From: dbs Date: Mon, 31 Jan 2011 02:14:37 +0000 (+0000) Subject: Make Evergreen Perl modules installable via Module::Build to match OpenSRF X-Git-Url: https://old-git.evergreen-ils.org/?a=commitdiff_plain;h=660f472a236daa2ab73809f8ce88243eaeb682f1;p=evergreen%2Fpines.git Make Evergreen Perl modules installable via Module::Build to match OpenSRF Build.PL gives us an install-time check on dependencies; right now the required versions are not set, but we can update these easily to start catching some of the problematic modules that have tripped sites up in the past. Build.PL really seems to want a top-level "OpenILS.pm" so add a placeholder accordingly. Adjust references to /src/perlmods/ to /src/perlmods/lib/ even though a number of the affected scripts are probably cruft. Use autoconf to provide the default paths in O:WWW:Web and O:WWW:Method; next step is probably to teach autoconf to ask Build.PL to do that for us to make the OpenILS Perl modules more independent. git-svn-id: svn://svn.open-ils.org/ILS/trunk@19340 dcc99617-32d9-48b4-a31d-7c20da2025e4 --- diff --git a/Open-ILS/examples/json-request-test.pl b/Open-ILS/examples/json-request-test.pl index c75877e326..edafb1cc38 100755 --- a/Open-ILS/examples/json-request-test.pl +++ b/Open-ILS/examples/json-request-test.pl @@ -1,8 +1,7 @@ #!/usr/bin/perl -w use strict; -use lib '../src/perlmods/'; -use lib '../../OpenSRF/src/perlmods/'; -use lib '../src/perlmods/OpenILS/Utils/'; +use lib '../src/perlmods/lib/'; +use lib '../src/perlmods/lib/OpenILS/Utils/'; use OpenSRF::Utils::JSON; use OpenSRF::System; diff --git a/Open-ILS/src/Makefile.am b/Open-ILS/src/Makefile.am index 63a8f53b30..7988b53eb0 100644 --- a/Open-ILS/src/Makefile.am +++ b/Open-ILS/src/Makefile.am @@ -61,7 +61,7 @@ sysconf_DATA = $(examples)/action_trigger_filters.json.example \ if BUILDILSCORE #Add directories to build -OILSCORE_DIRS = c-apps extras +OILSCORE_DIRS = c-apps extras perlmods #Add manual (non-automake) install targets for simplicity of installing. OILSCORE_INST = ilscore-install @@ -158,7 +158,6 @@ oilsinclude_HEADERS = $(headsdir)/idl_fieldmapper.h $(headsdir)/oils_constants.h install-data-hook: $(OILSCORE_INST) $(OILSWEB_INST) $(OILSUPDATES_INST) $(OILSREP_INST) uninstall-hook: - rm -R $(perldir) rm -R $(TEMPLATEDIR) rm -R $(XSLDIR) rm -R $(CGIDIR) @@ -167,14 +166,9 @@ uninstall-hook: #perl-install and string-templates-install ilscore-install: @echo $@ - @echo "Installing Perl modules" - $(MKDIR_P) $(perldir) $(MKDIR_P) $(TEMPLATEDIR) - cp -r @srcdir@/perlmods/* $(perldir) cp -r @srcdir@/templates/marc $(TEMPLATEDIR) cp -r @srcdir@/templates/password-reset $(TEMPLATEDIR) - sed -i 's|SYSCONFDIR|@sysconfdir@|g' '$(DESTDIR)@libdir@/perl5/OpenILS/WWW/Web.pm' - sed -i 's|SYSCONFDIR|@sysconfdir@|g' '$(DESTDIR)@libdir@/perl5/OpenILS/WWW/Method.pm' @echo "Installing string templates to $(TEMPLATEDIR)" $(MKDIR_P) $(TEMPLATEDIR) $(MKDIR_P) $(datadir)/overdue/ diff --git a/Open-ILS/src/perlmods/Build.PL b/Open-ILS/src/perlmods/Build.PL new file mode 100644 index 0000000000..00b0a26d09 --- /dev/null +++ b/Open-ILS/src/perlmods/Build.PL @@ -0,0 +1,102 @@ +#!/usr/bin/perl + +use Module::Build; +use strict; +use warnings; + +my $build = Module::Build->new( + module_name => 'OpenILS', + license => 'gpl', + requires => { + 'Apache2::Const' => '0', + 'Apache2::Log' => '0', + 'Apache2::RequestIO' => '0', + 'Apache2::RequestRec' => '0', + 'Apache2::RequestUtil' => '0', + 'APR::Const' => '0', + 'APR::Table' => '0', + 'Business::CreditCard' => '0', + 'Business::EDI' => '0', + 'Business::ISBN' => '0', + 'Business::OnlinePayment' => '0', + 'Carp' => '0', + 'CGI' => '0', + 'Class::DBI' => '0', + 'Class::DBI::AbstractSearch' => '0', + 'Data::Dumper' => '0', + 'DateTime' => '0', + 'DateTime::Format::ISO8601' => '0', + 'DateTime::Format::Mail' => '0', + 'DateTime::Format::Strptime' => '0', + 'DateTime::Set' => '0', + 'DateTime::SpanSet' => '0', + 'DBI' => '0', + 'Digest::MD5' => '0', + 'Email::Send' => '0', + 'Encode' => '0', + 'Error' => '0', + 'Exporter' => '0', + 'File::Basename' => '0', + 'File::Spec' => '0', + 'File::stat' => '0', + 'File::Temp' => '0', + 'Getopt::Long' => '0', + 'IO::Scalar' => '0', + 'JavaScript::SpiderMonkey' => '0', + 'List::Util' => '0', + 'Locale::Country' => '0', + 'LWP::UserAgent' => '0', + 'MARC::Batch' => '0', + 'MARC::Field' => '0', + 'MARC::File::XML' => '0', + 'MARC::Record' => '0', + 'MIME::Base64' => '0', + 'Net::FTP' => '0', + 'Net::SSH2' => '0', + 'OpenSRF::Application' => '0', + 'OpenSRF::AppSession' => '0', + 'OpenSRF::EX' => '0', + 'OpenSRF::MultiSession' => '0', + 'OpenSRF::System' => '0', + 'OpenSRF::Utils' => '0', + 'OpenSRF::Utils::Cache' => '0', + 'OpenSRF::Utils::Config' => '0', + 'OpenSRF::Utils::JSON' => '0', + 'OpenSRF::Utils::Logger' => '0', + 'OpenSRF::Utils::SettingsClient' => '0', + 'OpenSRF::Utils::SettingsParser' => '0', + 'Parse::RecDescent' => '0', + 'POSIX' => '0', + 'RPC::XML' => '0', + 'RPC::XML::Client' => '0', + 'RPC::XML::Function' => '0', + 'RPC::XML::Method' => '0', + 'RPC::XML::Parser' => '0', + 'RPC::XML::Procedure' => '0', + 'Safe' => '0', + 'Scalar::Util' => '0', + 'Socket' => '0', + 'SRU::Request' => '0', + 'SRU::Response' => '0', + 'Sys::Syslog' => '0', + 'Template' => '0', + 'Template::Plugin' => '0', + 'Test::More' => '0', + 'Text::Aspell' => '0', + 'Text::CSV' => '0', + 'Text::Glob' => '0', + 'Time::HiRes' => '0', + 'Time::Local' => '0', + 'Unicode::Normalize' => '0', + 'UNIVERSAL::require' => '0', + 'UUID::Tiny' => '0', + 'XML::LibXML' => '0', + 'XML::LibXML::XPathContext' => '0', + 'XML::LibXSLT' => '0', + 'XML::Simple' => '0', + } +); + +$build->create_build_script; + +# vim:et:ts=4:sw=4: diff --git a/Open-ILS/src/perlmods/MANIFEST b/Open-ILS/src/perlmods/MANIFEST new file mode 100644 index 0000000000..fc0ec787e8 --- /dev/null +++ b/Open-ILS/src/perlmods/MANIFEST @@ -0,0 +1,177 @@ +Build.PL +lib/OpenILS.pm +lib/OpenILS/Application.pm +lib/OpenILS/Application/Acq.pm +lib/OpenILS/Application/Acq/Claims.pm +lib/OpenILS/Application/Acq/EDI.pm +lib/OpenILS/Application/Acq/EDI/Translator.pm +lib/OpenILS/Application/Acq/Financials.pm +lib/OpenILS/Application/Acq/Invoice.pm +lib/OpenILS/Application/Acq/Lineitem.pm +lib/OpenILS/Application/Acq/Order.pm +lib/OpenILS/Application/Acq/Picklist.pm +lib/OpenILS/Application/Acq/Provider.pm +lib/OpenILS/Application/Acq/Search.pm +lib/OpenILS/Application/Actor.pm +lib/OpenILS/Application/Actor/ClosedDates.pm +lib/OpenILS/Application/Actor/Container.pm +lib/OpenILS/Application/Actor/Friends.pm +lib/OpenILS/Application/Actor/Stage.pm +lib/OpenILS/Application/Actor/UserGroups.pm +lib/OpenILS/Application/AppUtils.pm +lib/OpenILS/Application/Booking.pm +lib/OpenILS/Application/Cat.pm +lib/OpenILS/Application/Cat/AssetCommon.pm +lib/OpenILS/Application/Cat/AuthCommon.pm +lib/OpenILS/Application/Cat/Authority.pm +lib/OpenILS/Application/Cat/BibCommon.pm +lib/OpenILS/Application/Cat/Merge.pm +lib/OpenILS/Application/Circ.pm +lib/OpenILS/Application/Circ/CircCommon.pm +lib/OpenILS/Application/Circ/Circulate.pm +lib/OpenILS/Application/Circ/CopyLocations.pm +lib/OpenILS/Application/Circ/CreditCard.pm +lib/OpenILS/Application/Circ/HoldNotify.pm +lib/OpenILS/Application/Circ/Holds.pm +lib/OpenILS/Application/Circ/Money.pm +lib/OpenILS/Application/Circ/NonCat.pm +lib/OpenILS/Application/Circ/ScriptBuilder.pm +lib/OpenILS/Application/Circ/StatCat.pm +lib/OpenILS/Application/Circ/Survey.pm +lib/OpenILS/Application/Circ/Transit.pm +lib/OpenILS/Application/Collections.pm +lib/OpenILS/Application/Fielder.pm +lib/OpenILS/Application/Ingest.pm +lib/OpenILS/Application/Penalty.pm +lib/OpenILS/Application/PermaCrud.pm +lib/OpenILS/Application/Proxy.pm +lib/OpenILS/Application/Reporter.pm +lib/OpenILS/Application/ResolverResolver.pm +lib/OpenILS/Application/Search.pm +lib/OpenILS/Application/Search/AddedContent.pm +lib/OpenILS/Application/Search/Authority.pm +lib/OpenILS/Application/Search/Biblio.pm +lib/OpenILS/Application/Search/CNBrowse.pm +lib/OpenILS/Application/Search/Serial.pm +lib/OpenILS/Application/Search/Z3950.pm +lib/OpenILS/Application/Search/Zips.pm +lib/OpenILS/Application/Serial.pm +lib/OpenILS/Application/Storage.pm +lib/OpenILS/Application/Storage/CDBI.pm +lib/OpenILS/Application/Storage/CDBI/action.pm +lib/OpenILS/Application/Storage/CDBI/actor.pm +lib/OpenILS/Application/Storage/CDBI/asset.pm +lib/OpenILS/Application/Storage/CDBI/authority.pm +lib/OpenILS/Application/Storage/CDBI/biblio.pm +lib/OpenILS/Application/Storage/CDBI/booking.pm +lib/OpenILS/Application/Storage/CDBI/config.pm +lib/OpenILS/Application/Storage/CDBI/container.pm +lib/OpenILS/Application/Storage/CDBI/metabib.pm +lib/OpenILS/Application/Storage/CDBI/money.pm +lib/OpenILS/Application/Storage/CDBI/permission.pm +lib/OpenILS/Application/Storage/CDBI/serial.pm +lib/OpenILS/Application/Storage/Driver/Pg.pm +lib/OpenILS/Application/Storage/Driver/Pg/cdbi.pm +lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm +lib/OpenILS/Application/Storage/Driver/Pg/fts.pm +lib/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm +lib/OpenILS/Application/Storage/Driver/Pg/storage.pm +lib/OpenILS/Application/Storage/FTS.pm +lib/OpenILS/Application/Storage/Publisher.pm +lib/OpenILS/Application/Storage/Publisher/action.pm +lib/OpenILS/Application/Storage/Publisher/actor.pm +lib/OpenILS/Application/Storage/Publisher/asset.pm +lib/OpenILS/Application/Storage/Publisher/authority.pm +lib/OpenILS/Application/Storage/Publisher/biblio.pm +lib/OpenILS/Application/Storage/Publisher/config.pm +lib/OpenILS/Application/Storage/Publisher/container.pm +lib/OpenILS/Application/Storage/Publisher/metabib.pm +lib/OpenILS/Application/Storage/Publisher/money.pm +lib/OpenILS/Application/Storage/Publisher/permission.pm +lib/OpenILS/Application/Storage/QueryParser.pm +lib/OpenILS/Application/SuperCat.pm +lib/OpenILS/Application/Trigger.pm +lib/OpenILS/Application/Trigger/Cleanup.pm +lib/OpenILS/Application/Trigger/Collector.pm +lib/OpenILS/Application/Trigger/Event.pm +lib/OpenILS/Application/Trigger/EventGroup.pm +lib/OpenILS/Application/Trigger/ModRunner.pm +lib/OpenILS/Application/Trigger/Reactor.pm +lib/OpenILS/Application/Trigger/Reactor/ApplyCircFee.pm +lib/OpenILS/Application/Trigger/Reactor/ApplyPatronPenalty.pm +lib/OpenILS/Application/Trigger/Reactor/AstCall.pm +lib/OpenILS/Application/Trigger/Reactor/GeneratePurchaseOrderJEDI.pm +lib/OpenILS/Application/Trigger/Reactor/MarkItemLost.pm +lib/OpenILS/Application/Trigger/Reactor/ProcessTemplate.pm +lib/OpenILS/Application/Trigger/Reactor/SendEmail.pm +lib/OpenILS/Application/Trigger/Reactor/SendFile.pm +lib/OpenILS/Application/Trigger/Reactor/StaticEmail.pm +lib/OpenILS/Application/Trigger/Validator.pm +lib/OpenILS/Application/Trigger/Validator/Acq.pm +lib/OpenILS/Application/Trigger/Validator/Acq/PurchaseOrderEDIRequired.pm +lib/OpenILS/Application/Trigger/Validator/Acq/UserRequestCancelled.pm +lib/OpenILS/Application/Trigger/Validator/Acq/UserRequestOrdered.pm +lib/OpenILS/Application/Trigger/Validator/Acq/UserRequestReceived.pm +lib/OpenILS/Application/Vandelay.pm +lib/OpenILS/Const.pm +lib/OpenILS/Event.pm +lib/OpenILS/Perm.pm +lib/OpenILS/Reporter/Proxy.pm +lib/OpenILS/Reporter/SQLBuilder.pm +lib/OpenILS/SIP.pm +lib/OpenILS/SIP/Item.pm +lib/OpenILS/SIP/Msg.pm +lib/OpenILS/SIP/Patron.pm +lib/OpenILS/SIP/Transaction.pm +lib/OpenILS/SIP/Transaction/Checkin.pm +lib/OpenILS/SIP/Transaction/Checkout.pm +lib/OpenILS/SIP/Transaction/Renew.pm +lib/OpenILS/Template/Plugin/Unicode.pm +lib/OpenILS/Template/Plugin/WebSession.pm +lib/OpenILS/Template/Plugin/WebUtils.pm +lib/OpenILS/Utils/Cronscript.pm +lib/OpenILS/Utils/Cronscript.pm.in +lib/OpenILS/Utils/CStoreEditor.pm +lib/OpenILS/Utils/Editor.pm +lib/OpenILS/Utils/Fieldmapper.pm +lib/OpenILS/Utils/ISBN.pm +lib/OpenILS/Utils/Lockfile.pm +lib/OpenILS/Utils/MFHD.pm +lib/OpenILS/Utils/MFHD/Caption.pm +lib/OpenILS/Utils/MFHD/Date.pm +lib/OpenILS/Utils/MFHD/Holding.pm +lib/OpenILS/Utils/MFHD/test/mfhd.t +lib/OpenILS/Utils/MFHD/test/mfhddata.txt +lib/OpenILS/Utils/MFHD/test/testlib.pm +lib/OpenILS/Utils/MFHDParser.pm +lib/OpenILS/Utils/ModsParser.pm +lib/OpenILS/Utils/Normalize.pm +lib/OpenILS/Utils/OfflineStore.pm +lib/OpenILS/Utils/Penalty.pm +lib/OpenILS/Utils/PermitHold.pm +lib/OpenILS/Utils/RemoteAccount.pm +lib/OpenILS/Utils/ScriptRunner.pm +lib/OpenILS/Utils/SpiderMonkey.pm +lib/OpenILS/Utils/ZClient.pm +lib/OpenILS/WWW/AddedContent.pm +lib/OpenILS/WWW/AddedContent/Amazon.pm +lib/OpenILS/WWW/AddedContent/ContentCafe.pm +lib/OpenILS/WWW/AddedContent/OpenLibrary.pm +lib/OpenILS/WWW/AddedContent/Syndetic.pm +lib/OpenILS/WWW/BadDebt.pm +lib/OpenILS/WWW/EGWeb.pm +lib/OpenILS/WWW/Exporter.pm +lib/OpenILS/WWW/IDL2js.pm +lib/OpenILS/WWW/Method.pm +lib/OpenILS/WWW/PasswordReset.pm +lib/OpenILS/WWW/Proxy.pm +lib/OpenILS/WWW/Redirect.pm +lib/OpenILS/WWW/Reporter.pm +lib/OpenILS/WWW/Reporter/transforms.pm +lib/OpenILS/WWW/SuperCat.pm +lib/OpenILS/WWW/SuperCat/Feed.pm +lib/OpenILS/WWW/TemplateBatchBibUpdate.pm +lib/OpenILS/WWW/Vandelay.pm +lib/OpenILS/WWW/Web.pm +lib/OpenILS/WWW/XMLRPCGateway.pm +MANIFEST This list of files diff --git a/Open-ILS/src/perlmods/MANIFEST.SKIP b/Open-ILS/src/perlmods/MANIFEST.SKIP new file mode 100644 index 0000000000..1727f41ae7 --- /dev/null +++ b/Open-ILS/src/perlmods/MANIFEST.SKIP @@ -0,0 +1,70 @@ + +#!start included /usr/share/perl5/ExtUtils/MANIFEST.SKIP +# Avoid version control files. +\bRCS\b +\bCVS\b +\bSCCS\b +,v$ +\B\.svn\b +\B\.git\b +\B\.gitignore\b +\b_darcs\b +\B\.cvsignore$ + +# Avoid VMS specific MakeMaker generated files +\bDescrip.MMS$ +\bDESCRIP.MMS$ +\bdescrip.mms$ + +# Avoid Makemaker generated and utility files. +\bMANIFEST\.bak +\bMakefile$ +\bblib/ +\bMakeMaker-\d +\bpm_to_blib\.ts$ +\bpm_to_blib$ +\bblibdirs\.ts$ # 6.18 through 6.25 generated this + +# Avoid Module::Build generated and utility files. +\bBuild$ +\b_build/ +\bBuild.bat$ +\bBuild.COM$ +\bBUILD.COM$ +\bbuild.com$ + +# Avoid temp and backup files. +~$ +\.old$ +\#$ +\b\.# +\.bak$ +\.tmp$ +\.# +\.rej$ +\.swp$ + +# Avoid OS-specific files/dirs +# Mac OSX metadata +\B\.DS_Store +# Mac OSX SMB mount metadata files +\B\._ + +# Avoid Devel::Cover files. +\bcover_db\b +#!end included /usr/share/perl5/ExtUtils/MANIFEST.SKIP + +# Avoid configuration metadata file +^MYMETA\. + +# Avoid Module::Build generated and utility files. +\bBuild$ +\bBuild.bat$ +\b_build +\bBuild.COM$ +\bBUILD.COM$ +\bbuild.com$ +^MANIFEST\.SKIP + +# Avoid archives of this distribution +\bOpenILS-[\d\.\_]+ diff --git a/Open-ILS/src/perlmods/MYMETA.yml b/Open-ILS/src/perlmods/MYMETA.yml new file mode 100644 index 0000000000..6a4475c506 --- /dev/null +++ b/Open-ILS/src/perlmods/MYMETA.yml @@ -0,0 +1,980 @@ +--- +abstract: ~ +author: [] +configure_requires: + Module::Build: 0.36 +dynamic_config: 0 +generated_by: 'Module::Build version 0.3603' +license: gpl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: OpenILS +provides: + CQL::BooleanNode: + file: lib/OpenILS/WWW/SuperCat.pm + CQL::TermNode: + file: lib/OpenILS/WWW/SuperCat.pm + Class::DBI: + file: lib/OpenILS/Application/Storage/FTS.pm + Fieldmapper: + file: lib/OpenILS/Utils/Fieldmapper.pm + MFHD: + file: lib/OpenILS/Utils/MFHD.pm + MFHD::Caption: + file: lib/OpenILS/Utils/MFHD/Caption.pm + MFHD::Date: + file: lib/OpenILS/Utils/MFHD/Date.pm + MFHD::Holding: + file: lib/OpenILS/Utils/MFHD/Holding.pm + OpenILS: + file: lib/OpenILS.pm + version: 2.00 + OpenILS::Application: + file: lib/OpenILS/Application.pm + OpenILS::Application::Acq: + file: lib/OpenILS/Application/Acq.pm + OpenILS::Application::Acq::BatchManager: + file: lib/OpenILS/Application/Acq/Order.pm + OpenILS::Application::Acq::Claims: + file: lib/OpenILS/Application/Acq/Claims.pm + OpenILS::Application::Acq::EDI: + file: lib/OpenILS/Application/Acq/EDI.pm + OpenILS::Application::Acq::EDI::Translator: + file: lib/OpenILS/Application/Acq/EDI/Translator.pm + OpenILS::Application::Acq::Financials: + file: lib/OpenILS/Application/Acq/Financials.pm + OpenILS::Application::Acq::Invoice: + file: lib/OpenILS/Application/Acq/Invoice.pm + OpenILS::Application::Acq::Lineitem: + file: lib/OpenILS/Application/Acq/Lineitem.pm + OpenILS::Application::Acq::Order: + file: lib/OpenILS/Application/Acq/Order.pm + OpenILS::Application::Acq::Picklist: + file: lib/OpenILS/Application/Acq/Picklist.pm + OpenILS::Application::Acq::Provider: + file: lib/OpenILS/Application/Acq/Provider.pm + OpenILS::Application::Acq::Search: + file: lib/OpenILS/Application/Acq/Search.pm + OpenILS::Application::Actor: + file: lib/OpenILS/Application/Actor.pm + OpenILS::Application::Actor::ClosedDates: + file: lib/OpenILS/Application/Actor/ClosedDates.pm + OpenILS::Application::Actor::Container: + file: lib/OpenILS/Application/Actor/Container.pm + OpenILS::Application::Actor::Friends: + file: lib/OpenILS/Application/Actor/Friends.pm + OpenILS::Application::Actor::Stage: + file: lib/OpenILS/Application/Actor/Stage.pm + OpenILS::Application::Actor::UserGroups: + file: lib/OpenILS/Application/Actor/UserGroups.pm + OpenILS::Application::AppUtils: + file: lib/OpenILS/Application/AppUtils.pm + OpenILS::Application::Booking: + file: lib/OpenILS/Application/Booking.pm + OpenILS::Application::Cat: + file: lib/OpenILS/Application/Cat.pm + OpenILS::Application::Cat::AssetCommon: + file: lib/OpenILS/Application/Cat/AssetCommon.pm + OpenILS::Application::Cat::AuthCommon: + file: lib/OpenILS/Application/Cat/AuthCommon.pm + OpenILS::Application::Cat::Authority: + file: lib/OpenILS/Application/Cat/Authority.pm + OpenILS::Application::Cat::BibCommon: + file: lib/OpenILS/Application/Cat/BibCommon.pm + OpenILS::Application::Cat::Merge: + file: lib/OpenILS/Application/Cat/Merge.pm + OpenILS::Application::Circ: + file: lib/OpenILS/Application/Circ.pm + OpenILS::Application::Circ::CircCommon: + file: lib/OpenILS/Application/Circ/CircCommon.pm + OpenILS::Application::Circ::Circulate: + file: lib/OpenILS/Application/Circ/Circulate.pm + OpenILS::Application::Circ::Circulator: + file: lib/OpenILS/Application/Circ/Circulate.pm + OpenILS::Application::Circ::CopyLocations: + file: lib/OpenILS/Application/Circ/CopyLocations.pm + OpenILS::Application::Circ::CreditCard: + file: lib/OpenILS/Application/Circ/CreditCard.pm + OpenILS::Application::Circ::HoldNotify: + file: lib/OpenILS/Application/Circ/HoldNotify.pm + OpenILS::Application::Circ::Holds: + file: lib/OpenILS/Application/Circ/Holds.pm + OpenILS::Application::Circ::Money: + file: lib/OpenILS/Application/Circ/Money.pm + OpenILS::Application::Circ::NonCat: + file: lib/OpenILS/Application/Circ/NonCat.pm + OpenILS::Application::Circ::ScriptBuilder: + file: lib/OpenILS/Application/Circ/ScriptBuilder.pm + OpenILS::Application::Circ::StatCat: + file: lib/OpenILS/Application/Circ/StatCat.pm + OpenILS::Application::Circ::Survey: + file: lib/OpenILS/Application/Circ/Survey.pm + OpenILS::Application::Circ::Transit: + file: lib/OpenILS/Application/Circ/Transit.pm + OpenILS::Application::Collections: + file: lib/OpenILS/Application/Collections.pm + OpenILS::Application::Fielder: + file: lib/OpenILS/Application/Fielder.pm + OpenILS::Application::Ingest: + file: lib/OpenILS/Application/Ingest.pm + OpenILS::Application::Ingest::Authority: + file: lib/OpenILS/Application/Ingest.pm + OpenILS::Application::Ingest::Biblio: + file: lib/OpenILS/Application/Ingest.pm + OpenILS::Application::Ingest::Biblio::Fingerprint: + file: lib/OpenILS/Application/Ingest.pm + OpenILS::Application::Ingest::Biblio::URI: + file: lib/OpenILS/Application/Ingest.pm + OpenILS::Application::Ingest::FlatMARC: + file: lib/OpenILS/Application/Ingest.pm + OpenILS::Application::Ingest::XPATH: + file: lib/OpenILS/Application/Ingest.pm + OpenILS::Application::Penalty: + file: lib/OpenILS/Application/Penalty.pm + OpenILS::Application::PermaCrud: + file: lib/OpenILS/Application/PermaCrud.pm + OpenILS::Application::Proxy: + file: lib/OpenILS/Application/Proxy.pm + OpenILS::Application::Reporter: + file: lib/OpenILS/Application/Reporter.pm + OpenILS::Application::ResolverResolver: + file: lib/OpenILS/Application/ResolverResolver.pm + OpenILS::Application::Search: + file: lib/OpenILS/Application/Search.pm + OpenILS::Application::Search::AddedContent: + file: lib/OpenILS/Application/Search/AddedContent.pm + OpenILS::Application::Search::Authority: + file: lib/OpenILS/Application/Search/Authority.pm + OpenILS::Application::Search::Biblio: + file: lib/OpenILS/Application/Search/Biblio.pm + OpenILS::Application::Search::CNBrowse: + file: lib/OpenILS/Application/Search/CNBrowse.pm + OpenILS::Application::Search::Serial: + file: lib/OpenILS/Application/Search/Serial.pm + OpenILS::Application::Search::Z3950: + file: lib/OpenILS/Application/Search/Z3950.pm + OpenILS::Application::Search::Zips: + file: lib/OpenILS/Application/Search/Zips.pm + OpenILS::Application::Serial: + file: lib/OpenILS/Application/Serial.pm + OpenILS::Application::Storage: + file: lib/OpenILS/Application/Storage.pm + OpenILS::Application::Storage::CDBI: + file: lib/OpenILS/Application/Storage/CDBI.pm + version: 1 + OpenILS::Application::Storage::CDBI::action: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + version: 1 + OpenILS::Application::Storage::CDBI::actor: + file: lib/OpenILS/Application/Storage/CDBI/actor.pm + version: 1 + OpenILS::Application::Storage::CDBI::asset: + file: lib/OpenILS/Application/Storage/CDBI/asset.pm + version: 1 + OpenILS::Application::Storage::CDBI::authority: + file: lib/OpenILS/Application/Storage/CDBI/authority.pm + version: 1 + OpenILS::Application::Storage::CDBI::biblio: + file: lib/OpenILS/Application/Storage/CDBI/biblio.pm + version: 1 + OpenILS::Application::Storage::CDBI::booking: + file: lib/OpenILS/Application/Storage/CDBI/booking.pm + version: 1 + OpenILS::Application::Storage::CDBI::config: + file: lib/OpenILS/Application/Storage/CDBI/config.pm + version: 1 + OpenILS::Application::Storage::CDBI::container: + file: lib/OpenILS/Application/Storage/CDBI/container.pm + version: 1 + OpenILS::Application::Storage::CDBI::metabib: + file: lib/OpenILS/Application/Storage/CDBI/metabib.pm + version: 1 + OpenILS::Application::Storage::CDBI::money: + file: lib/OpenILS/Application/Storage/CDBI/money.pm + version: 1 + OpenILS::Application::Storage::CDBI::permission: + file: lib/OpenILS/Application/Storage/CDBI/permission.pm + version: 1 + OpenILS::Application::Storage::CDBI::serial: + file: lib/OpenILS/Application/Storage/CDBI/serial.pm + version: 1 + OpenILS::Application::Storage::Driver::Pg: + file: lib/OpenILS/Application/Storage/Driver/Pg.pm + OpenILS::Application::Storage::Driver::Pg::QueryParser: + file: lib/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm + OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan: + file: lib/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm + OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan::facet: + file: lib/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm + OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan::filter: + file: lib/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm + OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan::modifier: + file: lib/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm + OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan::node: + file: lib/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm + OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan::node::atom: + file: lib/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm + OpenILS::Application::Storage::FTS: + file: lib/OpenILS/Application/Storage/FTS.pm + OpenILS::Application::Storage::Publisher: + file: lib/OpenILS/Application/Storage/Publisher.pm + version: 1 + OpenILS::Application::Storage::Publisher::action: + file: lib/OpenILS/Application/Storage/Publisher/action.pm + OpenILS::Application::Storage::Publisher::actor: + file: lib/OpenILS/Application/Storage/Publisher/actor.pm + OpenILS::Application::Storage::Publisher::asset: + file: lib/OpenILS/Application/Storage/Publisher/asset.pm + OpenILS::Application::Storage::Publisher::authority: + file: lib/OpenILS/Application/Storage/Publisher/authority.pm + version: 1 + OpenILS::Application::Storage::Publisher::biblio: + file: lib/OpenILS/Application/Storage/Publisher/biblio.pm + version: 1 + OpenILS::Application::Storage::Publisher::config: + file: lib/OpenILS/Application/Storage/Publisher/config.pm + OpenILS::Application::Storage::Publisher::container: + file: lib/OpenILS/Application/Storage/Publisher/container.pm + OpenILS::Application::Storage::Publisher::metabib: + file: lib/OpenILS/Application/Storage/Publisher/metabib.pm + version: 1 + OpenILS::Application::Storage::Publisher::money: + file: lib/OpenILS/Application/Storage/Publisher/money.pm + OpenILS::Application::Storage::Publisher::permission: + file: lib/OpenILS/Application/Storage/Publisher/permission.pm + OpenILS::Application::SuperCat: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::SuperCat::unAPI: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::SuperCat::unAPI::acn: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::SuperCat::unAPI::acp: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::SuperCat::unAPI::auri: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::SuperCat::unAPI::sbsum: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::SuperCat::unAPI::scap: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::SuperCat::unAPI::sdist: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::SuperCat::unAPI::siss: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::SuperCat::unAPI::sisum: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::SuperCat::unAPI::sitem: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::SuperCat::unAPI::sssum: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::SuperCat::unAPI::sstr: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::SuperCat::unAPI::ssub: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::SuperCat::unAPI::ssum_base: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::SuperCat::unAPI::sunit: + file: lib/OpenILS/Application/SuperCat.pm + OpenILS::Application::Trigger: + file: lib/OpenILS/Application/Trigger.pm + OpenILS::Application::Trigger::Cleanup: + file: lib/OpenILS/Application/Trigger/Cleanup.pm + OpenILS::Application::Trigger::Collector: + file: lib/OpenILS/Application/Trigger/Collector.pm + OpenILS::Application::Trigger::Event: + file: lib/OpenILS/Application/Trigger/Event.pm + OpenILS::Application::Trigger::EventGroup: + file: lib/OpenILS/Application/Trigger/EventGroup.pm + OpenILS::Application::Trigger::ModLoader: + file: lib/OpenILS/Application/Trigger/ModRunner.pm + OpenILS::Application::Trigger::ModRunner: + file: lib/OpenILS/Application/Trigger/ModRunner.pm + OpenILS::Application::Trigger::ModRunner::Cleanup: + file: lib/OpenILS/Application/Trigger/ModRunner.pm + OpenILS::Application::Trigger::ModRunner::Collector: + file: lib/OpenILS/Application/Trigger/ModRunner.pm + OpenILS::Application::Trigger::ModRunner::Reactor: + file: lib/OpenILS/Application/Trigger/ModRunner.pm + OpenILS::Application::Trigger::ModRunner::Validator: + file: lib/OpenILS/Application/Trigger/ModRunner.pm + OpenILS::Application::Trigger::ModStackRunner: + file: lib/OpenILS/Application/Trigger/ModRunner.pm + OpenILS::Application::Trigger::Reactor: + file: lib/OpenILS/Application/Trigger/Reactor.pm + OpenILS::Application::Trigger::Reactor::ApplyCircFee: + file: lib/OpenILS/Application/Trigger/Reactor/ApplyCircFee.pm + OpenILS::Application::Trigger::Reactor::ApplyPatronPenalty: + file: lib/OpenILS/Application/Trigger/Reactor/ApplyPatronPenalty.pm + OpenILS::Application::Trigger::Reactor::AstCall: + file: lib/OpenILS/Application/Trigger/Reactor/AstCall.pm + OpenILS::Application::Trigger::Reactor::GeneratePurchaseOrderJEDI: + file: lib/OpenILS/Application/Trigger/Reactor/GeneratePurchaseOrderJEDI.pm + OpenILS::Application::Trigger::Reactor::MarkItemLost: + file: lib/OpenILS/Application/Trigger/Reactor/MarkItemLost.pm + OpenILS::Application::Trigger::Reactor::ProcessTemplate: + file: lib/OpenILS/Application/Trigger/Reactor/ProcessTemplate.pm + OpenILS::Application::Trigger::Reactor::SendEmail: + file: lib/OpenILS/Application/Trigger/Reactor/SendEmail.pm + OpenILS::Application::Trigger::Reactor::SendFile: + file: lib/OpenILS/Application/Trigger/Reactor/SendFile.pm + OpenILS::Application::Trigger::Reactor::StaticEmail: + file: lib/OpenILS/Application/Trigger/Reactor/StaticEmail.pm + OpenILS::Application::Trigger::Validator: + file: lib/OpenILS/Application/Trigger/Validator.pm + OpenILS::Application::Trigger::Validator::Acq: + file: lib/OpenILS/Application/Trigger/Validator/Acq.pm + OpenILS::Application::Trigger::Validator::Acq::PurchaseOrderEDIRequired: + file: lib/OpenILS/Application/Trigger/Validator/Acq/PurchaseOrderEDIRequired.pm + OpenILS::Application::Trigger::Validator::Acq::UserRequestCancelled: + file: lib/OpenILS/Application/Trigger/Validator/Acq/UserRequestCancelled.pm + OpenILS::Application::Trigger::Validator::Acq::UserRequestOrdered: + file: lib/OpenILS/Application/Trigger/Validator/Acq/UserRequestOrdered.pm + OpenILS::Application::Trigger::Validator::Acq::UserRequestReceived: + file: lib/OpenILS/Application/Trigger/Validator/Acq/UserRequestReceived.pm + OpenILS::Application::Vandelay: + file: lib/OpenILS/Application/Vandelay.pm + OpenILS::Const: + file: lib/OpenILS/Const.pm + OpenILS::Event: + file: lib/OpenILS/Event.pm + OpenILS::Perm: + file: lib/OpenILS/Perm.pm + OpenILS::Reporter::Proxy: + file: lib/OpenILS/Reporter/Proxy.pm + OpenILS::Reporter::SQLBuilder: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Having: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::OrderBy: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Select: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::Bare: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::GenericTransform: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::age: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::average: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::count: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::count_distinct: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::date_trunc: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::day_name: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::dom: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::dow: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::doy: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::first: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::hod: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::hour_trunc: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::last: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::lower: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::max: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::min: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::month_name: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::month_trunc: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::months_ago: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::moy: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::qoy: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::quarter: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::quarters_ago: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::substring: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::sum: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::upper: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::woy: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Transform::year_trunc: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Column::Where: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Input: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Input::Transform::Bare: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Input::Transform::GenericTransform: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Input::Transform::NULL: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Input::Transform::age: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Input::Transform::relative_date: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Input::Transform::relative_month: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Input::Transform::relative_week: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Input::Transform::relative_year: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Join: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Join::cross: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Join::inner: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Join::left: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Join::right: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::Relation: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::Reporter::SQLBuilder::ResultSet: + file: lib/OpenILS/Reporter/SQLBuilder.pm + OpenILS::SIP: + file: lib/OpenILS/SIP.pm + OpenILS::SIP::Item: + file: lib/OpenILS/SIP/Item.pm + OpenILS::SIP::Msg: + file: lib/OpenILS/SIP/Msg.pm + OpenILS::SIP::Patron: + file: lib/OpenILS/SIP/Patron.pm + OpenILS::SIP::Transaction: + file: lib/OpenILS/SIP/Transaction.pm + OpenILS::SIP::Transaction::Checkin: + file: lib/OpenILS/SIP/Transaction/Checkin.pm + OpenILS::SIP::Transaction::Checkout: + file: lib/OpenILS/SIP/Transaction/Checkout.pm + OpenILS::SIP::Transaction::Renew: + file: lib/OpenILS/SIP/Transaction/Renew.pm + OpenILS::Template::Plugin::Unicode: + file: lib/OpenILS/Template/Plugin/Unicode.pm + OpenILS::Template::Plugin::WebSession: + file: lib/OpenILS/Template/Plugin/WebSession.pm + OpenILS::Template::Plugin::WebUtils: + file: lib/OpenILS/Template/Plugin/WebUtils.pm + OpenILS::Utils::CStoreEditor: + file: lib/OpenILS/Utils/CStoreEditor.pm + OpenILS::Utils::Cronscript: + file: lib/OpenILS/Utils/Cronscript.pm + OpenILS::Utils::Editor: + file: lib/OpenILS/Utils/Editor.pm + OpenILS::Utils::ISBN: + file: lib/OpenILS/Utils/ISBN.pm + version: 0.01 + OpenILS::Utils::Lockfile: + file: lib/OpenILS/Utils/Lockfile.pm + OpenILS::Utils::MFHDParser: + file: lib/OpenILS/Utils/MFHDParser.pm + OpenILS::Utils::ModsParser: + file: lib/OpenILS/Utils/ModsParser.pm + OpenILS::Utils::Normalize: + file: lib/OpenILS/Utils/Normalize.pm + OpenILS::Utils::OfflineStore: + file: lib/OpenILS/Utils/OfflineStore.pm + OpenILS::Utils::OfflineStore::Script: + file: lib/OpenILS/Utils/OfflineStore.pm + OpenILS::Utils::OfflineStore::Session: + file: lib/OpenILS/Utils/OfflineStore.pm + OpenILS::Utils::Penalty: + file: lib/OpenILS/Utils/Penalty.pm + OpenILS::Utils::PermitHold: + file: lib/OpenILS/Utils/PermitHold.pm + OpenILS::Utils::RemoteAccount: + file: lib/OpenILS/Utils/RemoteAccount.pm + OpenILS::Utils::ScriptRunner: + file: lib/OpenILS/Utils/ScriptRunner.pm + OpenILS::Utils::SpiderMonkey: + file: lib/OpenILS/Utils/SpiderMonkey.pm + OpenILS::Utils::ZClient: + file: lib/OpenILS/Utils/ZClient.pm + OpenILS::Utils::ZClient::Record: + file: lib/OpenILS/Utils/ZClient.pm + OpenILS::Utils::ZClient::ResultSet: + file: lib/OpenILS/Utils/ZClient.pm + OpenILS::WWW::AddedContent: + file: lib/OpenILS/WWW/AddedContent.pm + OpenILS::WWW::AddedContent::Amazon: + file: lib/OpenILS/WWW/AddedContent/Amazon.pm + OpenILS::WWW::AddedContent::ContentCafe: + file: lib/OpenILS/WWW/AddedContent/ContentCafe.pm + OpenILS::WWW::AddedContent::OpenLibrary: + file: lib/OpenILS/WWW/AddedContent/OpenLibrary.pm + OpenILS::WWW::AddedContent::Syndetic: + file: lib/OpenILS/WWW/AddedContent/Syndetic.pm + OpenILS::WWW::BadDebt: + file: lib/OpenILS/WWW/BadDebt.pm + OpenILS::WWW::EGWeb: + file: lib/OpenILS/WWW/EGWeb.pm + OpenILS::WWW::Exporter: + file: lib/OpenILS/WWW/Exporter.pm + OpenILS::WWW::IDL2js: + file: lib/OpenILS/WWW/IDL2js.pm + OpenILS::WWW::Method: + file: lib/OpenILS/WWW/Method.pm + OpenILS::WWW::PasswordReset: + file: lib/OpenILS/WWW/PasswordReset.pm + OpenILS::WWW::Proxy: + file: lib/OpenILS/WWW/Proxy.pm + OpenILS::WWW::Redirect: + file: lib/OpenILS/WWW/Redirect.pm + OpenILS::WWW::Reporter: + file: lib/OpenILS/WWW/Reporter.pm + OpenILS::WWW::SuperCat: + file: lib/OpenILS/WWW/SuperCat.pm + OpenILS::WWW::SuperCat::Feed: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::atom: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::atom::item: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::html: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::html::item: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::htmlcard: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::htmlcard::item: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::htmlholdings: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::htmlholdings::item: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::marctxt: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::marctxt::item: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::marcxml: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::marcxml::item: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::mods: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::mods3: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::mods32: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::mods32::item: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::mods33: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::mods33::item: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::mods3::item: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::mods::item: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::ris: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::ris::item: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::rss2: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::SuperCat::Feed::rss2::item: + file: lib/OpenILS/WWW/SuperCat/Feed.pm + OpenILS::WWW::TemplateBatchBibUpdate: + file: lib/OpenILS/WWW/TemplateBatchBibUpdate.pm + OpenILS::WWW::Vandelay: + file: lib/OpenILS/WWW/Vandelay.pm + OpenILS::WWW::Web: + file: lib/OpenILS/WWW/Web.pm + OpenILS::WWW::XMLRPCGateway: + file: lib/OpenILS/WWW/XMLRPCGateway.pm + PathConfig: + file: lib/OpenILS/WWW/EGWeb.pm + QueryParser: + file: lib/OpenILS/Application/Storage/QueryParser.pm + QueryParser::query_plan: + file: lib/OpenILS/Application/Storage/QueryParser.pm + QueryParser::query_plan::facet: + file: lib/OpenILS/Application/Storage/QueryParser.pm + QueryParser::query_plan::filter: + file: lib/OpenILS/Application/Storage/QueryParser.pm + QueryParser::query_plan::modifier: + file: lib/OpenILS/Application/Storage/QueryParser.pm + QueryParser::query_plan::node: + file: lib/OpenILS/Application/Storage/QueryParser.pm + QueryParser::query_plan::node::atom: + file: lib/OpenILS/Application/Storage/QueryParser.pm + action: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::circulation: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::hold_copy_map: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::hold_notification: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::hold_request: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::hold_transit_copy: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::in_house_use: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::non_cat_in_house_use: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::non_cataloged_circulation: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::open_circulation: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::reservation_transit_copy: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::survey: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::survey_answer: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::survey_question: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::survey_response: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::transit_copy: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + action::unfulfilled_hold_list: + file: lib/OpenILS/Application/Storage/CDBI/action.pm + actor: + file: lib/OpenILS/Application/Storage/CDBI/actor.pm + actor::card: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::org_address: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::org_unit: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::org_unit::closed_date: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::org_unit::hours_of_operation: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::org_unit_proximity: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::org_unit_setting: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::org_unit_type: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::perm_group: + file: lib/OpenILS/Application/Storage/CDBI/actor.pm + actor::perm_group_permission_map: + file: lib/OpenILS/Application/Storage/CDBI/actor.pm + actor::perm_group_user_map: + file: lib/OpenILS/Application/Storage/CDBI/actor.pm + actor::permission: + file: lib/OpenILS/Application/Storage/CDBI/actor.pm + actor::stat_cat: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::stat_cat_entry: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::stat_cat_entry_user_map: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::user: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::user_access_entry: + file: lib/OpenILS/Application/Storage/CDBI/actor.pm + actor::user_address: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::user_setting: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::user_standing_penalty: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::usr_note: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::usr_org_unit_opt_in: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + actor::workstation: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + asset: + file: lib/OpenILS/Application/Storage/CDBI/asset.pm + asset::call_number: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + asset::call_number_class: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + asset::call_number_note: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + asset::copy: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + asset::copy_location: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + asset::copy_location_order: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + asset::copy_note: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + asset::stat_cat: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + asset::stat_cat_entry: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + asset::stat_cat_entry_copy_map: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + authority: + file: lib/OpenILS/Application/Storage/CDBI/authority.pm + authority::full_rec: + file: lib/OpenILS/Application/Storage/CDBI/authority.pm + authority::record_descriptor: + file: lib/OpenILS/Application/Storage/CDBI/authority.pm + authority::record_entry: + file: lib/OpenILS/Application/Storage/CDBI/authority.pm + authority::record_note: + file: lib/OpenILS/Application/Storage/CDBI/authority.pm + biblio: + file: lib/OpenILS/Application/Storage/CDBI/biblio.pm + biblio::record_entry: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + biblio::record_note: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + booking: + file: lib/OpenILS/Application/Storage/CDBI/booking.pm + booking::reservation: + file: lib/OpenILS/Application/Storage/CDBI/booking.pm + booking::reservation_attr_value_map: + file: lib/OpenILS/Application/Storage/CDBI/booking.pm + booking::resource: + file: lib/OpenILS/Application/Storage/CDBI/booking.pm + booking::resource_attr_map: + file: lib/OpenILS/Application/Storage/CDBI/booking.pm + booking::resource_type: + file: lib/OpenILS/Application/Storage/CDBI/booking.pm + config: + file: lib/OpenILS/Application/Storage/CDBI/config.pm + config::audience_map: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::bib_source: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::copy_status: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::i18n_core: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::i18n_locale: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::identification_type: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::item_form_map: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::item_type_map: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::language_map: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::lit_form_map: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::metabib_field: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::net_access_level: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::non_cataloged_type: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::rules::age_hold_protect: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::rules::circ_duration: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::rules::max_fine: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::rules::recurring_fine: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + config::standing: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + container: + file: lib/OpenILS/Application/Storage/CDBI/container.pm + container::biblio_record_entry_bucket: + file: lib/OpenILS/Application/Storage/CDBI/container.pm + container::biblio_record_entry_bucket_item: + file: lib/OpenILS/Application/Storage/CDBI/container.pm + container::call_number_bucket: + file: lib/OpenILS/Application/Storage/CDBI/container.pm + container::call_number_bucket_item: + file: lib/OpenILS/Application/Storage/CDBI/container.pm + container::copy_bucket: + file: lib/OpenILS/Application/Storage/CDBI/container.pm + container::copy_bucket_item: + file: lib/OpenILS/Application/Storage/CDBI/container.pm + container::user_bucket: + file: lib/OpenILS/Application/Storage/CDBI/container.pm + container::user_bucket_item: + file: lib/OpenILS/Application/Storage/CDBI/container.pm + metabib: + file: lib/OpenILS/Application/Storage/CDBI/metabib.pm + metabib::author_field_entry: + file: lib/OpenILS/Application/Storage/CDBI/metabib.pm + metabib::full_rec: + file: lib/OpenILS/Application/Storage/CDBI/metabib.pm + metabib::identifier_field_entry: + file: lib/OpenILS/Application/Storage/CDBI/metabib.pm + metabib::keyword_field_entry: + file: lib/OpenILS/Application/Storage/CDBI/metabib.pm + metabib::metarecord: + file: lib/OpenILS/Application/Storage/CDBI/metabib.pm + metabib::metarecord_source_map: + file: lib/OpenILS/Application/Storage/CDBI/metabib.pm + metabib::record_descriptor: + file: lib/OpenILS/Application/Storage/CDBI/metabib.pm + metabib::series_field_entry: + file: lib/OpenILS/Application/Storage/CDBI/metabib.pm + metabib::subject_field_entry: + file: lib/OpenILS/Application/Storage/CDBI/metabib.pm + metabib::title_field_entry: + file: lib/OpenILS/Application/Storage/CDBI/metabib.pm + money: + file: lib/OpenILS/Application/Storage/CDBI/money.pm + money::billable_transaction: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::billable_transaction_summary: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::billing: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::cash_payment: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::check_payment: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::collections_tracker: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::credit_card_payment: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::credit_payment: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::desk_payment: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::forgive_payment: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::goods_payment: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::grocery: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::open_billable_transaction_summary: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::open_user_circulation_summary: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::open_user_summary: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::payment: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::user_circulation_summary: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::user_summary: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + money::work_payment: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + permission: + file: lib/OpenILS/Application/Storage/CDBI/permission.pm + permission::grp_perm_map: + file: lib/OpenILS/Application/Storage/CDBI/permission.pm + permission::grp_tree: + file: lib/OpenILS/Application/Storage/CDBI/permission.pm + permission::perm_list: + file: lib/OpenILS/Application/Storage/CDBI/permission.pm + permission::usr_grp_map: + file: lib/OpenILS/Application/Storage/CDBI/permission.pm + permission::usr_perm_map: + file: lib/OpenILS/Application/Storage/CDBI/permission.pm + permission::usr_work_ou_map: + file: lib/OpenILS/Application/Storage/CDBI/permission.pm + serial: + file: lib/OpenILS/Application/Storage/CDBI/serial.pm + serial::issuance: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + serial::item: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + serial::record_entry: + file: lib/OpenILS/Application/Storage/CDBI/serial.pm + serial::subscription: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + serial::unit: + file: lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm + testlib: + file: lib/OpenILS/Utils/MFHD/test/testlib.pm +requires: + APR::Const: 0 + APR::Table: 0 + Apache2::Const: 0 + Apache2::Log: 0 + Apache2::RequestIO: 0 + Apache2::RequestRec: 0 + Apache2::RequestUtil: 0 + Business::CreditCard: 0 + Business::EDI: 0 + Business::ISBN: 0 + Business::OnlinePayment: 0 + CGI: 0 + Carp: 0 + Class::DBI: 0 + Class::DBI::AbstractSearch: 0 + DBI: 0 + Data::Dumper: 0 + DateTime: 0 + DateTime::Format::ISO8601: 0 + DateTime::Format::Mail: 0 + DateTime::Format::Strptime: 0 + DateTime::Set: 0 + DateTime::SpanSet: 0 + Digest::MD5: 0 + Email::Send: 0 + Encode: 0 + Error: 0 + Exporter: 0 + File::Basename: 0 + File::Spec: 0 + File::Temp: 0 + File::stat: 0 + Getopt::Long: 0 + IO::Scalar: 0 + JavaScript::SpiderMonkey: 0 + LWP::UserAgent: 0 + List::Util: 0 + Locale::Country: 0 + MARC::Batch: 0 + MARC::Field: 0 + MARC::File::XML: 0 + MARC::Record: 0 + MIME::Base64: 0 + Net::FTP: 0 + Net::SSH2: 0 + OpenSRF::AppSession: 0 + OpenSRF::Application: 0 + OpenSRF::EX: 0 + OpenSRF::MultiSession: 0 + OpenSRF::System: 0 + OpenSRF::Utils: 0 + OpenSRF::Utils::Cache: 0 + OpenSRF::Utils::Config: 0 + OpenSRF::Utils::JSON: 0 + OpenSRF::Utils::Logger: 0 + OpenSRF::Utils::SettingsClient: 0 + OpenSRF::Utils::SettingsParser: 0 + POSIX: 0 + Parse::RecDescent: 0 + RPC::XML: 0 + RPC::XML::Client: 0 + RPC::XML::Function: 0 + RPC::XML::Method: 0 + RPC::XML::Parser: 0 + RPC::XML::Procedure: 0 + SRU::Request: 0 + SRU::Response: 0 + Safe: 0 + Scalar::Util: 0 + Socket: 0 + Sys::Syslog: 0 + Template: 0 + Template::Plugin: 0 + Test::More: 0 + Text::Aspell: 0 + Text::CSV: 0 + Text::Glob: 0 + Time::HiRes: 0 + Time::Local: 0 + UNIVERSAL::require: 0 + UUID::Tiny: 0 + Unicode::Normalize: 0 + XML::LibXML: 0 + XML::LibXML::XPathContext: 0 + XML::LibXSLT: 0 + XML::Simple: 0 +resources: + license: http://opensource.org/licenses/gpl-license.php +version: 2.00 diff --git a/Open-ILS/src/perlmods/Makefile.am b/Open-ILS/src/perlmods/Makefile.am new file mode 100644 index 0000000000..047b503466 --- /dev/null +++ b/Open-ILS/src/perlmods/Makefile.am @@ -0,0 +1,45 @@ +# Copyright (C) 2009 Equinox Software, Inc. +# Shawn Boyette +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License +# as published by the Free Software Foundation; either version 2 +# of the License, or (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +CLEANFILES = Build +DISTCLEANFILES = Makefile.in Makefile + +all: + perl Build.PL || make -s build-perl-fail + ./Build || make -s build-perl-fail + +check: + ./Build test || make -s build-perl-fail + +install: + ./Build install + +build-perl-fail: + echo + echo ">>> Build/test of Perl modules has failed. The most likely" + echo ">>> possibility is that a dependency is not pre-installed" + echo ">>> or that a test has failed." + echo ">>> See the messages above this one for more information." + echo + exit 1 + +install-perl-fail: + echo + echo ">>> Install of Perl modules has failed." + echo ">>> Are you root?" + echo ">>> See the message above this one for more information." + echo + +distclean-local: + rm -rf ./_build + rm -rf ./blib \ No newline at end of file diff --git a/Open-ILS/src/perlmods/OpenILS/Application.pm b/Open-ILS/src/perlmods/OpenILS/Application.pm deleted file mode 100644 index cd4dbbf9c0..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application.pm +++ /dev/null @@ -1,73 +0,0 @@ -package OpenILS::Application; -use OpenSRF::Application; -use UNIVERSAL::require; -use base qw/OpenSRF::Application/; - -sub ils_version { - # version format is "x-y-z", for example "2-0-0" for Evergreen 2.0.0 - # For branches, format is "x-y" - return "HEAD"; -} - -__PACKAGE__->register_method( - api_name => 'opensrf.open-ils.system.ils_version', - api_level => 1, - method => 'ils_version', -); - -__PACKAGE__->register_method( - api_name => 'opensrf.open-ils.fetch_idl.file', - api_level => 1, - method => 'get_idl_file', -); -sub get_idl_file { - use OpenSRF::Utils::SettingsClient; - return OpenSRF::Utils::SettingsClient->new->config_value('IDL'); -} - -sub register_method { - my $class = shift; - my %args = @_; - my %dup_args = %args; - - $class = ref($class) || $class; - - $args{package} ||= $class; - __PACKAGE__->SUPER::register_method( %args ); - - if (exists($dup_args{authoritative}) and $dup_args{authoritative}) { - (my $name = $dup_args{api_name}) =~ s/$/.authoritative/o; - if ($name ne $dup_args{api_name}) { - $dup_args{real_api_name} = $dup_args{api_name}; - $dup_args{method} = 'authoritative_wrapper'; - $dup_args{api_name} = $name; - $dup_args{package} = __PACKAGE__; - __PACKAGE__->SUPER::register_method( %dup_args ); - } - } -} - -sub authoritative_wrapper { - - if (!$OpenILS::Utils::CStoreEditor::_loaded) { - die "Couldn't load OpenILS::Utils::CStoreEditor!" unless 'OpenILS::Utils::CStoreEditor'->use; - } - - my $self = shift; - my $client = shift; - my @args = @_; - - my $method = $self->method_lookup($self->{real_api_name}); - die unless $method; - - local $OpenILS::Utils::CStoreEditor::always_xact = 1; - - $client->respond( $_ ) for ( $method->run(@args) ); - - OpenILS::Utils::CStoreEditor->flush_forced_xacts(); - - return undef; -} - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq.pm deleted file mode 100644 index 04ba25485e..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Acq.pm +++ /dev/null @@ -1,15 +0,0 @@ -package OpenILS::Application::Acq; -use base qw/OpenILS::Application/; -use strict; use warnings; - -use OpenILS::Application::Acq::Picklist; -use OpenILS::Application::Acq::Financials; -use OpenILS::Application::Acq::Provider; -use OpenILS::Application::Acq::Lineitem; -use OpenILS::Application::Acq::Order; -use OpenILS::Application::Acq::EDI; -use OpenILS::Application::Acq::Search; -use OpenILS::Application::Acq::Claims; -use OpenILS::Application::Acq::Invoice; - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Claims.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq/Claims.pm deleted file mode 100644 index dba843cd88..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Claims.pm +++ /dev/null @@ -1,349 +0,0 @@ -package OpenILS::Application::Acq::Claims; -use base qw/OpenILS::Application/; -use strict; use warnings; - -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Application::AppUtils; -use OpenILS::Event; -my $U = 'OpenILS::Application::AppUtils'; - - -__PACKAGE__->register_method( - method => 'claim_ready_items', - api_name => 'open-ils.acq.claim.eligible.lineitem_detail', - stream => 1, - signature => { - desc => q/Locates lineitem_details that are eligible for claiming/, - params => [ - {desc => 'Authentication token', type => 'string'}, - { desc => q/ - Filter object. Filter keys include - purchase_order - lineitem - lineitem_detail - claim_policy_action - ordering_agency - /, - type => 'object' - }, - { desc => q/ - Flesh fields. Which fields to flesh on the response object. - For valid options, see the filter object - q/, - type => 'array' - } - ], - return => {desc => 'Claim ready data', type => 'object', class => 'acrlid'} - } -); - -sub claim_ready_items { - my($self, $conn, $auth, $filters, $flesh_fields, $limit, $offset) = @_; - - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - $filters ||= {}; - $flesh_fields ||= []; - $limit ||= 50; - $offset ||= 0; - - if(defined $filters->{ordering_agency}) { - return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $filters->{ordering_agency}); - } else { - $filters->{ordering_agency} = $U->user_has_work_perm_at($e, 'VIEW_PURCHASE_ORDER', {descendants => 1}); - } - - my $items = $e->search_acq_claim_ready_lineitem_detail([$filters, {limit => $limit, offset => $offset}]); - - my %cache; - for my $item (@$items) { - - # flesh from the flesh fields, using the cache when we can - foreach (@$flesh_fields) { - my $retrieve = "retrieve_acq_${_}"; - $cache{$_} = {} unless $cache{$_}; - $item->$_( - $cache{$_}{$item->$_} || - ($cache{$_}{$item->$_} = $e->$retrieve($item->$_)) - ); - } - - $conn->respond($item); - } - - return undef; -} - -__PACKAGE__->register_method( - method => "claim_item", - api_name => "open-ils.acq.claim.lineitem", - stream => 1, - signature => { - desc => q/Initiates a claim for a lineitem/, - params => [ - {desc => "Authentication token", type => "string"}, - {desc => "Lineitem ID", type => "number"}, - {desc => q/Claim (acqcl) ID. If defined, attach new claim - events to this existing claim object/, type => "number"}, - {desc => q/Claim Type (acqclt) ID. If defined (and no claim is - defined), create a new claim with this type/, type => "number"}, - {desc => "Note for the claim event", type => "string"}, - {desc => q/Optional: Claim Policy Actions. If not present, - claim events for all eligible claim policy actions will be - created. This is an array of acqclpa IDs./, - type => "array"}, - ], - return => { - desc => "The claim voucher events on success, Event on error", - type => "object", class => "acrlid" - } - } -); - -__PACKAGE__->register_method( - method => 'claim_item', - api_name => 'open-ils.acq.claim.lineitem_detail', - stream => 1, - signature => { - desc => q/Initiates a claim for an individual lineitem_detail/, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Lineitem Detail ID', type => 'number'}, - {desc => 'Claim (acqcl) ID. If defined, attach new claim events to this existing claim object', type => 'number'}, - {desc => 'Claim Type (acqclt) ID. If defined (and no claim is defined), create a new claim with this type', type => 'number'}, - {desc => "Note for the claim event", type => "string"}, - { desc => q/ - - Optional: Claim Policy Actions. If not present, claim events - for all eligible claim policy actions will be created. This is - an array of acqclpa ID's. - /, - type => 'array' - }, - { desc => q/ - Optional: Claim Event Types. If present, we bypass any policy configuration - and use the specified event types. This is useful for manual claiming against - items that have no claim policy. - /, - type => 'array' - } - ], - return => { - desc => "The claim voucher events on success, Event on error", - type => "object", class => "acrlid" - } - } -); - -sub claim_item { - my $self = shift; - my $conn = shift; - my $auth = shift; - my $object_id = shift; - my $claim_id = shift; - my $claim_type_id = shift; - my $note = shift; - my $policy_actions = shift; - - # if this claim occurs outside of a policy, allow the caller to specificy the event type - my $claim_event_types = shift; - - my $e = new_editor(xact => 1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - - my $evt; - my $claim; - my $claim_type; - my $claim_events = { - events => [], - trigger_stuff => [] - }; - - my $lid_flesh = { - "flesh" => 2, - "flesh_fields" => { - "acqlid" => ["lineitem"], "jub" => ["purchase_order"], - } - }; - - if($claim_id) { - $claim = $e->retrieve_acq_claim($claim_id) or return $e->die_event; - } elsif($claim_type_id) { - $claim_type = $e->retrieve_acq_claim_type($claim_type_id) or return $e->die_event; - } else { - $e->rollback; - return OpenILS::Event->new('BAD_PARAMS'); - } - - - my $lids; - if($self->api_name =~ /claim.lineitem_detail/) { - - $lids = $e->search_acq_lineitem_detail([ - {"id" => $object_id, "cancel_reason" => undef}, - $lid_flesh - ]) or return $e->die_event; - - } elsif($self->api_name =~ /claim.lineitem/) { - $lids = $e->search_acq_lineitem_detail([ - {"lineitem" => $object_id, "cancel_reason" => undef}, - $lid_flesh - ]) or return $e->die_event; - } - - foreach my $lid (@$lids) { - return $evt if - $evt = claim_lineitem_detail( - $e, $lid, $claim, $claim_type, $policy_actions, - $note, $claim_events, $claim_event_types - ); - } - - $e->commit; - - # create related A/T events - $U->create_events_for_hook('claim_event.created', $_->[0], $_->[1]) for @{$claim_events->{trigger_stuff}}; - - # do voucher rendering and return result - $conn->respond($U->fire_object_event( - undef, "format.acqcle.html", $_->[0], $_->[1], "print-on-demand" - )) foreach @{$claim_events->{trigger_stuff}}; - return undef; -} - -sub claim_lineitem_detail { - my($e, $lid, $claim, $claim_type, $policy_actions, $note, $claim_events, $claim_event_types) = @_; - - # Create the claim object - unless($claim) { - $claim = Fieldmapper::acq::claim->new; - $claim->lineitem_detail($lid->id); - $claim->type($claim_type->id); - $e->create_acq_claim($claim) or return $e->die_event; - } - - unless($claim_event_types) { - # user did not specify explicit event types - - unless($policy_actions) { - # user did not specifcy policy actions. find all eligible. - - my $list = $e->json_query({ - select => {acrlid => ['claim_policy_action']}, - from => 'acrlid', - where => {lineitem_detail => $lid->id} - }); - - $policy_actions = [map { $_->{claim_policy_action} } @$list]; - } - - # from the set of policy_action's, locate the related event types - # IOW, the policy action's action - $claim_event_types = []; - for my $act_id (@$policy_actions) { - my $action = $e->retrieve_acq_claim_policy_action($act_id) or return $e->die_event; - push(@$claim_event_types, $action->action); - } - } - - # for each eligible (or chosen) policy actions, create a claim_event - for my $event_type (@$claim_event_types) { - my $event = Fieldmapper::acq::claim_event->new; - $event->claim($claim->id); - $event->type($event_type); - $event->creator($e->requestor->id); - $event->note($note); - $e->create_acq_claim_event($event) or return $e->die_event; - push(@{$claim_events->{events}}, $event); - push(@{$claim_events->{trigger_stuff}}, [$event, $lid->lineitem->purchase_order->ordering_agency]); - } - - return undef; -} - - -__PACKAGE__->register_method( - method => "get_claim_voucher_by_lid", - api_name => "open-ils.acq.claim.voucher.by_lineitem_detail", - stream => 1, - signature => { - desc => q/Retrieve existing claim vouchers by lineitem detail ID/, - params => [ - {desc => "Authentication token", type => "string"}, - {desc => "Lineitem detail ID", type => "number"} - ], - return => { - desc => "Claim ready data", type => "object", class => "atev" - } - } -); - -sub get_claim_voucher_by_lid { - my ($self, $conn, $auth, $lid_id) = @_; - - my $e = new_editor("authtoken" => $auth); - return $e->die_event unless $e->checkauth; - - my $lid = $e->retrieve_acq_lineitem_detail([ - $lid_id, { - "flesh" => 2, - "flesh_fields" => { - "acqlid" => ["lineitem"], "jub" => ["purchase_order"] - } - } - ]); - - return $e->die_event unless $e->allowed( - "VIEW_PURCHASE_ORDER", $lid->lineitem->purchase_order->ordering_agency - ); - - my $id_list = $e->json_query({ - "select" => {"atev" => ["id"]}, - "from" => { - "atev" => { - "atevdef" => {"field" => "id", "fkey" => "event_def"}, - "acqcle" => { - "field" => "id", "fkey" => "target", - "join" => { - "acqcl" => { - "field" => "id", "fkey" => "claim", - "join" => { - "acqlid" => { - "fkey" => "lineitem_detail", - "field" => "id" - } - } - } - } - } - } - }, - "where" => { - "-and" => { - "+atevdef" => {"hook" => "format.acqcle.html"}, - "+acqlid" => {"id" => $lid_id} - } - } - }) or return $e->die_event; - - if ($id_list && @$id_list) { - foreach (@$id_list) { - $conn->respond( - $e->retrieve_action_trigger_event([ - $_->{"id"}, { - "flesh" => 1, - "flesh_fields" => {"atev" => ["template_output"]} - } - ]) - ); - } - } - - $e->disconnect; - undef; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm deleted file mode 100644 index 3fc0883f3c..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm +++ /dev/null @@ -1,828 +0,0 @@ -package OpenILS::Application::Acq::EDI; -use base qw/OpenILS::Application/; - -use strict; use warnings; - -use IO::Scalar; - -use OpenSRF::AppSession; -use OpenSRF::EX qw/:try/; -use OpenSRF::Utils::Logger qw(:logger); -use OpenSRF::Utils::JSON; - -use OpenILS::Application::Acq::Lineitem; -use OpenILS::Utils::RemoteAccount; -use OpenILS::Utils::CStoreEditor q/new_editor/; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Application::Acq::EDI::Translator; - -use Business::EDI; - -use Data::Dumper; -our $verbose = 0; - -sub new { - my($class, %args) = @_; - my $self = bless(\%args, $class); - # $self->{args} = {}; - return $self; -} - -# our $reasons = {}; # cache for acq.cancel_reason rows ? - -our $translator; - -sub translator { - return $translator ||= OpenILS::Application::Acq::EDI::Translator->new(@_); -} - -my %map = ( - host => 'remote_host', - username => 'remote_user', - password => 'remote_password', - account => 'remote_account', - # in_dir => 'remote_path', # field_map overrides path with in_dir - path => 'remote_path', -); - - -## Just for debugging stuff: -sub add_a_msg { - my ($self, $conn) = @_; - my $e = new_editor(xact=>1); - my $incoming = Fieldmapper::acq::edi_message->new; - $incoming->edi("This is content"); - $incoming->account(1); - $incoming->remote_file('in/some_file.edi'); - $e->create_acq_edi_message($incoming);; - $e->commit; -} -# __PACKAGE__->register_method( method => 'add_a_msg', api_name => 'open-ils.acq.edi.add_a_msg'); # debugging - -__PACKAGE__->register_method( - method => 'retrieve', - api_name => 'open-ils.acq.edi.retrieve', - authoritative => 1, - signature => { - desc => 'Fetch incoming message(s) from EDI accounts. ' . - 'Optional arguments to restrict to one vendor and/or a max number of messages. ' . - 'Note that messages are not parsed or processed here, just fetched and translated.', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Vendor ID (undef for "all")', type => 'number'}, - {desc => 'Date Inactive Since', type => 'string'}, - {desc => 'Max Messages Retrieved', type => 'number'} - ], - return => { - desc => 'List of new message IDs (empty if none)', - type => 'array' - } - } -); - -sub retrieve_core { - my ($self, $set, $max, $e, $test) = @_; # $e is a working editor - - $e ||= new_editor(); - $set ||= __PACKAGE__->retrieve_vendors($e); - - my @return = (); - my $vcount = 0; - foreach my $account (@$set) { - my $count = 0; - my $server; - $logger->info("EDI check for vendor " . ++$vcount . " of " . scalar(@$set) . ": " . $account->host); - unless ($server = __PACKAGE__->remote_account($account)) { # assignment, not comparison - $logger->err(sprintf "Failed remote account mapping for %s (%s)", $account->host, $account->id); - next; - }; -# my $rf_starter = './'; # default to current dir - if ($account->in_dir) { - if ($account->in_dir =~ /\*+.*\//) { - $logger->err("EDI in_dir has a slash after an asterisk in value: '" . $account->in_dir . "'. Skipping account with indeterminate target dir!"); - next; - } -# $rf_starter = $account->in_dir; -# $rf_starter =~ s/((\/)?[^\/]*)\*+[^\/]*$//; # kill up to the first (possible) slash before the asterisk: keep the preceeding static dir -# $rf_starter .= '/' if $rf_starter or $2; # recap the dir, or replace leading "/" if there was one (but don't add if empty) - } - my @files = ($server->ls({remote_file => ($account->in_dir || './')})); - my @ok_files = grep {$_ !~ /\/\.?\.$/ and $_ ne '0'} @files; - $logger->info(sprintf "%s of %s files at %s/%s", scalar(@ok_files), scalar(@files), $account->host, $account->in_dir); - # $server->remote_path(undef); - foreach my $remote_file (@ok_files) { - # my $remote_file = $rf_starter . $_; - my $description = sprintf "%s/%s", $account->host, $remote_file; - - # deduplicate vs. acct/filenames already in DB - my $hits = $e->search_acq_edi_message([ - { - account => $account->id, - remote_file => $remote_file, - status => {'in' => [qw/ processed /]}, # if it never got processed, go ahead and get the new one (try again) - # create_time => 'NOW() - 60 DAYS', # if we wanted to allow filenames to be reused after a certain time - # ideally we would also use the date from FTP, but that info isn't available via RemoteAccount - } - # { flesh => 1, flesh_fields => {...}, } - ]); - if (scalar(@$hits)) { - $logger->debug("EDI: $remote_file already retrieved. Skipping"); - warn "EDI: $remote_file already retrieved. Skipping"; - next; - } - - ++$count; - $max and $count > $max and last; - $logger->info(sprintf "%s of %s targets: %s", $count, scalar(@ok_files), $description); - print sprintf "%s of %s targets: %s\n", $count, scalar(@ok_files), $description; - if ($test) { - push @return, "test_$count"; - next; - } - my $content; - my $io = IO::Scalar->new(\$content); - unless ( $server->get({remote_file => $remote_file, local_file => $io}) ) { - $logger->error("(S)FTP get($description) failed"); - next; - } - my $incoming = __PACKAGE__->process_retrieval($content, $remote_file, $server, $account->id, $e); -# $server->delete(remote_file => $_); # delete remote copies of saved message - push @return, $incoming->id; - } - } - return \@return; -} - -# my $in = OpenILS::Application::Acq::EDI->process_retrieval($file_content, $remote_filename, $server, $account_id, $editor); - -sub process_retrieval { - my $incoming = Fieldmapper::acq::edi_message->new; - my ($class, $content, $remote, $server, $account_or_id, $e) = @_; - $content or return; - $e ||= new_editor; - - my $account = __PACKAGE__->record_activity( $account_or_id, $e ); - - my $z; # must predeclare - $z = ( $content =~ s/('UNH\+\d+\+ORDRSP:)0(:96A:UN')/$1D$2/g ) - and $logger->warn("Patching bogus spec reference ORDRSP:0:96A:UN => ORDRSP:D:96A:UN ($z times)"); # Hack/fix some faulty "0" in (B&T) data - - $incoming->remote_file($remote); - $incoming->account($account->id); - $incoming->edi($content); - $incoming->message_type(($content =~ /'UNH\+\d+\+(\S{6}):/) ? $1 : 'ORDRSP'); # cheap sniffing, ORDRSP fallback - __PACKAGE__->attempt_translation($incoming); - $e->xact_begin; - $e->create_acq_edi_message($incoming); - $e->xact_commit; - # refresh: send process_jedi the updated row - $e->xact_begin; - my $outgoing = $e->retrieve_acq_edi_message($incoming->id); # refresh again! - $e->xact_rollback; - my $res = __PACKAGE__->process_jedi($outgoing, $server, $account, $e); - $e->xact_begin; - $outgoing = $e->retrieve_acq_edi_message($incoming->id); # refresh again! - $e->xact_rollback; - $outgoing->status($res ? 'processed' : 'proc_error'); - if ($res) { - $e->xact_begin; - $e->update_acq_edi_message($outgoing); - $e->xact_commit; - } - return $outgoing; -} - -# ->send_core -# $account is a Fieldmapper object for acq.edi_account row -# $messageset is an arrayref with acq.edi_message.id values -# $e is optional editor object -sub send_core { - my ($class, $account, $message_ids, $e) = @_; # $e is a working editor - - ($account and scalar @$message_ids) or return; - $e ||= new_editor(); - - $e->xact_begin; - my @messageset = map {$e->retrieve_acq_edi_message($_)} @$message_ids; - $e->xact_rollback; - my $m_count = scalar(@messageset); - (scalar(@$message_ids) == $m_count) or - $logger->warn(scalar(@$message_ids) - $m_count . " bad IDs passed to send_core (ignored)"); - - my $log_str = sprintf "EDI send to edi_account %s (%s)", $account->id, $account->host; - $logger->info("$log_str: $m_count message(s)"); - $m_count or return; - - my $server; - my $server_error; - unless ($server = __PACKAGE__->remote_account($account, 1)) { # assignment, not comparison - $logger->error("Failed remote account connection for $log_str"); - $server_error = 1; - }; - foreach (@messageset) { - $_ or next; # we already warned about bum ids - my ($res, $error); - if ($server_error) { - $error = "Server error: Failed remote account connection for $log_str"; # already told $logger, this is to update object below - } elsif (! $_->edi) { - $logger->error("Message (id " . $_->id. ") for $log_str has no EDI content"); - $error = "EDI empty!"; - } elsif ($res = $server->put({remote_path => $account->path, content => $_->edi, single_ext => 1})) { - # This is the successful case! - $_->remote_file($res); - $_->status('complete'); - $_->process_time('NOW'); # For outbound files, sending is the end of processing on the EG side. - $logger->info("Sent message (id " . $_->id. ") via $log_str"); - } else { - $logger->error("(S)FTP put to $log_str FAILED: " . ($server->error || 'UNKOWNN')); - $error = "put FAILED: " . ($server->error || 'UNKOWNN'); - } - if ($error) { - $_->error($error); - $_->error_time('NOW'); - } - $logger->info("Calling update_acq_edi_message"); - $e->xact_begin; - unless ($e->update_acq_edi_message($_)) { - $logger->error("EDI send_core update_acq_edi_message failed for message object: " . Dumper($_)); - OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_ ), '/tmp/update_acq_edi_message.FAIL'); - OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_->to_bare_hash), '/tmp/update_acq_edi_message.FAIL.to_bare_hash'); - } - # There's always an update, even if we failed. - $e->xact_commit; - __PACKAGE__->record_activity($account, $e); # There's always an update, even if we failed. - } - return \@messageset; -} - -# attempt_translation does not touch the DB, just the object. -sub attempt_translation { - my ($class, $edi_message, $to_edi) = @_; - my $tran = translator(); - my $ret = $to_edi ? $tran->json2edi($edi_message->jedi) : $tran->edi2json($edi_message->edi); -# $logger->error("json: " . Dumper($json)); # debugging - if (not $ret or (! ref($ret)) or $ret->is_fault) { # RPC::XML::fault on failure - $edi_message->status('trans_error'); - $edi_message->error_time('NOW'); - my $pre = "EDI Translator " . ($to_edi ? 'json2edi' : 'edi2json') . " failed"; - my $message = ref($ret) ? - ("$pre, Error " . $ret->code . ": " . __PACKAGE__->nice_string($ret->string)) : - ("$pre: " . __PACKAGE__->nice_string($ret) ) ; - $edi_message->error($message); - $logger->error( $message); - return; - } - $edi_message->status('translated'); - $edi_message->translate_time('NOW'); - if ($to_edi) { - $edi_message->edi($ret->value); # translator returns an object - } else { - $edi_message->jedi($ret->value); # translator returns an object - } - return $edi_message; -} - -sub retrieve_vendors { - my ($self, $e, $vendor_id, $last_activity) = @_; # $e is a working editor - - $e ||= new_editor(); - - my $criteria = {'+acqpro' => {active => 't'}}; - $criteria->{'+acqpro'}->{id} = $vendor_id if $vendor_id; - return $e->search_acq_edi_account([ - $criteria, { - 'join' => 'acqpro', - flesh => 1, - flesh_fields => { - acqedi => ['provider'] - } - } - ]); -# {"id":{"!=":null},"+acqpro":{"active":"t"}}, {"join":"acqpro", "flesh_fields":{"acqedi":["provider"]},"flesh":1} -} - -# This is the SRF-exposed call, so it does checkauth - -sub retrieve { - my ($self, $conn, $auth, $vendor_id, $last_activity, $max) = @_; - - my $e = new_editor(authtoken=>$auth); - unless ($e and $e->checkauth()) { - $logger->warn("checkauth failed for authtoken '$auth'"); - return (); - } - # return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency); # add permission here ? - - my $set = __PACKAGE__->retrieve_vendors($e, $vendor_id, $last_activity) or return $e->die_event; - return __PACKAGE__->retrieve_core($e, $set, $max); -} - - -# field_map takes the hashref of vendor data with fields from acq.edi_account and -# maps them to the argument style needed for RemoteAccount. It also extrapolates -# data from the remote_host string for type and port, when available. - -sub field_map { - my $self = shift; - my $vendor = shift or return; - my $no_override = @_ ? shift : 0; - my %args = (); - $verbose and $logger->warn("vendor: " . Dumper($vendor)); - foreach (keys %map) { - $args{$map{$_}} = $vendor->$_ if defined $vendor->$_; - } - unless ($no_override) { - $args{remote_path} = $vendor->in_dir; # override "path" with "in_dir" - } - my $host = $args{remote_host} || ''; - ($host =~ s/^(S?FTP)://i and $args{type} = uc($1)) or - ($host =~ s/^(SSH|SCP)://i and $args{type} = 'SCP' ) ; - $host =~ s/:(\d+)$// and $args{port} = $1; - ($args{remote_host} = $host) =~ s#/+##; - $verbose and $logger->warn("field_map: " . Dumper(\%args)); - return %args; -} - - -# The point of remote_account is to get the RemoteAccount object with args from the DB - -sub remote_account { - my ($self, $vendor, $outbound, $e) = @_; - - unless (ref($vendor)) { # It's not a hashref/object. - $vendor or return; # If in fact it's nothing: abort! - # else it's a vendor_id string, so get the full vendor data - $e ||= new_editor(); - my $set_of_one = $self->retrieve_vendors($e, $vendor) or return; - $vendor = shift @$set_of_one; - } - - return OpenILS::Utils::RemoteAccount->new( - $self->field_map($vendor, $outbound) - ); -} - -# takes account ID or account Fieldmapper object - -sub record_activity { - my ($class, $account_or_id, $e) = @_; - $account_or_id or return; - $e ||= new_editor(); - my $account = ref($account_or_id) ? $account_or_id : $e->retrieve_acq_edi_account($account_or_id); - $logger->info("EDI record_activity calling update_acq_edi_account"); - $account->last_activity('NOW') or return; - $e->xact_begin; - $e->update_acq_edi_account($account) or $logger->warn("EDI: in record_activity, update_acq_edi_account FAILED"); - $e->xact_commit; - return $account; -} - -sub nice_string { - my $class = shift; - my $string = shift or return ''; - chomp($string); - my $head = @_ ? shift : 100; - my $tail = @_ ? shift : 25; - (length($string) < $head + $tail) and return $string; - my $h = substr($string,0,$head); - my $t = substr($string, -1*$tail); - $h =~s/\s*$//o; - $t =~s/\s*$//o; - return "$h ... $t"; - # return substr($string,0,$head) . "... " . substr($string, -1*$tail); -} - -sub jedi2perl { - my ($class, $jedi) = @_; - $jedi or return; - my $msg = OpenSRF::Utils::JSON->JSON2perl( $jedi ); - open (FOO, ">>/tmp/JSON2perl_dump.txt"); - print FOO Dumper($msg), "\n\n"; - close FOO; - $logger->warn("Dumped JSON2perl to /tmp/JSON2perl_dump.txt"); - return $msg; -} - -our @datecodes = (35, 359, 17, 191, 69, 76, 75, 79, 85, 74, 84, 223); -our @noop_6063 = (21); - -# ->process_jedi($message, $server, $remote, $e) -# $message is an edi_message object -# -sub process_jedi { - my ($class, $message, $server, $remote, $e) = @_; - $message or return; - $server ||= {}; # context - $remote ||= {}; # context - $e ||= new_editor; - my $jedi; - unless (ref($message) and $jedi = $message->jedi) { # assignment, not comparison - $logger->warn("EDI process_jedi missing required argument (edi_message object with jedi)!"); - return; - } - my $perl = __PACKAGE__->jedi2perl($jedi); - my $error = ''; - if (ref($message) and not $perl) { - $error = ($message->error || '') . " JSON2perl (jedi2perl) FAILED to convert jedi"; - } - elsif (! $perl->{body}) { - $error = "EDI interchange body not found!"; - } - elsif (! $perl->{body}->[0]) { - $error = "EDI interchange body not a populated arrayref!"; - } - if ($error) { - $logger->warn($error); - $message->error($error); - $message->error_time('NOW'); - $e->xact_begin; - $e->update_acq_edi_message($message) or $logger->warn("EDI update_acq_edi_message failed! $!"); - $e->xact_commit; - return; - } - -# Crazy data structure. Most of the arrays will be 1 element... we think. -# JEDI looks like: -# {'body' => [{'ORDERS' => [['UNH',{'0062' => '4635','S009' => {'0057' => 'EAN008','0051' => 'UN','0052' => 'D','0065' => 'ORDERS', ... -# -# So you might access it like: -# $obj->{body}->[0]->{ORDERS}->[0]->[0] eq 'UNH' - - $logger->info("EDI interchange body has " . scalar(@{$perl->{body}}) . " message(s)"); - my @ok_msg_codes = qw/ORDRSP OSTRPT/; - my @messages; - my $i = 0; - foreach my $part (@{$perl->{body}}) { - $i++; - unless (ref $part and scalar keys %$part) { - $logger->warn("EDI interchange message $i lacks structure. Skipping it."); - next; - } - foreach my $key (keys %$part) { - if (! grep {$_ eq $key} @ok_msg_codes) { # We only do one type for now. TODO: other types here - $logger->warn("EDI interchange $i contains unhandled '$key' message. Ignoring it."); - next; - } - my $msg = __PACKAGE__->message_object($part->{$key}) or next; - push @messages, $msg; - - my $bgm = $msg->xpath('BGM') or $logger->warn("EDI No BGM segment found?!"); - my $tag4343 = $msg->xpath('BGM/4343'); - my $tag1225 = $msg->xpath('BGM/1225'); - if (ref $tag4343) { - $logger->info(sprintf "EDI $key BGM/4343 Response Type: %s - %s", $tag4343->value, $tag4343->label) - } else { - $logger->warn("EDI $key BGM/4343 Response Type Code unrecognized"); # next; #? - } - if (ref $tag1225) { - $logger->info(sprintf "EDI $key BGM/1225 Message Function: %s - %s", $tag1225->value, $tag1225->label); - } else { - $logger->warn("EDI $key BGM/1225 Message Function Code unrecognized"); # next; #? - } - - # TODO: currency check, just to be paranoid - # *should* be unnecessary (vendor should reply in currency we send in ORDERS) - # That begs a policy question: how to handle mismatch? convert (bad accuracy), reject, or ignore? I say ignore. - - # ALL those codes below are basically some form of (lastest) delivery date/time - # see, e.g.: http://www.stylusstudio.com/edifact/D04B/2005.htm - # The order is the order of definitiveness (first match wins) - # Note: if/when we do serials via EDI, dates (and ranges/periods) will need massive special handling - my @dates; - my $ddate; - - foreach my $date ($msg->xpath('delivery_schedule')) { - my $val_2005 = $date->xpath_value('DTM/2005') or next; - (grep {$val_2005 eq $_} @datecodes) or next; # no match means some other kind of date we don't care about - push @dates, $date; - } - if (@dates) { - DATECODE: foreach my $dcode (@datecodes) { # now cycle back through hits in order of dcode definitiveness - foreach my $date (@dates) { - $date->xpath_value('DTM/2005') == $dcode or next; - $ddate = $date->xpath_value('DTM/2380') and last DATECODE; - # TODO: conversion based on format specified in DTM/2379 (best encapsulated in Business::EDI) - } - } - } - foreach my $detail ($msg->part('line_detail')) { - my $eg_line = __PACKAGE__->eg_li($detail, $remote, $server->{remote_host}, $e) or next; - my $li_date = $detail->xpath_value('DTM/2380') || $ddate; - my $price = $detail->xpath_value('line_price/PRI/5118') || ''; - $eg_line->expected_recv_time($li_date) if $li_date; - $eg_line->estimated_unit_price($price) if $price; - if (not $message->purchase_order) { # first good lineitem sets the message PO link - $message->purchase_order($eg_line->purchase_order); # EG $message object NOT Business::EDI $msg object - $e->xact_begin; - $e->update_acq_edi_message($message) or $logger->warn("EDI update_acq_edi_message (for PO number) failed! $!"); - $e->xact_commit; - } - # $e->search_acq_edi_account([]); - my $touches = 0; - my $eg_lids = $e->search_acq_lineitem_detail({lineitem => $eg_line->id}); # should be the same as $eg_line->lineitem_details - my $lidcount = scalar(@$eg_lids); - $lidcount == $eg_line->item_count or $logger->warn( - sprintf "EDI: LI %s itemcount (%d) mismatch, %d LIDs found", $eg_line->id, $eg_line->item_count, $lidcount - ); - foreach my $qty ($detail->part('all_QTY')) { - my $ubound = $qty->xpath_value('6060') or next; # nothing to do if qty is 0 - my $val_6063 = $qty->xpath_value('6063'); - $ubound > 0 or next; # don't be crazy! - if (! $val_6063) { - $logger->warn("EDI: Response for LI " . $eg_line->id . " specifies quantity $ubound with no 6063 code! Contact vendor to resolve."); - next; - } - - my $eg_reason = $e->retrieve_acq_cancel_reason(1200 + $val_6063); # DB populated w/ 6063 keys in 1200's - if (! $eg_reason) { - $logger->warn("EDI: Unhandled quantity code '$val_6063' (LI " . $eg_line->id . ") $ubound items unprocessed"); - next; - } elsif (grep {$val_6063 == $_} @noop_6063) { # an FYI like "ordered quantity" - $ubound eq $lidcount - or $logger->warn("EDI: LI " . $eg_line->id . " -- Vendor says we ordered $ubound, but we have $lidcount LIDs!)"); - next; - } - # elsif ($val_6063 == 83) { # backorder - #} elsif ($val_6063 == 85) { # cancel - #} elsif ($val_6063 == 12 or $val_6063 == 57 or $val_6063 == 84 or $val_6063 == 118) { - # despatched, in transit, urgent delivery, or quantity manifested - #} - if ($touches >= $lidcount) { - $logger->warn("EDI: LI " . $eg_line->id . ", We already updated $touches of $lidcount LIDS, " . - "but message wants QTY $ubound more set to " . $eg_reason->label . ". Ignoring!"); - next; - } - $e->xact_begin; - foreach (1 .. $ubound) { - my $eg_lid = shift @$eg_lids or $logger->warn("EDI: Used up all $lidcount LIDs! Ignoring extra status " . $eg_reason->label); - $eg_lid or next; - $logger->debug(sprintf "Updating LID %s to %s", $eg_lid->id, $eg_reason->label); - $eg_lid->cancel_reason($eg_reason->id); - $e->update_acq_lineitem_detail($eg_lid); - $touches++; - } - $e->xact_commit; - if ($ubound == $eg_line->item_count) { - $eg_line->cancel_reason($eg_reason->id); # if ALL the items have the same cancel_reason, the PO gets it too - } - } - $eg_line->edit_time('NOW'); # TODO: have this field automatically updated via ON UPDATE trigger. - $e->xact_begin; - $e->update_acq_lineitem($eg_line) or $logger->warn("EDI: update_acq_lineitem FAILED"); - $e->xact_commit; - # print STDERR "Lineitem update: ", Dumper($eg_line); - } - } - } - return \@messages; -} - -# returns message object if processing should continue -# returns false/undef value if processing should abort - -sub message_object { - my $class = shift; - my $body = shift or return; - my $key = shift if @_; - my $keystring = $key || 'UNSPECIFIED'; - - my $msg = Business::EDI::Message->new($body); - unless ($msg) { - $logger->error("EDI interchange message: $keystring body failed Business::EDI constructor. Skipping it."); - return; - } - $key = $msg->code if ! $key; # Now we set the key for reference if it wasn't specified - my $val_0065 = $msg->xpath_value('UNH/S009/0065') || ''; - unless ($val_0065 eq $key) { - $logger->error("EDI $key UNH/S009/0065 ('$val_0065') conflicts w/ message type $key. Aborting"); - return; - } - my $val_0051 = $msg->xpath_value('UNH/S009/0051') || ''; - unless ($val_0051 eq 'UN') { - $logger->warn("EDI $key UNH/S009/0051 designates '$val_0051', not 'UN' as controlling agency. Attempting to process anyway"); - } - my $val_0054 = $msg->xpath_value('UNH/S009/0054') || ''; - if ($val_0054) { - $logger->info("EDI $key UNH/S009/0054 uses Spec revision version '$val_0054'"); - # Possible Spec Version limitation - # my $yy = $tag_0054 ? substr($val_0054,0,2) : ''; - # unless ($yy eq '00' or $yy > 94 ...) { - # $logger->warn("EDI $key UNH/S009/0051 Spec revision version '$val_0054' not supported"); - # } - } else { - $logger->warn("EDI $key UNH/S009/0054 does not reference a known Spec revision version"); - } - return $msg; -} - -=head2 ->eg_li($lineitem_object, [$remote, $server_log_string, $editor]) - -my $line_item = OpenILS::Application::Acq::EDI->eg_li($edi_line, $remote, "test_server_01", $e); - - $remote is a acq.edi_account Fieldmapper object. - $server_log_string is an arbitrary string use to identify the remote host in potential log messages. - -Updates: - acq.lineitem.estimated_unit_price, - acq.lineitem.state (dependent on mapping codes), - acq.lineitem.expected_recv_time, - acq.lineitem.edit_time (consequently) - -=cut - -sub eg_li { - my ($class, $line, $server, $server_log_string, $e) = @_; - $line or return; - $e ||= new_editor(); - - my $id; - # my $rff = $line->part('line_reference/RFF') or $logger->warn("EDI ORDRSP line_detail/RFF missing!"); - my $val_1153 = $line->xpath_value('line_reference/RFF/1153') || ''; - my $val_1154 = $line->xpath_value('line_reference/RFF/1154') || ''; - my $val_1082 = $line->xpath_value('LIN/1082') || ''; - - my @po_nums; - - $val_1154 =~ s#^(.*)\/##; # Many sources send the ID as 'order_ID/LI_ID' - $1 and push @po_nums, $1; - $val_1082 =~ s#^(.*)\/##; # Many sources send the ID as 'order_ID/LI_ID' - $1 and push @po_nums, $1; - - # TODO: possible check of po_nums - # now do a lot of checking - - if ($val_1153 eq 'LI') { - $id = $val_1154 or $logger->warn("EDI ORDRSP RFF/1154 reference to LI empty. Attempting failover to LIN/1082"); - } else { - $logger->warn("EDI ORDRSP RFF/1153 unexpected value ('$val_1153', not 'LI'). Attempting failover to LIN/1082"); - } - - # FIXME - the line item ID in LIN/1082 ought to match RFF/1154, but - # not all materials vendors obey this. Commenting out check for now - # as being too strict. - #if ($id and $val_1082 and $val_1082 ne $id) { - # $logger->warn("EDI ORDRSP LIN/1082 Line Item ID mismatch ($id vs. $val_1082): cannot target update"); - # return; - #} - - $id ||= $val_1082 || ''; - if ($id eq '') { - $logger->warn('Cannot identify line item from EDI message'); - return; - } - - $logger->info("EDI retrieve/update lineitem $id"); - - my $li = OpenILS::Application::Acq::Lineitem::retrieve_lineitem_impl($e, $id, { - flesh_li_details => 1, - }, 1); # Could send more {options}. The 1 is for no_auth. - - if (! $li or ref($li) ne 'Fieldmapper::acq::lineitem') { - $logger->error("EDI failed to retrieve lineitem by id '$id' for server $server_log_string"); - return; - } - unless ((! $server) or (! $server->provider)) { # but here we want $server to be acq.edi_account instead of RemoteAccount - if ($server->provider != $li->provider) { - # links go both ways: acq.provider.edi_default and acq.edi_account.provider - $logger->info("EDI acct provider (" . $server->provider. ") doesn't match lineitem provider(" - . $li->provider . "). Checking acq.provider.edi_default..."); - my $provider = $e->retrieve_acq_provider($li->provider); - if ($provider->edi_default != $server->id) { - $logger->error(sprintf "EDI provider/acct %s/%s (%s) is blocked from updating lineitem $id belonging to provider/edi_default %s/%s", - $server->provider, $server->id, $server->label, $li->provider, $provider->edi_default); - return; - } - } - } - - my @lin_1229 = $line->xpath('LIN/1229') or $logger->warn("EDI LIN/1229 Action Code missing!"); - my $key = $lin_1229[0] or return; - - my $eg_reason = $e->retrieve_acq_cancel_reason(1000 + $key->value); # DB populated w/ spec keys in 1000's - $eg_reason or $logger->warn(sprintf "EDI LIN/1229 Action Code '%s' (%s) not recognized in acq.cancel_reason", $key->value, $key->label); - $eg_reason or return; - - $li->cancel_reason($eg_reason->id); - unless ($eg_reason->keep_debits) { - $logger->warn("EDI LIN/1229 Action Code '%s' (%s) has keep_debits=0", $key->value, $key->label); - } - - my @prices = $line->xpath_value("line_price/PRI/5118"); - $li->estimated_unit_price($prices[0]) if @prices; - - return $li; -} - -# caching not needed for now (edi_fetcher is asynchronous) -# sub get_reason { -# my ($class, $key, $e) = @_; -# $reasons->{$key} and return $reasons->{$key}; -# $e ||= new_editor(); -# $reasons->{$key} = $e->retrieve_acq_cancel_reason($key); -# return $reasons->{$key}; -# } - -1; - -__END__ - -Example JSON data. - -Note the pseudo-hash 2-element arrays. - -[ - 'SG26', - [ - [ - 'LIN', - { - '1229' => '5', - '1082' => 1, - 'C212' => { - '7140' => '9780446360272', - '7143' => 'EN' - } - } - ], - [ - 'IMD', - { - '7081' => 'BST', - '7077' => 'F', - 'C273' => { - '7008' => [ - 'NOT APPLIC WEBSTERS NEW WORLD THESA' - ] - } - } - ], - [ - 'QTY', - { - 'C186' => { - '6063' => '21', - '6060' => 10 - } - } - ], - [ - 'QTY', - { - 'C186' => { - '6063' => '12', - '6060' => 10 - } - } - ], - [ - 'QTY', - { - 'C186' => { - '6063' => '85', - '6060' => 0 - } - } - ], - [ - 'FTX', - { - '4451' => 'LIN', - 'C107' => { - '4441' => '01', - '3055' => '28', - '1131' => '8B' - } - } - ], - [ - 'SG30', - [ - [ - 'PRI', - { - 'C509' => { - '5118' => '4.5', - '5387' => 'SRP', - '5125' => 'AAB' - } - } - ] - ] - ], - [ - 'SG31', - [ - [ - 'RFF', - { - 'C506' => { - '1154' => '8/1', - '1153' => 'LI' - } - } - ] - ] - ] - ] -], - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI/Translator.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI/Translator.pm deleted file mode 100644 index 160fd01318..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI/Translator.pm +++ /dev/null @@ -1,82 +0,0 @@ -package OpenILS::Application::Acq::EDI::Translator; - -use warnings; -use strict; - -use RPC::XML::Client; -use Data::Dumper; - -# DEFAULTS -my $proto = 'http://'; -my $host = $proto . 'localhost'; -my $path = '/EDI'; -my $port = 9191; -my $verbose = 0; - -sub new { - my ($class, %args) = @_; - my $self = bless(\%args, $class); - $self->init; - return $self; -} - -sub init { - my $self = shift; - $self->host_cleanup; -} - -sub host_cleanup { - my $self = shift; - my $target = $self->{host} || $host; - $target =~ /^\S+:\/\// or $target = ($self->{proto} || $proto) . $target; - $target =~ /:\d+$/ or $target .= ':' . ($self->{port} || $port); - $target .= ($self->{path} || $path); - $self->{verbose} and print "Cleanup: $self->{host} ==> $target\n"; - $self->{host} = $target; - return $target; -} - -sub client { - my $self = shift; - return $self->{client} ||= RPC::XML::Client->new($self->{host}); # TODO: auth -} - -sub debug_file { - my $self = shift; - my $text = shift; - my $filename = @_ ? shift : ('/tmp/' . __PACKAGE__ . '_unknown.tmp'); - unless (open (TMP_EDI, ">$filename")) { - warn "Cannot write $filename: $!"; - return; - } - print TMP_EDI $text, "\n"; - close TMP_EDI; - return 1; -} - -sub json2edi { - my $self = shift; - my $text = shift; - $self->debug_file($text, '/tmp/perl_json2edi.tmp'); - my $client = $self->client(); - $self->{verbose} and print "Trying json2edi on host: $self->{host}\n"; - $client->request->header('Content-Type' => 'text/xml;charset=utf-8'); - my $resp = $client->send_request('json2edi', $text); - $self->{verbose} and print Dumper($resp); - return $resp; -} - -sub edi2json { - my $self = shift; - my $text = shift; - $self->debug_file($text, '/tmp/perl_edi2json.tmp'); - my $client = $self->client(); - $self->{verbose} and print "Trying edi2json on host: $self->{host}\n"; - $client->request->header('Content-Type' => 'text/xml;charset=utf-8'); - my $resp = $client->send_request('edi2json', $text); - $self->{verbose} and print Dumper($resp); - return $resp; -} - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Financials.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq/Financials.pm deleted file mode 100644 index acdcd31cb8..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Financials.pm +++ /dev/null @@ -1,1356 +0,0 @@ -package OpenILS::Application::Acq::Financials; -use base qw/OpenILS::Application/; -use strict; use warnings; - -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Const qw/:const/; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Event; -use OpenILS::Application::AppUtils; -use OpenILS::Application::Acq::Lineitem; -my $U = 'OpenILS::Application::AppUtils'; - -# ---------------------------------------------------------------------------- -# Funding Sources -# ---------------------------------------------------------------------------- - -__PACKAGE__->register_method( - method => 'create_funding_source', - api_name => 'open-ils.acq.funding_source.create', - signature => { - desc => 'Creates a new funding_source', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'funding source object to create', type => 'object'} - ], - return => {desc => 'The ID of the new funding_source'} - } -); - -sub create_funding_source { - my($self, $conn, $auth, $funding_source) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('ADMIN_FUNDING_SOURCE', $funding_source->owner); - $e->create_acq_funding_source($funding_source) or return $e->die_event; - $e->commit; - return $funding_source->id; -} - - -__PACKAGE__->register_method( - method => 'delete_funding_source', - api_name => 'open-ils.acq.funding_source.delete', - signature => { - desc => 'Deletes a funding_source', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'funding source ID', type => 'number'} - ], - return => {desc => '1 on success, Event on failure'} - } -); - -sub delete_funding_source { - my($self, $conn, $auth, $funding_source_id) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $funding_source = $e->retrieve_acq_funding_source($funding_source_id) or return $e->die_event; - return $e->die_event unless $e->allowed('ADMIN_FUNDING_SOURCE', $funding_source->owner, $funding_source); - $e->delete_acq_funding_source($funding_source) or return $e->die_event; - $e->commit; - return 1; -} - -__PACKAGE__->register_method( - method => 'retrieve_funding_source', - api_name => 'open-ils.acq.funding_source.retrieve', - authoritative => 1, - signature => { - desc => 'Retrieves a new funding_source', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'funding source ID', type => 'number'} - ], - return => {desc => 'The funding_source object on success, Event on failure'} - } -); - -sub retrieve_funding_source { - my($self, $conn, $auth, $funding_source_id, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - $options ||= {}; - - my $flesh = {flesh => 1, flesh_fields => {acqfs => []}}; - push(@{$flesh->{flesh_fields}->{acqfs}}, 'credits') if $$options{flesh_credits}; - push(@{$flesh->{flesh_fields}->{acqfs}}, 'allocations') if $$options{flesh_allocations}; - - my $funding_source = $e->retrieve_acq_funding_source([$funding_source_id, $flesh]) or return $e->event; - - return $e->event unless $e->allowed( - ['ADMIN_FUNDING_SOURCE','MANAGE_FUNDING_SOURCE', 'VIEW_FUNDING_SOURCE'], - $funding_source->owner, $funding_source); - - $funding_source->summary(retrieve_funding_source_summary_impl($e, $funding_source)) - if $$options{flesh_summary}; - return $funding_source; -} - -__PACKAGE__->register_method( - method => 'retrieve_org_funding_sources', - api_name => 'open-ils.acq.funding_source.org.retrieve', - stream => 1, - signature => { - desc => 'Retrieves all the funding_sources associated with an org unit that the requestor has access to see', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'List of org Unit IDs. If no IDs are provided, this method returns the - full set of funding sources this user has permission to view', type => 'number'}, - {desc => q/Limiting permission. this permission is used find the work-org tree from which - the list of orgs is generated if no org ids are provided. - The default is ADMIN_FUNDING_SOURCE/, type => 'string'}, - ], - return => {desc => 'The funding_source objects on success, empty array otherwise'} - } -); - -sub retrieve_org_funding_sources { - my($self, $conn, $auth, $org_id_list, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - $options ||= {}; - - my $limit_perm = ($$options{limit_perm}) ? $$options{limit_perm} : 'ADMIN_FUNDING_SOURCE'; - return OpenILS::Event->new('BAD_PARAMS') - unless $limit_perm =~ /(ADMIN|MANAGE|VIEW)_FUNDING_SOURCE/; - - my $org_ids = ($org_id_list and @$org_id_list) ? $org_id_list : - $U->user_has_work_perm_at($e, $limit_perm, {descendants =>1}); - - return [] unless @$org_ids; - my $sources = $e->search_acq_funding_source({owner => $org_ids}); - - for my $source (@$sources) { - $source->summary(retrieve_funding_source_summary_impl($e, $source)) - if $$options{flesh_summary}; - $conn->respond($source); - } - - return undef; -} - -sub retrieve_funding_source_summary_impl { - my($e, $source) = @_; - my $at = $e->search_acq_funding_source_allocation_total({funding_source => $source->id})->[0]; - my $b = $e->search_acq_funding_source_balance({funding_source => $source->id})->[0]; - my $ct = $e->search_acq_funding_source_credit_total({funding_source => $source->id})->[0]; - return { - allocation_total => ($at) ? $at->amount : 0, - balance => ($b) ? $b->amount : 0, - credit_total => ($ct) ? $ct->amount : 0, - }; -} - - -__PACKAGE__->register_method( - method => 'create_funding_source_credit', - api_name => 'open-ils.acq.funding_source_credit.create', - signature => { - desc => 'Create a new funding source credit', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'funding source credit object', type => 'object'} - ], - return => {desc => 'The ID of the new funding source credit on success, Event on failure'} - } -); - -sub create_funding_source_credit { - my($self, $conn, $auth, $fs_credit) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->event unless $e->checkauth; - - my $fs = $e->retrieve_acq_funding_source($fs_credit->funding_source) - or return $e->die_event; - return $e->die_event unless $e->allowed(['MANAGE_FUNDING_SOURCE'], $fs->owner, $fs); - - $e->create_acq_funding_source_credit($fs_credit) or return $e->die_event; - $e->commit; - return $fs_credit->id; -} - - -# --------------------------------------------------------------- -# funds -# --------------------------------------------------------------- - -__PACKAGE__->register_method( - method => 'create_fund', - api_name => 'open-ils.acq.fund.create', - signature => { - desc => 'Creates a new fund', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'fund object to create', type => 'object'} - ], - return => {desc => 'The ID of the newly created fund object'} - } -); - -sub create_fund { - my($self, $conn, $auth, $fund) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('ADMIN_FUND', $fund->org); - $e->create_acq_fund($fund) or return $e->die_event; - $e->commit; - return $fund->id; -} - - -__PACKAGE__->register_method( - method => 'delete_fund', - api_name => 'open-ils.acq.fund.delete', - signature => { - desc => 'Deletes a fund', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'fund ID', type => 'number'} - ], - return => {desc => '1 on success, Event on failure'} - } -); - -sub delete_fund { - my($self, $conn, $auth, $fund_id) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $fund = $e->retrieve_acq_fund($fund_id) or return $e->die_event; - return $e->die_event unless $e->allowed('ADMIN_FUND', $fund->org, $fund); - $e->delete_acq_fund($fund) or return $e->die_event; - $e->commit; - return 1; -} - -__PACKAGE__->register_method( - method => 'retrieve_fund', - api_name => 'open-ils.acq.fund.retrieve', - authoritative => 1, - signature => { - desc => 'Retrieves a new fund', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'fund ID', type => 'number'} - ], - return => {desc => 'The fund object on success, Event on failure'} - } -); - -sub retrieve_fund { - my($self, $conn, $auth, $fund_id, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - $options ||= {}; - - my $flesh = {flesh => 2, flesh_fields => {acqf => []}}; - if ($options->{"flesh_tags"}) { - push @{$flesh->{"flesh_fields"}->{"acqf"}}, "tags"; - $flesh->{"flesh_fields"}->{"acqftm"} = ["tag"]; - } - push(@{$flesh->{flesh_fields}->{acqf}}, 'debits') if $$options{flesh_debits}; - push(@{$flesh->{flesh_fields}->{acqf}}, 'allocations') if $$options{flesh_allocations}; - push(@{$flesh->{flesh_fields}->{acqfa}}, 'funding_source') if $$options{flesh_allocation_sources}; - - my $fund = $e->retrieve_acq_fund([$fund_id, $flesh]) or return $e->event; - return $e->event unless $e->allowed(['ADMIN_FUND','MANAGE_FUND', 'VIEW_FUND'], $fund->org, $fund); - $fund->summary(retrieve_fund_summary_impl($e, $fund)) - if $$options{flesh_summary}; - return $fund; -} - -__PACKAGE__->register_method( - method => 'retrieve_org_funds', - api_name => 'open-ils.acq.fund.org.retrieve', - stream => 1, - signature => { - desc => 'Retrieves all the funds associated with an org unit', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'List of org Unit IDs. If no IDs are provided, this method returns the - full set of funding sources this user has permission to view', type => 'number'}, - {desc => q/Options hash. - "limit_perm" -- this permission is used find the work-org tree from which - the list of orgs is generated if no org ids are provided. The default is ADMIN_FUND. - "flesh_summary" -- if true, the summary field on each fund is fleshed - The default is ADMIN_FUND/, type => 'string'}, - ], - return => {desc => 'The fund objects on success, Event on failure'} - } -); - -__PACKAGE__->register_method( - method => 'retrieve_org_funds', - api_name => 'open-ils.acq.fund.org.years.retrieve'); - - -sub retrieve_org_funds { - my($self, $conn, $auth, $filter, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - $filter ||= {}; - $options ||= {}; - - my $limit_perm = ($$options{limit_perm}) ? $$options{limit_perm} : 'ADMIN_FUND'; - return OpenILS::Event->new('BAD_PARAMS') - unless $limit_perm =~ /(ADMIN|MANAGE|VIEW)_FUND/; - - $filter->{org} = $filter->{org} || - $U->user_has_work_perm_at($e, $limit_perm, {descendants =>1}); - return undef unless @{$filter->{org}}; - - my $query = [ - $filter, - { - limit => $$options{limit} || 50, - offset => $$options{offset} || 0, - order_by => $$options{order_by} || {acqf => 'name'} - } - ]; - - if($self->api_name =~ /years/) { - # return the distinct set of fund years covered by the selected funds - my $data = $e->json_query({ - select => { - acqf => [{column => 'year', transform => 'distinct'}] - }, - from => 'acqf', - where => $filter} - ); - - return [map { $_->{year} } @$data]; - } - - my $funds = $e->search_acq_fund($query); - - for my $fund (@$funds) { - $fund->summary(retrieve_fund_summary_impl($e, $fund)) - if $$options{flesh_summary}; - $conn->respond($fund); - } - - return undef; -} - -__PACKAGE__->register_method( - method => 'retrieve_fund_summary', - api_name => 'open-ils.acq.fund.summary.retrieve', - authoritative => 1, - signature => { - desc => 'Returns a summary of credits/debits/encumbrances for a fund', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'fund id', type => 'number' } - ], - return => {desc => 'A hash of summary information, Event on failure'} - } -); - -sub retrieve_fund_summary { - my($self, $conn, $auth, $fund_id) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - my $fund = $e->retrieve_acq_fund($fund_id) or return $e->event; - return $e->event unless $e->allowed('MANAGE_FUND', $fund->org, $fund); - return retrieve_fund_summary_impl($e, $fund); -} - - -sub retrieve_fund_summary_impl { - my($e, $fund) = @_; - - my $at = $e->search_acq_fund_allocation_total({fund => $fund->id})->[0]; - my $dt = $e->search_acq_fund_debit_total({fund => $fund->id})->[0]; - my $et = $e->search_acq_fund_encumbrance_total({fund => $fund->id})->[0]; - my $st = $e->search_acq_fund_spent_total({fund => $fund->id})->[0]; - my $cb = $e->search_acq_fund_combined_balance({fund => $fund->id})->[0]; - my $sb = $e->search_acq_fund_spent_balance({fund => $fund->id})->[0]; - - return { - allocation_total => ($at) ? $at->amount : 0, - debit_total => ($dt) ? $dt->amount : 0, - encumbrance_total => ($et) ? $et->amount : 0, - spent_total => ($st) ? $st->amount : 0, - combined_balance => ($cb) ? $cb->amount : 0, - spent_balance => ($sb) ? $sb->amount : 0, - }; -} - -__PACKAGE__->register_method( - method => 'transfer_money_between_funds', - api_name => 'open-ils.acq.funds.transfer_money', - signature => { - desc => 'Method for transfering money between funds', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Originating fund ID', type => 'number'}, - {desc => 'Amount of money to transfer away from the originating fund, in the same currency as said fund', type => 'number'}, - {desc => 'Destination fund ID', type => 'number'}, - {desc => 'Amount of money to transfer to the destination fund, in the same currency as said fund. If null, uses the same amount specified with the Originating Fund, and attempts a currency conversion if appropriate.', type => 'number'}, - {desc => 'Transfer Note', type => 'string'} - ], - return => {desc => '1 on success, Event on failure'} - } -); - -sub transfer_money_between_funds { - my($self, $conn, $auth, $ofund_id, $ofund_amount, $dfund_id, $dfund_amount, $note) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $ofund = $e->retrieve_acq_fund($ofund_id) or return $e->event; - return $e->die_event unless $e->allowed(['ADMIN_FUND','MANAGE_FUND'], $ofund->org, $ofund); - my $dfund = $e->retrieve_acq_fund($dfund_id) or return $e->event; - return $e->die_event unless $e->allowed(['ADMIN_FUND','MANAGE_FUND'], $dfund->org, $dfund); - - if (!defined $dfund_amount) { - my $ratio = 1; - if ($ofund->currency_type ne $dfund->currency_type) { - my $exchange_rate = $e->json_query({ - "select"=>{"acqexr"=>["ratio"]}, - "from"=>"acqexr", - "where"=>{ - "from_currency"=>$ofund->currency_type, - "to_currency"=>$dfund->currency_type - } - }); - if (scalar(@$exchange_rate)<1) { - $logger->error('Unable to find exchange rate for ' . $ofund->currency_type . ' to ' . $dfund->currency_type); - return $e->die_event; - } - $ratio = @{$exchange_rate}[0]->{ratio}; - } - $dfund_amount = $ofund_amount * $ratio; - } else { - return $e->die_event unless $e->allowed("ACQ_XFER_MANUAL_DFUND_AMOUNT"); - } - - $e->json_query({ - from => [ - 'acq.transfer_fund', - $ofund_id, $ofund_amount, $dfund_id, $dfund_amount, $e->requestor->id, $note - ] - }); - - $e->commit; - - return 1; -} - - - -# --------------------------------------------------------------- -# fund Allocations -# --------------------------------------------------------------- - -__PACKAGE__->register_method( - method => 'create_fund_alloc', - api_name => 'open-ils.acq.fund_allocation.create', - signature => { - desc => 'Creates a new fund_allocation', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'fund allocation object to create', type => 'object'} - ], - return => {desc => 'The ID of the new fund_allocation'} - } -); - -sub create_fund_alloc { - my($self, $conn, $auth, $fund_alloc) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - - # this action is equivalent to both debiting a funding source and crediting a fund - - my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source) - or return $e->die_event; - return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner); - - my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event; - return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund); - - $fund_alloc->allocator($e->requestor->id); - $e->create_acq_fund_allocation($fund_alloc) or return $e->die_event; - $e->commit; - return $fund_alloc->id; -} - - -__PACKAGE__->register_method( - method => 'delete_fund_alloc', - api_name => 'open-ils.acq.fund_allocation.delete', - signature => { - desc => 'Deletes a fund_allocation', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'fund Alocation ID', type => 'number'} - ], - return => {desc => '1 on success, Event on failure'} - } -); - -sub delete_fund_alloc { - my($self, $conn, $auth, $fund_alloc_id) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - - my $fund_alloc = $e->retrieve_acq_fund_allocation($fund_alloc_id) or return $e->die_event; - - my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source) - or return $e->die_event; - return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner, $source); - - my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event; - return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund); - - $e->delete_acq_fund_allocation($fund_alloc) or return $e->die_event; - $e->commit; - return 1; -} - -__PACKAGE__->register_method( - method => 'retrieve_fund_alloc', - api_name => 'open-ils.acq.fund_allocation.retrieve', - authoritative => 1, - signature => { - desc => 'Retrieves a new fund_allocation', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'fund Allocation ID', type => 'number'} - ], - return => {desc => 'The fund allocation object on success, Event on failure'} - } -); - -sub retrieve_fund_alloc { - my($self, $conn, $auth, $fund_alloc_id) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - my $fund_alloc = $e->retrieve_acq_fund_allocation($fund_alloc_id) or return $e->event; - - my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source) - or return $e->die_event; - return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner, $source); - - my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event; - return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund); - - return $fund_alloc; -} - - -__PACKAGE__->register_method( - method => 'retrieve_funding_source_allocations', - api_name => 'open-ils.acq.funding_source.allocations.retrieve', - authoritative => 1, - signature => { - desc => 'Retrieves a new fund_allocation', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'fund Allocation ID', type => 'number'} - ], - return => {desc => 'The fund allocation object on success, Event on failure'} - } -); - -sub retrieve_funding_source_allocations { - my($self, $conn, $auth, $fund_alloc_id) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - my $fund_alloc = $e->retrieve_acq_fund_allocation($fund_alloc_id) or return $e->event; - - my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source) - or return $e->die_event; - return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner, $source); - - my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event; - return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund); - - return $fund_alloc; -} - -# ---------------------------------------------------------------------------- -# Currency -# ---------------------------------------------------------------------------- - -__PACKAGE__->register_method( - method => 'retrieve_all_currency_type', - api_name => 'open-ils.acq.currency_type.all.retrieve', - stream => 1, - signature => { - desc => 'Retrieves all currency_type objects', - params => [ - {desc => 'Authentication token', type => 'string'}, - ], - return => {desc => 'List of currency_type objects', type => 'list'} - } -); - -sub retrieve_all_currency_type { - my($self, $conn, $auth, $fund_alloc_id) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('GENERAL_ACQ'); - $conn->respond($_) for @{$e->retrieve_all_acq_currency_type()}; -} - -__PACKAGE__->register_method( - method => 'create_lineitem_assets', - api_name => 'open-ils.acq.lineitem.assets.create', - signature => { - desc => q/Creates the bibliographic data, volume, and copies associated with a lineitem./, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'The lineitem id', type => 'number'}, - {desc => q/Options hash./} - ], - return => {desc => 'ID of newly created bib record, Event on error'} - } -); - -sub create_lineitem_assets { - my($self, $conn, $auth, $li_id, $options) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - my ($count, $resp) = create_lineitem_assets_impl($e, $li_id, $options); - return $resp if $resp; - $e->commit; - return $count; -} - -sub create_lineitem_assets_impl { - my($e, $li_id, $options) = @_; - $options ||= {}; - my $evt; - - my $li = $e->retrieve_acq_lineitem([ - $li_id, - { flesh => 1, - flesh_fields => {jub => ['purchase_order', 'attributes']} - } - ]) or return (undef, $e->die_event); - - # ----------------------------------------------------------------- - # first, create the bib record if necessary - # ----------------------------------------------------------------- - unless($li->eg_bib_id) { - - my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import( - $e, $li->marc); #$rec->bib_source - - if($U->event_code($record)) { - $e->rollback; - return (undef, $record); - } - - $li->editor($e->requestor->id); - $li->edit_time('now'); - $li->eg_bib_id($record->id); - $e->update_acq_lineitem($li) or return (undef, $e->die_event); - } - - my $li_details = $e->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1}); - - # ----------------------------------------------------------------- - # for each lineitem_detail, create the volume if necessary, create - # a copy, and link them all together. - # ----------------------------------------------------------------- - my %volcache; - for my $li_detail_id (@{$li_details}) { - - my $li_detail = $e->retrieve_acq_lineitem_detail($li_detail_id) - or return (undef, $e->die_event); - - # Create the volume object if necessary - my $volume = $volcache{$li_detail->cn_label}; - unless($volume and $volume->owning_lib == $li_detail->owning_lib) { - ($volume, $evt) = - OpenILS::Application::Cat::AssetCommon->find_or_create_volume( - $e, $li_detail->cn_label, $li->eg_bib_id, $li_detail->owning_lib); - return (undef, $evt) if $evt; - $volcache{$volume->id} = $volume; - } - - my $copy = Fieldmapper::asset::copy->new; - $copy->isnew(1); - $copy->loan_duration(2); - $copy->fine_level(2); - $copy->status(OILS_COPY_STATUS_ON_ORDER); - $copy->barcode($li_detail->barcode); - $copy->location($li_detail->location); - $copy->call_number($volume->id); - $copy->circ_lib($volume->owning_lib); - $copy->circ_modifier($$options{circ_modifier} || 'book'); - - $evt = OpenILS::Application::Cat::AssetCommon->create_copy($e, $volume, $copy); - return (undef, $evt) if $evt; - - $li_detail->eg_copy_id($copy->id); - $e->update_acq_lineitem_detail($li_detail) or return (undef, $e->die_event); - } - - return (scalar @{$li_details}); -} - - - - -sub create_purchase_order_impl { - my($e, $p_order) = @_; - - $p_order->creator($e->requestor->id); - $p_order->editor($e->requestor->id); - $p_order->owner($e->requestor->id); - $p_order->edit_time('now'); - - return $e->die_event unless - $e->allowed('CREATE_PURCHASE_ORDER', $p_order->ordering_agency); - - my $provider = $e->retrieve_acq_provider($p_order->provider) - or return $e->die_event; - return $e->die_event unless - $e->allowed('MANAGE_PROVIDER', $provider->owner, $provider); - - $e->create_acq_purchase_order($p_order) or return $e->die_event; - return undef; -} - - -__PACKAGE__->register_method( - method => 'retrieve_all_user_purchase_order', - api_name => 'open-ils.acq.purchase_order.user.all.retrieve', - stream => 1, - signature => { - desc => 'Retrieves a purchase order', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'purchase_order to retrieve', type => 'number'}, - {desc => q/Options hash. flesh_lineitems: to get the lineitems and lineitem_attrs; - clear_marc: to clear the MARC data from the lineitem (for reduced bandwidth); - limit: number of items to return ,defaults to 50; - offset: offset in the list of items to return - order_by: sort the result, provide one or more colunm names, separated by commas, - optionally followed by ASC or DESC as a single string - li_limit : number of lineitems to return if fleshing line items; - li_offset : lineitem offset if fleshing line items - li_order_by : lineitem sort definition if fleshing line items - flesh_lineitem_detail_count : flesh lineitem_detail_count field - /, - type => 'hash'} - ], - return => {desc => 'The purchase order, Event on failure'} - } -); - -sub retrieve_all_user_purchase_order { - my($self, $conn, $auth, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - $options ||= {}; - - # grab purchase orders I have - my $perm_orgs = $U->user_has_work_perm_at($e, 'MANAGE_PROVIDER', {descendants =>1}); - return OpenILS::Event->new('PERM_FAILURE', ilsperm => 'MANAGE_PROVIDER') - unless @$perm_orgs; - my $provider_ids = $e->search_acq_provider({owner => $perm_orgs}, {idlist=>1}); - my $po_ids = $e->search_acq_purchase_order({provider => $provider_ids}, {idlist=>1}); - - # grab my purchase orders - push(@$po_ids, @{$e->search_acq_purchase_order({owner => $e->requestor->id}, {idlist=>1})}); - - return undef unless @$po_ids; - - # now get the db to limit/sort for us - $po_ids = $e->search_acq_purchase_order( - [ {id => $po_ids}, { - limit => $$options{limit} || 50, - offset => $$options{offset} || 0, - order_by => {acqpo => $$options{order_by} || 'create_time'} - } - ], - {idlist => 1} - ); - - $conn->respond(retrieve_purchase_order_impl($e, $_, $options)) for @$po_ids; - return undef; -} - - -__PACKAGE__->register_method( - method => 'search_purchase_order', - api_name => 'open-ils.acq.purchase_order.search', - stream => 1, - signature => { - desc => 'Search for a purchase order', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => q/Search hash. Search fields include id, provider/, type => 'hash'} - ], - return => {desc => 'A stream of POs'} - } -); - -sub search_purchase_order { - my($self, $conn, $auth, $search, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - my $po_ids = $e->search_acq_purchase_order($search, {idlist=>1}); - for my $po_id (@$po_ids) { - $conn->respond($e->retrieve_acq_purchase_order($po_id)) - unless po_perm_failure($e, $po_id); - } - - return undef; -} - - - -__PACKAGE__->register_method( - method => 'retrieve_purchase_order', - api_name => 'open-ils.acq.purchase_order.retrieve', - stream => 1, - signature => { - desc => 'Retrieves a purchase order', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'purchase_order to retrieve', type => 'number'}, - {desc => q/Options hash. flesh_lineitems, to get the lineitems and lineitem_attrs; - clear_marc, to clear the MARC data from the lineitem (for reduced bandwidth) - li_limit : number of lineitems to return if fleshing line items; - li_offset : lineitem offset if fleshing line items - li_order_by : lineitem sort definition if fleshing line items, - flesh_po_items : po_item objects - /, - type => 'hash'} - ], - return => {desc => 'The purchase order, Event on failure'} - } -); - -sub retrieve_purchase_order { - my($self, $conn, $auth, $po_id, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - $po_id = [ $po_id ] unless ref $po_id; - for ( @{$po_id} ) { - my $rv; - if ( po_perm_failure($e, $_) ) - { $rv = $e->event } - else - { $rv = retrieve_purchase_order_impl($e, $_, $options) } - - $conn->respond($rv); - } - - return undef; -} - - -# if the user does not have permission to perform actions on this PO, return the perm failure event -sub po_perm_failure { - my($e, $po_id, $fund_id) = @_; - my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->event; - return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $po->ordering_agency, $po); - return undef; -} - -sub build_price_summary { - my ($e, $po_id) = @_; - - # TODO: Add summary value for estimated amount (pre-encumber) - - # fetch the fund debits for this purchase order - my $debits = $e->json_query({ - "select" => {"acqfdeb" => [qw/encumbrance amount/]}, - "from" => { - "acqlid" => { - "jub" => { - "fkey" => "lineitem", - "field" => "id", - "join" => { - "acqpo" => { - "fkey" => "purchase_order", "field" => "id" - } - } - }, - "acqfdeb" => {"fkey" => "fund_debit", "field" => "id"} - } - }, - "where" => {"+acqpo" => {"id" => $po_id}} - }); - - # add any debits for non-bib po_items - push(@$debits, @{ - $e->json_query({ - "select" => {"acqfdeb" => [qw/encumbrance amount/]}, - "from" => {acqpoi => 'acqfdeb'}, - "where" => {"+acqpoi" => {"purchase_order" => $po_id}} - }) - }); - - my ($enc, $spent) = (0, 0); - for my $deb (@$debits) { - if($U->is_true($deb->{encumbrance})) { - $enc += $deb->{amount}; - } else { - $spent += $deb->{amount}; - } - } - ($enc, $spent); -} - - -sub retrieve_purchase_order_impl { - my($e, $po_id, $options) = @_; - - my $flesh = {"flesh" => 1, "flesh_fields" => {"acqpo" => []}}; - - $options ||= {}; - unless ($options->{"no_flesh_cancel_reason"}) { - push @{$flesh->{"flesh_fields"}->{"acqpo"}}, "cancel_reason"; - } - if ($options->{"flesh_notes"}) { - push @{$flesh->{"flesh_fields"}->{"acqpo"}}, "notes"; - } - if ($options->{"flesh_provider"}) { - push @{$flesh->{"flesh_fields"}->{"acqpo"}}, "provider"; - } - - push (@{$flesh->{flesh_fields}->{acqpo}}, 'po_items') if $options->{flesh_po_items}; - - my $args = (@{$flesh->{"flesh_fields"}->{"acqpo"}}) ? - [$po_id, $flesh] : $po_id; - - my $po = $e->retrieve_acq_purchase_order($args) - or return $e->event; - - if($$options{flesh_lineitems}) { - - my $flesh_fields = { jub => ['attributes'] }; - $flesh_fields->{jub}->[1] = 'lineitem_details' if $$options{flesh_lineitem_details}; - $flesh_fields->{acqlid} = ['fund_debit'] if $$options{flesh_fund_debit}; - - my $items = $e->search_acq_lineitem([ - {purchase_order => $po_id}, - { - flesh => 3, - flesh_fields => $flesh_fields, - limit => $$options{li_limit} || 50, - offset => $$options{li_offset} || 0, - order_by => {jub => $$options{li_order_by} || 'create_time'} - } - ]); - - if($$options{clear_marc}) { - $_->clear_marc for @$items; - } - - $po->lineitems($items); - $po->lineitem_count(scalar(@$items)); - - } elsif( $$options{flesh_lineitem_ids} ) { - $po->lineitems($e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1})); - - } elsif( $$options{flesh_lineitem_count} ) { - - my $items = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist=>1}); - $po->lineitem_count(scalar(@$items)); - } - - if($$options{flesh_price_summary}) { - my ($enc, $spent) = build_price_summary($e, $po_id); - $po->amount_encumbered($enc); - $po->amount_spent($spent); - } - - return $po; -} - - -__PACKAGE__->register_method( - method => 'format_po', - api_name => 'open-ils.acq.purchase_order.format' -); - -sub format_po { - my($self, $conn, $auth, $po_id, $format) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->event; - return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $po->ordering_agency); - - my $hook = "format.po.$format"; - return $U->fire_object_event(undef, $hook, $po, $po->ordering_agency); -} - -__PACKAGE__->register_method( - method => 'format_lineitem', - api_name => 'open-ils.acq.lineitem.format' -); - -sub format_lineitem { - my($self, $conn, $auth, $li_id, $format, $user_data) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - my $li = $e->retrieve_acq_lineitem($li_id) or return $e->event; - - my $context_org; - if (defined $li->purchase_order) { - my $po = $e->retrieve_acq_purchase_order($li->purchase_order) or return $e->die_event; - return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $po->ordering_agency); - $context_org = $po->ordering_agency; - } else { - my $pl = $e->retrieve_acq_picklist($li->picklist) or return $e->die_event; - if($e->requestor->id != $pl->owner) { - return $e->event unless - $e->allowed('VIEW_PICKLIST', $pl->org_unit, $pl); - } - $context_org = $pl->org_unit; - } - - my $hook = "format.acqli.$format"; - return $U->fire_object_event(undef, $hook, $li, $context_org, 'print-on-demand', $user_data); -} - -__PACKAGE__->register_method ( - method => 'po_events', - api_name => 'open-ils.acq.purchase_order.events.owner', - stream => 1, - signature => q/ - Retrieve EDI-related purchase order events (format.po.jedi), by default those which are pending. - @param authtoken Login session key - @param owner Id or array of id's for the purchase order Owner field. Filters the events to just those pertaining to PO's meeting this criteria. - @param options Object for tweaking the selection criteria and fleshing options. - / -); - -__PACKAGE__->register_method ( - method => 'po_events', - api_name => 'open-ils.acq.purchase_order.events.ordering_agency', - stream => 1, - signature => q/ - Retrieve EDI-related purchase order events (format.po.jedi), by default those which are pending. - @param authtoken Login session key - @param owner Id or array of id's for the purchase order Ordering Agency field. Filters the events to just those pertaining to PO's meeting this criteria. - @param options Object for tweaking the selection criteria and fleshing options. - / -); - -__PACKAGE__->register_method ( - method => 'po_events', - api_name => 'open-ils.acq.purchase_order.events.id', - stream => 1, - signature => q/ - Retrieve EDI-related purchase order events (format.po.jedi), by default those which are pending. - @param authtoken Login session key - @param owner Id or array of id's for the purchase order Id field. Filters the events to just those pertaining to PO's meeting this criteria. - @param options Object for tweaking the selection criteria and fleshing options. - / -); - -sub po_events { - my($self, $conn, $auth, $search_value, $options) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - (my $search_field = $self->api_name) =~ s/.*\.([_a-z]+)$/$1/; - my $obj_type = 'acqpo'; - - if ($search_field eq 'ordering_agency') { - $search_value = $U->get_org_descendants($search_value); - } - - my $query = { - "select"=>{"atev"=>["id"]}, - "from"=>"atev", - "where"=>{ - "target"=>{ - "in"=>{ - "select"=>{$obj_type=>["id"]}, - "from"=>$obj_type, - "where"=>{$search_field=>$search_value} - } - }, - "event_def"=>{ - "in"=>{ - "select"=>{atevdef=>["id"]}, - "from"=>"atevdef", - "where"=>{ - "hook"=>"format.po.jedi" - } - } - }, - "state"=>"pending" - }, - "order_by"=>[{"class"=>"atev", "field"=>"run_time", "direction"=>"desc"}] - }; - - if ($options && defined $options->{state}) { - $query->{'where'}{'state'} = $options->{state} - } - - if ($options && defined $options->{start_time}) { - $query->{'where'}{'start_time'} = $options->{start_time}; - } - - if ($options && defined $options->{order_by}) { - $query->{'order_by'} = $options->{order_by}; - } - my $po_events = $e->json_query($query); - - my $flesh_fields = { 'atev' => [ 'event_def' ] }; - my $flesh_depth = 1; - - for my $id (@$po_events) { - my $event = $e->retrieve_action_trigger_event([ - $id->{id}, - {flesh => $flesh_depth, flesh_fields => $flesh_fields} - ]); - if (! $event) { next; } - - my $po = retrieve_purchase_order_impl( - $e, - $event->target(), - {flesh_lineitem_count=>1,flesh_price_summary=>1} - ); - - if ($e->allowed( ['CREATE_PURCHASE_ORDER','VIEW_PURCHASE_ORDER'], $po->ordering_agency() )) { - $event->target( $po ); - $conn->respond($event); - } - } - - return undef; -} - -__PACKAGE__->register_method ( - method => 'update_po_events', - api_name => 'open-ils.acq.purchase_order.event.cancel.batch', - stream => 1, -); -__PACKAGE__->register_method ( - method => 'update_po_events', - api_name => 'open-ils.acq.purchase_order.event.reset.batch', - stream => 1, -); - -sub update_po_events { - my($self, $conn, $auth, $event_ids) = @_; - my $e = new_editor(xact => 1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - - my $x = 1; - for my $id (@$event_ids) { - - # do a little dance to determine what libraries we are ultimately affecting - my $event = $e->retrieve_action_trigger_event([ - $id, - { flesh => 2, - flesh_fields => {atev => ['event_def'], atevdef => ['hook']} - } - ]) or return $e->die_event; - - my $po = retrieve_purchase_order_impl( - $e, - $event->target(), - {} - ); - - return $e->die_event unless $e->allowed( ['CREATE_PURCHASE_ORDER','VIEW_PURCHASE_ORDER'], $po->ordering_agency() ); - - if($self->api_name =~ /cancel/) { - $event->state('invalid'); - } elsif($self->api_name =~ /reset/) { - $event->clear_start_time; - $event->clear_update_time; - $event->state('pending'); - } - - $e->update_action_trigger_event($event) or return $e->die_event; - $conn->respond({maximum => scalar(@$event_ids), progress => $x++}); - } - - $e->commit; - return {complete => 1}; -} - - -__PACKAGE__->register_method ( - method => 'process_fiscal_rollover', - api_name => 'open-ils.acq.fiscal_rollover.combined', - stream => 1, - signature => { - desc => q/ - Performs a combined fiscal fund rollover process. - - Creates a new series of funds for the following year, copying the old years - funds that are marked as propagable. They apply to the funds belonging to - either an org unit or to an org unit and all of its dependent org units. - The procedures may be run repeatedly; if any fund has already been propagated, - both the old and the new funds will be left alone. - - Closes out any applicable funds (by org unit or by org unit and dependents) - that are marked as propagable. If such a fund has not already been propagated - to the new year, it will be propagated at closing time. - - If a fund is marked as subject to rollover, any unspent balance in the old year's - fund (including money encumbered but not spent) is transferred to the new year's - fund. Otherwise it is deallocated back to the funding source(s). - - In either case, any encumbrance debits are transferred to the new fund, along - with the corresponding lineitem details. The old year's fund is marked as inactive - so that new debits may not be charged to it. - /, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Fund Year to roll over', type => 'integer'}, - {desc => 'Org unit ID', type => 'integer'}, - {desc => 'Include Descendant Orgs (boolean)', type => 'integer'}, - ], - return => {desc => 'Returns a stream of all related funds for the next year including fund summary for each'} - } - -); - -__PACKAGE__->register_method ( - method => 'process_fiscal_rollover', - api_name => 'open-ils.acq.fiscal_rollover.combined.dry_run', - stream => 1, - signature => { - desc => q/ - @see open-ils.acq.fiscal_rollover.combined - This is the dry-run version. The action is performed, - new fund information is returned, then all changes are rolled back. - / - } - -); - -__PACKAGE__->register_method ( - method => 'process_fiscal_rollover', - api_name => 'open-ils.acq.fiscal_rollover.propagate', - stream => 1, - signature => { - desc => q/ - @see open-ils.acq.fiscal_rollover.combined - This version performs fund propagation only. I.e, creation of - the following year's funds. It does not rollover over balances, encumbrances, - or mark the previous year's funds as complete. - / - } -); - -__PACKAGE__->register_method ( - method => 'process_fiscal_rollover', - api_name => 'open-ils.acq.fiscal_rollover.propagate.dry_run', - stream => 1, - signature => { desc => q/ - @see open-ils.acq.fiscal_rollover.propagate - This is the dry-run version. The action is performed, - new fund information is returned, then all changes are rolled back. - / } -); - - - -sub process_fiscal_rollover { - my( $self, $conn, $auth, $year, $org_id, $descendants, $options ) = @_; - - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('ADMIN_FUND', $org_id); - $options ||= {}; - - my $combined = ($self->api_name =~ /combined/); - - my $org_ids = ($descendants) ? - [ - map - { $_->{id} } # fetch my descendants - @{$e->json_query({from => ['actor.org_unit_descendants', $org_id]})} - ] - : [$org_id]; - - # Create next year's funds - # Note, it's safe to run this more than once. - # IOW, it will not create duplicate new funds. - $e->json_query({ - from => [ - ($descendants) ? - 'acq.propagate_funds_by_org_tree' : - 'acq.propagate_funds_by_org_unit', - $year, $e->requestor->id, $org_id - ] - }); - - if($combined) { - - # Roll the uncumbrances over to next year's funds - # Mark the funds for $year as inactive - - $e->json_query({ - from => [ - ($descendants) ? - 'acq.rollover_funds_by_org_tree' : - 'acq.rollover_funds_by_org_unit', - $year, $e->requestor->id, $org_id - ] - }); - } - - # Fetch all funds for the specified org units for the subsequent year - my $fund_ids = $e->search_acq_fund([ - { - year => int($year) + 1, - org => $org_ids, - propagate => 't' - }, { - limit => $$options{limit} || 20, - offset => $$options{offset} || 0, - } - ], - {idlist => 1} - ); - - foreach (@$fund_ids) { - my $fund = $e->retrieve_acq_fund($_) or return $e->die_event; - $fund->summary(retrieve_fund_summary_impl($e, $fund)); - - my $amount = 0; - if($combined and $U->is_true($fund->rollover)) { - # see how much money was rolled over - - my $sum = $e->json_query({ - select => {acqftr => [{column => 'dest_amount', transform => 'sum'}]}, - from => 'acqftr', - where => {dest_fund => $fund->id, note => 'Rollover'} - })->[0]; - - $amount = $sum->{dest_amount} if $sum; - } - - $conn->respond({fund => $fund, rollover_amount => $amount}); - } - - $self->api_name =~ /dry_run/ and $e->rollback or $e->commit; - return undef; -} - - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Invoice.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq/Invoice.pm deleted file mode 100644 index 305bd077e3..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Invoice.pm +++ /dev/null @@ -1,568 +0,0 @@ -package OpenILS::Application::Acq::Invoice; -use base qw/OpenILS::Application/; -use strict; use warnings; - -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Application::AppUtils; -use OpenILS::Event; -my $U = 'OpenILS::Application::AppUtils'; - - -__PACKAGE__->register_method( - method => 'build_invoice_api', - api_name => 'open-ils.acq.invoice.update', - signature => { - desc => q/Creates, updates, and deletes invoices, and related invoice entries, and invoice items/, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => q/Invoice/, type => 'number'}, - {desc => q/Entries. Array of 'acqie' objects/, type => 'array'}, - {desc => q/Items. Array of 'acqii' objects/, type => 'array'}, - ], - return => {desc => 'The invoice w/ entries and items attached', type => 'object', class => 'acqinv'} - } -); - -sub build_invoice_api { - my($self, $conn, $auth, $invoice, $entries, $items) = @_; - - my $e = new_editor(xact => 1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $evt; - - if(ref $invoice) { - if($invoice->isnew) { - $invoice->receiver($e->requestor->ws_ou) unless $invoice->receiver; - $invoice->recv_method('PPR') unless $invoice->recv_method; - $invoice->recv_date('now') unless $invoice->recv_date; - $e->create_acq_invoice($invoice) or return $e->die_event; - } elsif($invoice->isdeleted) { - i$e->delete_acq_invoice($invoice) or return $e->die_event; - } else { - $e->update_acq_invoice($invoice) or return $e->die_event; - } - } else { - # caller only provided the ID - $invoice = $e->retrieve_acq_invoice($invoice) or return $e->die_event; - } - - return $e->die_event unless $e->allowed('CREATE_INVOICE', $invoice->receiver); - - if($entries) { - for my $entry (@$entries) { - $entry->invoice($invoice->id); - - if($entry->isnew) { - - $e->create_acq_invoice_entry($entry) or return $e->die_event; - return $evt if $evt = update_entry_debits($e, $entry); - - } elsif($entry->isdeleted) { - - return $evt if $evt = rollback_entry_debits($e, $entry); - $e->delete_acq_invoice_entry($entry) or return $e->die_event; - - } elsif($entry->ischanged) { - - my $orig_entry = $e->retrieve_acq_invoice_entry($entry->id) or return $e->die_event; - - if($orig_entry->amount_paid != $entry->amount_paid or - $entry->phys_item_count != $orig_entry->phys_item_count) { - - return $evt if $evt = rollback_entry_debits($e, $orig_entry); - return $evt if $evt = update_entry_debits($e, $entry); - - } - - $e->update_acq_invoice_entry($entry) or return $e->die_event; - } - } - } - - if($items) { - for my $item (@$items) { - $item->invoice($invoice->id); - - if($item->isnew) { - - $e->create_acq_invoice_item($item) or return $e->die_event; - - # future: cache item types - my $item_type = $e->retrieve_acq_invoice_item_type( - $item->inv_item_type) or return $e->die_event; - - # prorated items are handled separately - unless($U->is_true($item_type->prorate)) { - my $debit; - if($item->po_item) { - my $po_item = $e->retrieve_acq_po_item($item->po_item) or return $e->die_event; - $debit = $e->retrieve_acq_fund_debit($po_item->fund_debit) or return $e->die_event; - } else { - $debit = Fieldmapper::acq::fund_debit->new; - $debit->isnew(1); - } - $debit->fund($item->fund); - $debit->amount($item->amount_paid); - $debit->origin_amount($item->amount_paid); - $debit->origin_currency_type($e->retrieve_acq_fund($item->fund)->currency_type); # future: cache funds locally - $debit->encumbrance('f'); - $debit->debit_type('direct_charge'); - - if($debit->isnew) { - $e->create_acq_fund_debit($debit) or return $e->die_event; - } else { - $e->update_acq_fund_debit($debit) or return $e->die_event; - } - - $item->fund_debit($debit->id); - $e->update_acq_invoice_item($item) or return $e->die_event; - } - - } elsif($item->isdeleted) { - - $e->delete_acq_invoice_item($item) or return $e->die_event; - - if($item->po_item and $e->retrieve_acq_po_item($item->po_item)->fund_debit == $item->fund_debit) { - # the debit is attached to the po_item. instead of deleting it, roll it back - # to being an encumbrance. Note: a prorated invoice_item that points to a po_item - # could point to a different fund_debit. We can't go back in time to collect all the - # prorated invoice_items (nor is the caller asking us too), so when that happens, - # just delete the extraneous debit (in the else block). - my $debit = $e->retrieve_acq_fund_debit($item->fund_debit); - $debit->encumbrance('t'); - $e->update_acq_fund_debit($debit) or return $e->die_event; - } else { - $e->delete_acq_fund_debit($e->retrieve_acq_fund_debit($item->fund_debit)) - or return $e->die_event; - } - - - } elsif($item->ischanged) { - - my $debit = $e->retrieve_acq_fund_debit($item->fund_debit) or return $e->die_event; - $debit->amount($item->amount_paid); - $debit->fund($item->fund); - $e->update_acq_fund_debit($debit) or return $e->die_event; - $e->update_acq_invoice_item($item) or return $e->die_event; - } - } - } - - $invoice = fetch_invoice_impl($e, $invoice->id); - $e->commit; - - return $invoice; -} - - -sub rollback_entry_debits { - my($e, $entry) = @_; - my $debits = find_entry_debits($e, $entry, 'f', entry_amount_per_item($entry)); - my $lineitem = $e->retrieve_acq_lineitem($entry->lineitem) or return $e->die_event; - - for my $debit (@$debits) { - # revert to the original estimated amount re-encumber - $debit->encumbrance('t'); - $debit->amount($lineitem->estimated_unit_price()); - $e->update_acq_fund_debit($debit) or return $e->die_event; - update_copy_cost($e, $debit) or return $e->die_event; # clear the cost - } - - return undef; -} - -sub update_entry_debits { - my($e, $entry) = @_; - - my $debits = find_entry_debits($e, $entry, 't'); - return undef unless @$debits; - - if($entry->phys_item_count > @$debits) { - $e->rollback; - # We can't invoice for more items than we have debits for - return OpenILS::Event->new( - 'ACQ_INVOICE_ENTRY_COUNT_EXCEEDS_DEBITS', - payload => {entry => $entry->id}); - } - - for my $debit (@$debits) { - my $amount = entry_amount_per_item($entry); - $debit->amount($amount); - $debit->encumbrance('f'); - $e->update_acq_fund_debit($debit) or return $e->die_event; - - # TODO: this does not reflect ancillary charges, like taxes, etc. - # We may need a way to indicate whether the amount attached to an - # invoice_item should be prorated and included in the copy cost. - # Note that acq.invoice_item_type.prorate does not necessarily - # mean a charge should be included in the copy price, only that - # it should spread accross funds. - update_copy_cost($e, $debit, $amount) or return $e->die_event; - } - - return undef; -} - -# update the linked copy to reflect the amount paid for the item -# returns true on success, false on error -sub update_copy_cost { - my ($e, $debit, $amount) = @_; - - my $lid = $e->search_acq_lineitem_detail([ - {fund_debit => $debit->id}, - {flesh => 1, flesh_fields => {acqlid => ['eg_copy_id']}} - ])->[0]; - - if($lid and my $copy = $lid->eg_copy_id) { - defined $amount and $copy->cost($amount) or $copy->clear_cost; - $copy->editor($e->requestor->id); - $copy->edit_date('now'); - $e->update_asset_copy($copy) or return 0; - } - - return 1; -} - - -sub entry_amount_per_item { - my $entry = shift; - return $entry->amount_paid if $U->is_true($entry->billed_per_item); - return 0 if $entry->phys_item_count == 0; - return $entry->amount_paid / $entry->phys_item_count; -} - -sub easy_money { # TODO XXX replace with something from a library - my ($val) = @_; - - my $rounded = int($val * 100) / 100.0; - if ($rounded == $val) { - return sprintf("%.02f", $val); - } else { - return sprintf("%g", $val); - } -} - -# 0 on failure (caller should call $e->die_event), array on success -sub amounts_spent_per_fund { - my ($e, $inv_id) = @_; - - my $entries = $e->search_acq_invoice_entry({"invoice" => $inv_id}) or - return 0; - - my $items = $e->search_acq_invoice_item({"invoice" => $inv_id}) or - return 0; - - my %totals_by_fund; - foreach my $entry (@$entries) { - my $debits = find_entry_debits($e, $entry, "f") or return 0; - foreach (@$debits) { - $totals_by_fund{$_->fund} ||= 0.0; - $totals_by_fund{$_->fund} += $_->amount; - } - } - - foreach my $item (@$items) { - next unless $item->fund and $item->amount_paid; - $totals_by_fund{$item->fund} ||= 0.0; - $totals_by_fund{$item->fund} += $item->amount_paid; - } - - my @totals; - foreach my $fund_id (keys %totals_by_fund) { - my $fund = $e->retrieve_acq_fund($fund_id) or return 0; - push @totals, { - "fund" => $fund->to_bare_hash, - "total" => easy_money($totals_by_fund{$fund_id}) - }; - } - - return \@totals; -} - -# there is no direct link between invoice_entry and fund debits. -# when we need to retrieve the related debits, we have to do some searching -sub find_entry_debits { - my($e, $entry, $encumbrance, $amount) = @_; - - my $query = { - select => {acqfdeb => ['id']}, - from => { - acqfdeb => { - acqlid => { - join => { - jub => { - join => { - acqie => { - filter => {id => $entry->id} - } - } - } - } - } - } - }, - where => {'+acqfdeb' => {encumbrance => $encumbrance}}, - order_by => {'acqlid' => ['recv_time']}, # un-received items will sort to the end - limit => $entry->phys_item_count - }; - - $query->{where}->{'+acqfdeb'}->{amount} = $amount if $amount; - - my $debits = $e->json_query($query); - my $debit_ids = [map { $_->{id} } @$debits]; - return (@$debit_ids) ? $e->search_acq_fund_debit({id => $debit_ids}) : []; -} - - -__PACKAGE__->register_method( - method => 'build_invoice_api', - api_name => 'open-ils.acq.invoice.retrieve', - authoritative => 1, - signature => { - desc => q/Creates a new stub invoice/, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => q/Invoice Id/, type => 'number'}, - ], - return => {desc => 'The new invoice w/ entries and items attached', type => 'object', class => 'acqinv'} - } -); - - -sub fetch_invoice_api { - my($self, $conn, $auth, $invoice_id, $options) = @_; - - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - my $invoice = fetch_invoice_impl($e, $invoice_id, $options) or - return $e->event; - return $e->event unless $e->allowed(['VIEW_INVOICE', 'CREATE_INVOICE'], $invoice->receiver); - - return $invoice; -} - -sub fetch_invoice_impl { - my ($e, $invoice_id, $options) = @_; - - $options ||= {}; - - my $args = $options->{"no_flesh_misc"} ? $invoice_id : [ - $invoice_id, - { - "flesh" => 6, - "flesh_fields" => { - "acqinv" => ["entries", "items"], - "acqii" => ["fund_debit", "purchase_order", "po_item"] - } - } - ]; - - return $e->retrieve_acq_invoice($args); -} - -__PACKAGE__->register_method( - method => 'prorate_invoice', - api_name => 'open-ils.acq.invoice.apply_prorate', - signature => { - desc => q/ - For all invoice items that have the prorate flag set to true, this will create the necessary - additional invoice_item's to prorate the cost across all affected funds by percent spent for each fund. - /, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => q/Invoice Id/, type => 'number'}, - ], - return => {desc => 'The updated invoice w/ entries and items attached', type => 'object', class => 'acqinv'} - } -); - - -sub prorate_invoice { - my($self, $conn, $auth, $invoice_id) = @_; - - my $e = new_editor(xact => 1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - - my $invoice = fetch_invoice_impl($e, $invoice_id) or return $e->die_event; - return $e->die_event unless $e->allowed('CREATE_INVOICE', $invoice->receiver); - - my @lid_debits; - push(@lid_debits, @{find_entry_debits($e, $_, 'f', entry_amount_per_item($_))}) for @{$invoice->entries}; - - my $inv_items = $e->search_acq_invoice_item([ - {"invoice" => $invoice_id, "fund_debit" => {"!=" => undef}}, - {"flesh" => 1, "flesh_fields" => {"acqii" => ["fund_debit"]}} - ]) or return $e->die_event; - - my @item_debits = map { $_->fund_debit } @$inv_items; - - my %fund_totals; - my $total_entry_paid = 0; - for my $debit (@lid_debits, @item_debits) { - $fund_totals{$debit->fund} = 0 unless $fund_totals{$debit->fund}; - $fund_totals{$debit->fund} += $debit->amount; - $total_entry_paid += $debit->amount; - } - - $logger->info("invoice: prorating against invoice amount $total_entry_paid"); - - for my $item (@{$invoice->items}) { - - next if $item->fund_debit; # item has already been processed - - # future: cache item types locally - my $item_type = $e->retrieve_acq_invoice_item_type($item->inv_item_type) or return $e->die_event; - next unless $U->is_true($item_type->prorate); - - # Prorate charges across applicable funds - my $full_item_paid = $item->amount_paid; # total amount paid for this item before splitting - my $full_item_cost = $item->cost_billed; # total amount invoiced for this item before splitting - my $first_round = 1; - my $largest_debit; - my $largest_item; - my $total_debited = 0; - my $total_costed = 0; - - for my $fund_id (keys %fund_totals) { - - my $spent_for_fund = $fund_totals{$fund_id}; - next unless $spent_for_fund > 0; - - my $prorated_amount = ($spent_for_fund / $total_entry_paid) * $full_item_paid; - my $prorated_cost = ($spent_for_fund / $total_entry_paid) * $full_item_cost; - $logger->info("invoice: attaching prorated amount $prorated_amount to fund $fund_id for invoice $invoice_id"); - - my $debit; - if($first_round and $item->po_item) { - # if this item is the result of a PO item, repurpose the original debit - # for the first chunk of the prorated amount - $debit = $e->retrieve_acq_fund_debit($item->po_item->fund_debit); - } else { - $debit = Fieldmapper::acq::fund_debit->new; - $debit->isnew(1); - } - - $debit->fund($fund_id); - $debit->amount($prorated_amount); - $debit->origin_amount($prorated_amount); - $debit->origin_currency_type($e->retrieve_acq_fund($fund_id)->currency_type); # future: cache funds locally - $debit->encumbrance('f'); - $debit->debit_type('prorated_charge'); - - if($debit->isnew) { - $e->create_acq_fund_debit($debit) or return $e->die_event; - } else { - $e->update_acq_fund_debit($debit) or return $e->die_event; - } - - $total_debited += $prorated_amount; - $total_costed += $prorated_cost; - $largest_debit = $debit if !$largest_debit or $prorated_amount > $largest_debit->amount; - - if($first_round) { - - # re-purpose the original invoice_item for the first prorated amount - $item->fund($fund_id); - $item->fund_debit($debit->id); - $item->amount_paid($prorated_amount); - $item->cost_billed($prorated_cost); - $e->update_acq_invoice_item($item) or return $e->die_event; - $largest_item = $item if !$largest_item or $prorated_amount > $largest_item->amount_paid; - - } else { - - # for subsequent prorated amounts, create a new invoice_item - my $new_item = $item->clone; - $new_item->clear_id; - $new_item->fund($fund_id); - $new_item->fund_debit($debit->id); - $new_item->amount_paid($prorated_amount); - $new_item->cost_billed($prorated_cost); - $e->create_acq_invoice_item($new_item) or return $e->die_event; - $largest_item = $new_item if !$largest_item or $prorated_amount > $largest_item->amount_paid; - } - - $first_round = 0; - } - - # make sure the percentages didn't leave a small sliver of money over/under-debited - # if so, tweak the largest debit to smooth out the difference - if($total_debited != $full_item_paid or $total_costed != $full_item_cost) { - - my $paid_diff = $full_item_paid - $total_debited; - my $cost_diff = $full_item_cost - $total_debited; - $logger->info("invoice: repairing prorate descrepency of paid:$paid_diff and cost:$cost_diff"); - my $new_paid = $largest_item->amount_paid + $paid_diff; - my $new_cost = $largest_item->cost_billed + $cost_diff; - - $largest_debit = $e->retrieve_acq_fund_debit($largest_debit->id); # get latest copy - $largest_debit->amount($new_paid); - $e->update_acq_fund_debit($largest_debit) or return $e->die_event; - - $largest_item = $e->retrieve_acq_invoice_item($largest_item->id); # get latest copy - $largest_item->amount_paid($new_paid); - $largest_item->cost_billed($new_cost); - - $e->update_acq_invoice_item($largest_item) or return $e->die_event; - } - } - - $invoice = fetch_invoice_impl($e, $invoice_id); - $e->commit; - - return $invoice; -} - - -__PACKAGE__->register_method( - method => "print_html_invoice", - api_name => "open-ils.acq.invoice.print.html", - stream => 1, - signature => { - desc => "Retrieve printable HTML vouchers for each given invoice", - params => [ - {desc => "Authentication token", type => "string"}, - {desc => "Invoice ID or a list of them", type => "mixed"}, - ], - return => { - desc => q{One A/T event containing a printable HTML voucher for - each given invoice}, - type => "object", class => "atev"} - } -); - - -sub print_html_invoice { - my ($self, $conn, $auth, $id_list) = @_; - - my $e = new_editor("authtoken" => $auth); - return $e->die_event unless $e->checkauth; - - $id_list = [$id_list] unless ref $id_list; - - my $invoices = $e->search_acq_invoice({"id" => $id_list}) or - return $e->die_event; - - foreach my $invoice (@$invoices) { - return $e->die_event unless - $e->allowed("VIEW_INVOICE", $invoice->receiver); - - my $amounts = amounts_spent_per_fund($e, $invoice->id) or - return $e->die_event; - - $conn->respond( - $U->fire_object_event( - undef, "format.acqinv.html", $invoice, $invoice->receiver, - "print-on-demand", $amounts - ) - ); - } - - $e->disconnect; - undef; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Lineitem.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq/Lineitem.pm deleted file mode 100644 index c36bf60b1d..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Lineitem.pm +++ /dev/null @@ -1,944 +0,0 @@ -package OpenILS::Application::Acq::Lineitem; -use base qw/OpenILS::Application/; -use strict; use warnings; - -use OpenILS::Event; -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Const qw/:const/; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Application::AppUtils; -use OpenILS::Application::Acq::Financials; -use OpenILS::Application::Cat::BibCommon; -use OpenILS::Application::Cat::AssetCommon; -my $U = 'OpenILS::Application::AppUtils'; - - -__PACKAGE__->register_method( - method => 'create_lineitem', - api_name => 'open-ils.acq.lineitem.create', - signature => { - desc => 'Creates a lineitem', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'The lineitem object to create', type => 'object'}, - ], - return => {desc => 'ID of newly created lineitem on success, Event on error'} - } -); - -sub create_lineitem { - my($self, $conn, $auth, $li) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - - - if($li->picklist) { - my $picklist = $e->retrieve_acq_picklist($li->picklist) - or return $e->die_event; - - if($picklist->owner != $e->requestor->id) { - return $e->die_event unless - $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist); - } - - # indicate the picklist was updated - $picklist->edit_time('now'); - $picklist->editor($e->requestor->id); - $e->update_acq_picklist($picklist) or return $e->die_event; - } - - if($li->purchase_order) { - my $po = $e->retrieve_acq_purchase_order($li->purchase_order) - or return $e->die_event; - return $e->die_event unless - $e->allowed('MANAGE_PROVIDER', $po->ordering_agency, $po); - - $li->provider($po->provider) unless defined $li->provider; - } - - $li->selector($e->requestor->id); - $e->create_acq_lineitem($li) or return $e->die_event; - - $e->commit; - return $li->id; -} - - -__PACKAGE__->register_method( - method => 'retrieve_lineitem', - api_name => 'open-ils.acq.lineitem.retrieve', - authoritative => 1, - signature => { - desc => 'Retrieves a lineitem', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'lineitem ID to retrieve', type => 'number'}, - {options => q/Hash of options, including: -flesh_attrs : for attributes, -flesh_notes : for notes, -flesh_cancel_reason : for cancel reason, -flesh_li_details : for order details objects, -clear_marc : to clear marcxml from lineitem/, type => 'hash'}, - ], - return => {desc => 'lineitem object on success, Event on error'} - } -); - - -sub retrieve_lineitem { - my($self, $conn, $auth, $li_id, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->die_event unless $e->checkauth; - return retrieve_lineitem_impl($e, $li_id, $options); -} - -sub retrieve_lineitem_impl { - my ($e, $li_id, $options, $no_auth) = @_; # no_auth needed for EDI scripts - $options ||= {}; - - my $flesh = { - flesh => 3, - flesh_fields => { - jub => ['purchase_order', 'picklist'], # needed for permission check - acqlid => [], - acqlin => [] - } - }; - - my $fields = $flesh->{flesh_fields}; - - push(@{$fields->{jub} }, 'attributes') if $$options{flesh_attrs}; - push(@{$fields->{jub} },'lineitem_notes') if $$options{flesh_notes}; - push(@{$fields->{acqlin}}, 'alert_text') if $$options{flesh_notes}; - push(@{$fields->{jub} }, 'order_summary') if $$options{flesh_order_summary}; - push(@{$fields->{acqlin}}, 'cancel_reason') if $$options{flesh_cancel_reason}; - - if($$options{flesh_li_details}) { - push(@{$fields->{jub} }, 'lineitem_details'); - push(@{$fields->{acqlid}}, 'fund' ) if $$options{flesh_fund}; - push(@{$fields->{acqlid}}, 'fund_debit' ) if $$options{flesh_fund_debit}; - push(@{$fields->{acqlid}}, 'cancel_reason') if $$options{flesh_cancel_reason}; - } - - if($$options{clear_marc}) { # avoid fetching marc blob - my @fields = grep { $_ ne 'marc' } Fieldmapper::acq::lineitem->new->real_fields; - $flesh->{select} = {jub => [@fields]}; - } - - my $li = $e->retrieve_acq_lineitem([$li_id, $flesh]) or return $e->event; - - # collect the # of lids - if($$options{flesh_li_details}) { - $li->item_count(scalar(@{$li->lineitem_details})); - } else { - my $details = $e->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1}); - $li->item_count(scalar(@$details)); - } - - # attach claims to LIDs - if($$options{flesh_li_details}) { - foreach (@{$li->lineitem_details}) { - $_->claims( - $e->search_acq_claim([ - {"lineitem_detail", $_->id}, { - "flesh" => 1, "flesh_fields" => {"acqcl" => ["type"]} - } - ]) - ); - } - } - - return $e->event unless (( - $li->purchase_order and - ($no_auth or $e->allowed(['VIEW_PURCHASE_ORDER', 'CREATE_PURCHASE_ORDER'], - $li->purchase_order->ordering_agency, $li->purchase_order)) - ) or ( - $li->picklist and !$li->purchase_order and # user doesn't have view_po perms - ($no_auth or $e->allowed(['VIEW_PICKLIST', 'CREATE_PICKLIST'], - $li->picklist->org_unit, $li->picklist)) - )); - - unless ($$options{flesh_po}) { - $li->purchase_order( - $li->purchase_order ? $li->purchase_order->id : undef - ); - } - unless ($$options{flesh_pl}) { - $li->picklist($li->picklist ? $li->picklist->id : undef); - } - return $li; -} - - - -__PACKAGE__->register_method( - method => 'delete_lineitem', - api_name => 'open-ils.acq.lineitem.delete', - signature => { - desc => 'Deletes a lineitem', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'lineitem ID to delete', type => 'number'}, - ], - return => {desc => '1 on success, Event on error'} - } -); - -__PACKAGE__->register_method( - method => 'delete_lineitem', - api_name => 'open-ils.acq.purchase_order.lineitem.delete', - signature => { - desc => 'Deletes a lineitem from a purchase order', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'lineitem ID to delete', type => 'number'}, - ], - return => {desc => '1 on success, Event on error'} - } -); - -__PACKAGE__->register_method( - method => 'delete_lineitem', - api_name => 'open-ils.acq.picklist.lineitem.delete', - signature => { - desc => 'Deletes a lineitem from a picklist', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'lineitem ID to delete', type => 'number'}, - ], - return => {desc => '1 on success, Event on error'} - } -); - -sub delete_lineitem { - my($self, $conn, $auth, $li_id) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - - my $li = $e->retrieve_acq_lineitem($li_id) - or return $e->die_event; - - # XXX check state - - if($li->picklist) { - my $picklist = $e->retrieve_acq_picklist($li->picklist) - or return $e->die_event; - return OpenILS::Event->new('BAD_PARAMS') - if $picklist->owner != $e->requestor->id; - } else { - # check PO perms - } - - # once a LI is attached to a PO, deleting it - # from a picklist means *detaching* it from the picklist - if ($self->api_name =~ /picklist/ && $li->purchase_order) { - $li->clear_picklist; - my $evt = update_lineitem_impl($e, $li); - return $evt if $evt; - $e->commit; - return 1; - } - - # delete the attached lineitem_details - my $lid_ids = $e->search_acq_lineitem_detail( - {lineitem => $li_id}, {idlist=>1}); - - for my $lid_id (@$lid_ids) { - $e->delete_acq_lineitem_detail( - $e->retrieve_acq_lineitem_detail($lid_id)) - or return $e->die_event; - } - - $e->delete_acq_lineitem($li) or return $e->die_event; - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - method => 'update_lineitem', - api_name => 'open-ils.acq.lineitem.update', - signature => { - desc => 'Update one or many lineitems', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'lineitem object update', type => 'object'} - ], - return => {desc => '1 on success, Event on error'} - } -); - -sub update_lineitem { - my($self, $conn, $auth, $li) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - - $li = [$li] unless ref $li eq "ARRAY"; - foreach (@$li) { - my $evt = update_lineitem_impl($e, $_); - return $evt if $evt; - } - - $e->commit; - return 1; -} - -sub update_lineitem_impl { - my($e, $li) = @_; - - my $orig_li = $e->retrieve_acq_lineitem([ - $li->id, - { flesh => 1, # grab the lineitem with picklist attached - flesh_fields => {jub => ['picklist', 'purchase_order']} - } - ]) or return $e->die_event; - - # the marc may have been cleared on retrieval... - $li->marc($orig_li->marc) unless $li->marc; - - $li->editor($e->requestor->id); - $li->edit_time('now'); - $e->update_acq_lineitem($li) or return $e->die_event; - return undef; -} - -__PACKAGE__->register_method( - method => 'lineitem_search', - api_name => 'open-ils.acq.lineitem.search', - stream => 1, - signature => { - desc => 'Searches lineitems', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Search definition', type => 'object'}, - {desc => 'Options hash. idlist=true', type => 'object'}, - {desc => 'List of lineitems', type => 'object/number'}, - ] - } -); - -sub lineitem_search { - my($self, $conn, $auth, $search, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('CREATE_PICKLIST'); - # XXX needs permissions consideration - my $lis = $e->search_acq_lineitem($search, {idlist=>1}); - for my $li_id (@$lis) { - if($$options{idlist}) { - $conn->respond($li_id); - } else { - my $res = retrieve_lineitem($self, $conn, $auth, $li_id, $options); - $conn->respond($res) unless $U->event_code($res); - } - } - return undef; -} - -__PACKAGE__->register_method ( - method => 'lineitems_related_by_bib', - api_name => 'open-ils.acq.lineitems_for_bib.by_bib_id', - stream => 1, - signature => q/ - Retrieves lineitems attached to same bib record, subject to the PO ordering agency. This variant takes the bib id. - @param authtoken Login session key - @param bib_id Id for the pertinent bib record. - @param options Object for tweaking the selection criteria and fleshing options. - / -); - -__PACKAGE__->register_method ( - method => 'lineitems_related_by_bib', - api_name => 'open-ils.acq.lineitems_for_bib.by_lineitem_id', - stream => 1, - signature => q/ - Retrieves lineitems attached to same bib record, subject to the PO ordering agency. This variant takes the id for any of the pertinent lineitems. - @param authtoken Login session key - @param bib_id Id for a pertinent lineitem. - @param options Object for tweaking the selection criteria and fleshing options. - / -); - -__PACKAGE__->register_method ( - method => 'lineitems_related_by_bib', - api_name => 'open-ils.acq.lineitems_for_bib.by_lineitem_id.count', - stream => 1, - signature => q/See open-ils.acq.lineitems_for_bib.by_lineitem_id. This version returns numbers of lineitems only (XXX may count lineitems we don't actually have permission to retrieve)/ -); - -sub lineitems_related_by_bib { - my($self, $conn, $auth, $test_value, $options) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - my $perm_orgs = $U->user_has_work_perm_at($e, 'VIEW_PURCHASE_ORDER', {descendants =>1}, $e->requestor->id); - - my $query = { - "select"=>{"jub"=>["id"]}, - "from"=>{"jub" => {"acqpo" => {type => 'left'}, "acqpl" => {type => 'left'}}}, - "where"=>{ - '-or' => [ - { "+acqpo"=>{ "ordering_agency" => $perm_orgs } }, - { '+acqpl' => { org_unit => $perm_orgs } } - ] - }, - "order_by"=>[{"class"=>"jub", "field"=>"create_time", "direction"=>"desc"}] - }; - - # Be sure we just return the original LI if no related bibs - if ($self->api_name =~ /by_lineitem_id/) { - my $orig = retrieve_lineitem($self, $conn, $auth, $test_value) or - return $e->die_event; - if ($test_value = $orig->eg_bib_id) { - $query->{"where"}->{"eg_bib_id"} = $test_value; - } else { - $query->{"where"}->{"id"} = $orig->id; - } - } elsif ($test_value) { - $query->{"where"}->{"eg_bib_id"} = $test_value; - } else { - $e->disconnect; - return new OpenILS::Event("BAD_PARAMS", "Null bib id"); - } - - if ($options && defined $options->{lineitem_state}) { - $query->{'where'}{'jub'}{'state'} = $options->{lineitem_state}; - } - - if ($options && defined $options->{po_state}) { - $query->{'where'}{'+acqpo'}{'state'} = $options->{po_state}; - } - - if ($options && defined $options->{order_by}) { - $query->{'order_by'} = $options->{order_by}; - } - - my $results = $e->json_query($query); - if ($self->api_name =~ /count$/) { - return scalar(@$results); - } else { - for my $result (@$results) { - # retrieve_lineitem takes care of POs and PLs and also handles - # options like flesh_notes and permissions checking. - $conn->respond( - retrieve_lineitem($self, $conn, $auth, $result->{"id"}, $options) - ); - } - } - - return undef; -} - - -__PACKAGE__->register_method( - method => "lineitem_search_by_attributes", - api_name => "open-ils.acq.lineitem.search.by_attributes", - stream => 1, - signature => { - desc => "Performs a search against lineitem_attrs", - params => [ - {desc => "Authentication token", type => "string"}, - { desc => q/ -Search definition: - attr_value_pairs : list of pairs of (attr definition ID, attr value) where value can be scalar (fuzzy match) or array (exact match) - li_states : list of lineitem states - po_agencies : list of purchase order ordering agencies (org) ids - -At least one of these search terms is required. - /, - type => "object"}, - { desc => q/ -Options hash: - idlist : if set, only return lineitem IDs - clear_marc : if set, strip the MARC xml from the lineitem before delivery - flesh_attrs : flesh lineitem attributes; - /, - type => "object"} - ] - } -); - -__PACKAGE__->register_method( - method => "lineitem_search_by_attributes", - api_name => "open-ils.acq.lineitem.search.by_attributes.ident", - stream => 1, - signature => { - desc => "Performs a search against lineitem_attrs where ident is true. ". - "See open-ils.acq.lineitem.search.by_attributes for params." - } -); - -sub lineitem_search_by_attributes { - my ($self, $conn, $auth, $search, $options) = @_; - - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - # XXX needs permissions consideration - - return [] unless $search; - my $attr_value_pairs = $search->{attr_value_pairs}; - my $li_states = $search->{li_states}; - my $po_agencies = $search->{po_agencies}; # XXX if none, base it on perms - - my $query = { - "select" => {"acqlia" => - [{"column" => "lineitem", "transform" => "distinct"}] - }, - "from" => { - "acqlia" => { - "acqliad" => {"field" => "id", "fkey" => "definition"}, - "jub" => { - "field" => "id", - "fkey" => "lineitem", - "join" => { - "acqpo" => { - "type" => "left", - "field" => "id", - "fkey" => "purchase_order" - } - } - } - } - } - }; - - my $where = {}; - $where->{"+acqliad"} = {"ident" => "t"} - if $self->api_name =~ /\.ident/; - - my $searched_for_something = 0; - - if (ref $attr_value_pairs eq "ARRAY") { - $where->{"-or"} = []; - foreach (@$attr_value_pairs) { - next if @$_ != 2; - my ($def, $value) = @$_; - push @{$where->{"-or"}}, { - "-and" => { - "attr_value" => (ref $value) ? - $value : {"ilike" => "%" . $value . "%"}, - "definition" => $def - } - }; - } - $searched_for_something = 1; - } - - if ($li_states and @$li_states) { - $where->{"+jub"} = {"state" => $li_states}; - $searched_for_something = 1; - } - - if ($po_agencies and @$po_agencies) { - $where->{"+acqpo"} = {"ordering_agency" => $po_agencies}; - $searched_for_something = 1; - } - - if (not $searched_for_something) { - $e->rollback; - return new OpenILS::Event( - "BAD_PARAMS", note => "You have provided no search terms." - ); - } - - $query->{"where"} = $where; - my $lis = $e->json_query($query); - - for my $li_id_obj (@$lis) { - my $li_id = $li_id_obj->{"lineitem"}; - if($options->{"idlist"}) { - $conn->respond($li_id); - } else { - $conn->respond( - retrieve_lineitem($self, $conn, $auth, $li_id, $options) - ); - } - } - undef; -} - - -__PACKAGE__->register_method( - method => 'lineitem_search_ident', - api_name => 'open-ils.acq.lineitem.search.ident', - stream => 1, - signature => { - desc => 'Performs a search against lineitem_attrs where ident is true', - params => [ - {desc => 'Authentication token', type => 'string'}, - { desc => q/Search definition. Options are: - attr_values : list of attribute values (required) - li_states : list of lineitem states - po_agencies : list of purchase order ordering agencies (org) ids - /, - type => 'object', - }, - { desc => q/ - Options hash. Options are: - idlist : if set, only return lineitem IDs - clear_marc : if set, strip the MARC xml from the lineitem before delivery - flesh_attrs : flesh lineitem attributes; - /, - type => 'object', - } - ] - } -); - -my $LI_ATTR_SEARCH = { - select => { acqlia => ['lineitem'] }, - from => { - acqlia => { - acqliad => { - field => 'id', - fkey => 'definition' - }, - jub => { - field => 'id', - fkey => 'lineitem', - join => { - acqpo => { - field => 'id', - fkey => 'purchase_order' - } - } - } - } - } -}; - -sub lineitem_search_ident { - my($self, $conn, $auth, $search, $options) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->event unless $e->checkauth; - # XXX needs permissions consideration - - return [] unless $search; - my $attr_values = $search->{attr_values}; - my $li_states = $search->{li_states}; - my $po_agencies = $search->{po_agencies}; # XXX if none, base it on perms - - my $where_clause = { - '-or' => [], - '+acqlia' => { - '+acqliad' => {ident => 't'}, - } - }; - - push(@{$where_clause->{'-or'}}, {attr_value => {ilike => "%$_%"}}) for @$attr_values; - - $where_clause->{'+jub'} = {state => {in => $li_states}} - if $li_states and @$li_states; - - $where_clause->{'+acqpo'} = {ordering_agency => $po_agencies} - if $po_agencies and @$po_agencies; - - $LI_ATTR_SEARCH->{where} = $where_clause; - - my $lis = $e->json_query($LI_ATTR_SEARCH); - - for my $li_id_obj (@$lis) { - my $li_id = $li_id_obj->{lineitem}; - if($$options{idlist}) { - $conn->respond($li_id); - } else { - my $li; - if($$options{flesh_attrs}) { - $li = $e->retrieve_acq_lineitem([ - $li_id, {flesh => 1, flesh_fields => {jub => ['attributes']}}]) - } else { - $li = $e->retrieve_acq_lineitem($li_id); - } - $li->clear_marc if $$options{clear_marc}; - $conn->respond($li); - } - } - return undef; -} - - -__PACKAGE__->register_method( - method => 'retrieve_lineitem_detail', - api_name => 'open-ils.acq.lineitem_detail.retrieve', - authoritative => 1, - signature => { - desc => q/Updates a lineitem detail/, - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'id of lineitem_detail to retrieve', type => 'number' }, - ], - return => { desc => 'object on success, Event on failure' } - } -); -sub retrieve_lineitem_detail { - my($self, $conn, $auth, $li_detail_id) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - my $li_detail = $e->retrieve_acq_lineitem_detail($li_detail_id) - or return $e->event; - - if($li_detail->fund) { - my $fund = $e->retrieve_acq_fund($li_detail->fund) or return $e->event; - return $e->event unless - $e->allowed('MANAGE_FUND', $fund->org, $fund); - } - - # XXX check lineitem perms - return $li_detail; -} - - -__PACKAGE__->register_method( - method => 'approve_lineitem', - api_name => 'open-ils.acq.lineitem.approve', - signature => { - desc => 'Mark a lineitem as approved', - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'lineitem ID', type => 'number' } - ], - return => { desc => '1 on success, Event on error' } - } -); -sub approve_lineitem { - my($self, $conn, $auth, $li_id) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - - # XXX perm checks for each lineitem detail - - my $li = $e->retrieve_acq_lineitem($li_id) - or return $e->die_event; - - return OpenILS::Event->new('ACQ_LINEITEM_APPROVED', payload => $li_id) - if $li->state eq 'approved'; - - my $details = $e->search_acq_lineitem_detail({lineitem => $li_id}); - return OpenILS::Event->new('ACQ_LINEITEM_NO_COPIES', payload => $li_id) - unless scalar(@$details) > 0; - - for my $detail (@$details) { - return OpenILS::Event->new('ACQ_LINEITEM_DETAIL_NO_FUND', payload => $detail->id) - unless $detail->fund; - - return OpenILS::Event->new('ACQ_LINEITEM_DETAIL_NO_ORG', payload => $detail->id) - unless $detail->owning_lib; - } - - $li->state('approved'); - $li->edit_time('now'); - $e->update_acq_lineitem($li) or return $e->die_event; - - $e->commit; - return 1; -} - - - -__PACKAGE__->register_method( - method => 'set_lineitem_attr', - api_name => 'open-ils.acq.lineitem_usr_attr.set', - signature => { - desc => 'Sets a lineitem_usr_attr value', - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'Lineitem ID', type => 'number' }, - { desc => 'Attr name', type => 'string' }, - { desc => 'Attr value', type => 'string' } - ], - return => { desc => '1 on success, Event on error' } - } -); - -__PACKAGE__->register_method( - method => 'set_lineitem_attr', - api_name => 'open-ils.acq.lineitem_local_attr.set', - signature => { - desc => 'Sets a lineitem_local_attr value', - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'Lineitem ID', type => 'number' }, - { desc => 'Attr name', type => 'string' }, - { desc => 'Attr value', type => 'string' } - ], - return => { desc => 'ID of the attr object on success, Event on error' } - } -); - - -sub set_lineitem_attr { - my($self, $conn, $auth, $li_id, $attr_name, $attr_value) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - - # XXX perm - - my $attr_type = $self->api_name =~ /local_attr/ ? - 'lineitem_local_attr_definition' : 'lineitem_usr_attr_definition'; - - my $attr = $e->search_acq_lineitem_attr({ - lineitem => $li_id, - attr_type => $attr_type, - attr_name => $attr_name})->[0]; - - my $find = "search_acq_$attr_type"; - - if($attr) { - $attr->attr_value($attr_value); - $e->update_acq_lineitem_attr($attr) or return $e->die_event; - } else { - $attr = Fieldmapper::acq::lineitem_attr->new; - $attr->lineitem($li_id); - $attr->attr_type($attr_type); - $attr->attr_name($attr_name); - $attr->attr_value($attr_value); - - my $attr_def_id = $e->$find({code => $attr_name}, {idlist=>1})->[0] - or return $e->die_event; - $attr->definition($attr_def_id); - $e->create_acq_lineitem_attr($attr) or return $e->die_event; - } - - $e->commit; - return $attr->id; -} - -__PACKAGE__->register_method( - method => 'get_lineitem_attr_defs', - api_name => 'open-ils.acq.lineitem_attr_definition.retrieve.all', - authoritative => 1, - signature => { - desc => 'Retrieve lineitem attr definitions', - params => [ { desc => 'Authentication token', type => 'string' }, ], - return => { desc => 'List of attr definitions' } - } -); - -sub get_lineitem_attr_defs { - my($self, $conn, $auth) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - my %results; - for my $type (qw/generated marc local usr provider/) { - my $call = "retrieve_all_acq_lineitem_${type}_attr_definition"; - $results{$type} = $e->$call; - } - return \%results; -} - - -__PACKAGE__->register_method( - method => 'lineitem_note_CUD_batch', - api_name => 'open-ils.acq.lineitem_note.cud.batch', - stream => 1, - signature => { - desc => q/Manage lineitem notes/, - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'List of lineitem_notes to manage', type => 'array' }, - ], - return => - { desc => 'Streaming response of current position in the array' } - } -); - -sub lineitem_note_CUD_batch { - my($self, $conn, $auth, $li_notes) = @_; - - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - # XXX perms - - my $total = @$li_notes; - my $count = 0; - - for my $note (@$li_notes) { - - $note->editor($e->requestor->id); - $note->edit_time('now'); - - if($note->isnew) { - $note->creator($e->requestor->id); - $note = $e->create_acq_lineitem_note($note) or return $e->die_event; - - } elsif($note->isdeleted) { - $e->delete_acq_lineitem_note($note) or return $e->die_event; - - } elsif($note->ischanged) { - $e->update_acq_lineitem_note($note) or return $e->die_event; - } - - if(!$note->isdeleted) { - $note = $e->retrieve_acq_lineitem_note([ - $note->id, { - "flesh" => 1, "flesh_fields" => {"acqlin" => ["alert_text"]} - } - ]); - } - - $conn->respond({maximum => $total, progress => ++$count, note => $note}); - } - - $e->commit; - return {complete => 1}; -} - -__PACKAGE__->register_method( - method => 'ranged_line_item_alert_text', - api_name => 'open-ils.acq.line_item_alert_text.ranged.retrieve.all'); # TODO: signature - -sub ranged_line_item_alert_text { - my($self, $conn, $auth, $org_id, $depth) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('ADMIN_ACQ_LINEITEM_ALERT_TEXT', $org_id); - return $e->search_acq_lineitem_alert_text( - {owning_lib => $U->get_org_full_path($org_id, $depth)}); -} - - -__PACKAGE__->register_method( - method => "retrieve_lineitem_by_copy_id", - api_name => "open-ils.acq.lineitem.retrieve.by_copy_id", - authoritative => 1, - signature => { - desc => q/Manage lineitem notes/, - params => [ - {desc => "Authentication token", type => "string"}, - {desc => "Evergreen internal copy ID", type => "number"}, - {desc => "Hash of options (see open-ils.acq.lineitem.retrieve", - type => "object"} - ], - return => { - desc => "Lineitem associated with given copy", - type => "object", class => "jub" - } - } -); - -sub retrieve_lineitem_by_copy_id { - my ($self, $conn, $auth, $object_id, $options) = @_; - - my $e = new_editor("authtoken" => $auth); - return $e->die_event unless $e->checkauth; - - my $result = $e->json_query({ - "select" => {"acqlid" => ["lineitem"]}, - "from" => "acqlid", - "where" => {"eg_copy_id" => $object_id} - })->[0] or do { - $e->disconnect; - return new OpenILS::Event("ACQ_LINEITEM_NOT_FOUND"); - }; - - my $li = retrieve_lineitem_impl($e, $result->{"lineitem"}, $options) or - return $e->die_event; - - $e->disconnect; - return $li; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Order.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq/Order.pm deleted file mode 100644 index f37f89375b..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Order.pm +++ /dev/null @@ -1,3177 +0,0 @@ -package OpenILS::Application::Acq::BatchManager; -use OpenILS::Application::Acq::Financials; -use OpenSRF::AppSession; -use OpenSRF::EX qw/:try/; -use strict; use warnings; - -sub new { - my($class, %args) = @_; - my $self = bless(\%args, $class); - $self->{args} = { - lid => 0, - li => 0, - copies => 0, - bibs => 0, - progress => 0, - debits_accrued => 0, - purchase_order => undef, - picklist => undef, - complete => 0, - indexed => 0, - total => 0 - }; - $self->{ingest_queue} = []; - $self->{cache} = {}; - $self->throttle(5) unless $self->throttle; - $self->{post_proc_queue} = []; - $self->{last_respond_progress} = 0; - return $self; -} - -sub conn { - my($self, $val) = @_; - $self->{conn} = $val if $val; - return $self->{conn}; -} -sub throttle { - my($self, $val) = @_; - $self->{throttle} = $val if $val; - return $self->{throttle}; -} -sub respond { - my($self, %other_args) = @_; - if($self->throttle and not %other_args) { - return unless ( - ($self->{args}->{progress} - $self->{last_respond_progress}) >= $self->throttle - ); - } - $self->conn->respond({ %{$self->{args}}, %other_args }); - $self->{last_respond_progress} = $self->{args}->{progress}; -} -sub respond_complete { - my($self, %other_args) = @_; - $self->complete; - $self->conn->respond_complete({ %{$self->{args}}, %other_args }); - $self->run_post_response_hooks; - return undef; -} - -# run the post response hook subs, shifting them off as we go -sub run_post_response_hooks { - my($self) = @_; - (shift @{$self->{post_proc_queue}})->() while @{$self->{post_proc_queue}}; -} - -# any subs passed to this method will be run after the call to respond_complete -sub post_process { - my($self, $sub) = @_; - push(@{$self->{post_proc_queue}}, $sub); -} - -sub total { - my($self, $val) = @_; - $self->{args}->{total} = $val if defined $val; - $self->{args}->{maximum} = $self->{args}->{total}; - return $self->{args}->{total}; -} -sub purchase_order { - my($self, $val) = @_; - $self->{args}->{purchase_order} = $val if $val; - return $self; -} -sub picklist { - my($self, $val) = @_; - $self->{args}->{picklist} = $val if $val; - return $self; -} -sub add_lid { - my $self = shift; - $self->{args}->{lid} += 1; - $self->{args}->{progress} += 1; - return $self; -} -sub add_li { - my $self = shift; - $self->{args}->{li} += 1; - $self->{args}->{progress} += 1; - return $self; -} -sub add_copy { - my $self = shift; - $self->{args}->{copies} += 1; - $self->{args}->{progress} += 1; - return $self; -} -sub add_bib { - my $self = shift; - $self->{args}->{bibs} += 1; - $self->{args}->{progress} += 1; - return $self; -} -sub add_debit { - my($self, $amount) = @_; - $self->{args}->{debits_accrued} += $amount; - $self->{args}->{progress} += 1; - return $self; -} -sub editor { - my($self, $editor) = @_; - $self->{editor} = $editor if defined $editor; - return $self->{editor}; -} -sub complete { - my $self = shift; - $self->{args}->{complete} = 1; - return $self; -} - -sub ingest_ses { - my($self, $val) = @_; - $self->{ingest_ses} = $val if $val; - return $self->{ingest_ses}; -} - -sub push_ingest_queue { - my($self, $rec_id) = @_; - - $self->ingest_ses(OpenSRF::AppSession->connect('open-ils.ingest')) - unless $self->ingest_ses; - - my $req = $self->ingest_ses->request('open-ils.ingest.full.biblio.record', $rec_id); - - push(@{$self->{ingest_queue}}, $req); -} - -sub process_ingest_records { - my $self = shift; - return unless @{$self->{ingest_queue}}; - - for my $req (@{$self->{ingest_queue}}) { - - try { - $req->gather(1); - $self->{args}->{indexed} += 1; - $self->{args}->{progress} += 1; - } otherwise {}; - - $self->respond; - } - $self->ingest_ses->disconnect; -} - - -sub cache { - my($self, $org, $key, $val) = @_; - $self->{cache}->{$org} = {} unless $self->{cache}->{org}; - $self->{cache}->{$org}->{$key} = $val if defined $val; - return $self->{cache}->{$org}->{$key}; -} - - -package OpenILS::Application::Acq::Order; -use base qw/OpenILS::Application/; -use strict; use warnings; -# ---------------------------------------------------------------------------- -# Break up each component of the order process and pieces into managable -# actions that can be shared across different workflows -# ---------------------------------------------------------------------------- -use OpenILS::Event; -use OpenSRF::Utils::Logger qw(:logger); -use OpenSRF::Utils::JSON; -use OpenSRF::AppSession; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Const qw/:const/; -use OpenSRF::EX q/:try/; -use OpenILS::Application::AppUtils; -use OpenILS::Application::Cat::BibCommon; -use OpenILS::Application::Cat::AssetCommon; -use MARC::Record; -use MARC::Batch; -use MARC::File::XML; -my $U = 'OpenILS::Application::AppUtils'; - - -# ---------------------------------------------------------------------------- -# Lineitem -# ---------------------------------------------------------------------------- -sub create_lineitem { - my($mgr, %args) = @_; - my $li = Fieldmapper::acq::lineitem->new; - $li->creator($mgr->editor->requestor->id); - $li->selector($li->creator); - $li->editor($li->creator); - $li->create_time('now'); - $li->edit_time('now'); - $li->state('new'); - $li->$_($args{$_}) for keys %args; - $li->clear_id; - $mgr->add_li; - $mgr->editor->create_acq_lineitem($li) or return 0; - - unless($li->estimated_unit_price) { - # extract the price from the MARC data - my $price = get_li_price_from_attr($mgr->editor, $li) or return $li; - $li->estimated_unit_price($price); - return update_lineitem($mgr, $li); - } - - return $li; -} - -sub get_li_price_from_attr { - my($e, $li) = @_; - my $attrs = $li->attributes || $e->search_acq_lineitem_attr({lineitem => $li->id}); - - for my $attr_type (qw/ - lineitem_local_attr_definition - lineitem_prov_attr_definition - lineitem_marc_attr_definition/) { - - my ($attr) = grep { - $_->attr_name eq 'estimated_price' and - $_->attr_type eq $attr_type } @$attrs; - - return $attr->attr_value if $attr; - } - - return undef; -} - - -sub update_lineitem { - my($mgr, $li) = @_; - $li->edit_time('now'); - $li->editor($mgr->editor->requestor->id); - $mgr->add_li; - return $mgr->editor->retrieve_acq_lineitem($mgr->editor->data) if - $mgr->editor->update_acq_lineitem($li); - return undef; -} - - -# ---------------------------------------------------------------------------- -# Create real holds from patron requests for a given lineitem -# ---------------------------------------------------------------------------- -sub promote_lineitem_holds { - my($mgr, $li) = @_; - - my $requests = $mgr->editor->search_acq_user_request( - { lineitem => $li->id, - '-or' => - [ { need_before => {'>' => 'now'} }, - { need_before => undef } - ] - } - ); - - for my $request ( @$requests ) { - - $request->eg_bib( $li->eg_bib_id ); - $mgr->editor->update_acq_user_request( $request ) or return 0; - - next unless ($U->is_true( $request->hold )); - - my $hold = Fieldmapper::action::hold_request->new; - $hold->usr( $request->usr ); - $hold->requestor( $request->usr ); - $hold->request_time( $request->request_date ); - $hold->pickup_lib( $request->pickup_lib ); - $hold->request_lib( $request->pickup_lib ); - $hold->selection_ou( $request->pickup_lib ); - $hold->phone_notify( $request->phone_notify ); - $hold->email_notify( $request->email_notify ); - $hold->expire_time( $request->need_before ); - - if ($request->holdable_formats) { - my $mrm = $mgr->editor->search_metabib_metarecord_source_map( { source => $li->eg_bib_id } )->[0]; - if ($mrm) { - $hold->hold_type( 'M' ); - $hold->holdable_formats( $request->holdable_formats ); - $hold->target( $mrm->metarecord ); - } - } - - if (!$hold->target) { - $hold->hold_type( 'T' ); - $hold->target( $li->eg_bib_id ); - } - - $mgr->editor->create_actor_hold_request( $hold ) or return 0; - } - - return $li; -} - -sub delete_lineitem { - my($mgr, $li) = @_; - $li = $mgr->editor->retrieve_acq_lineitem($li) unless ref $li; - - # delete the attached lineitem_details - my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1}); - for my $lid_id (@$lid_ids) { - return 0 unless delete_lineitem_detail($mgr, $lid_id); - } - - $mgr->add_li; - return $mgr->editor->delete_acq_lineitem($li); -} - -# begins and commit transactions as it goes -sub create_lineitem_list_assets { - my($mgr, $li_ids) = @_; - return undef if check_import_li_marc_perms($mgr, $li_ids); - - # create the bibs/volumes/copies and ingest the records - for my $li_id (@$li_ids) { - $mgr->editor->xact_begin; - my $data = create_lineitem_assets($mgr, $li_id) or return undef; - $mgr->editor->xact_commit; - # XXX ingest is in-db now - #$mgr->push_ingest_queue($data->{li}->eg_bib_id) if $data->{new_bib}; - $mgr->respond; - } - $mgr->process_ingest_records; - return 1; -} - -# returns event on error, undef on success -sub check_import_li_marc_perms { - my($mgr, $li_ids) = @_; - - # if there are any order records that are not linked to - # in-db bib records, verify staff has perms to import order records - my $order_li = $mgr->editor->search_acq_lineitem( - [{id => $li_ids, eg_bib_id => undef}, {limit => 1}], {idlist => 1})->[0]; - - if($order_li) { - return $mgr->editor->die_event unless - $mgr->editor->allowed('IMPORT_ACQ_LINEITEM_BIB_RECORD'); - } - - return undef; -} - - -# ---------------------------------------------------------------------------- -# if all of the lineitem details for this lineitem have -# been received, mark the lineitem as received -# returns 1 on non-received, li on received, 0 on error -# ---------------------------------------------------------------------------- - -sub describe_affected_po { - my ($e, $po) = @_; - - my ($enc, $spent) = - OpenILS::Application::Acq::Financials::build_price_summary( - $e, $po->id - ); - - +{$po->id => { - "state" => $po->state, - "amount_encumbered" => $enc, - "amount_spent" => $spent - } - }; -} - -sub check_lineitem_received { - my($mgr, $li_id) = @_; - - my $non_recv = $mgr->editor->search_acq_lineitem_detail( - {recv_time => undef, lineitem => $li_id}, {idlist=>1}); - - return 1 if @$non_recv; - - my $li = $mgr->editor->retrieve_acq_lineitem($li_id); - $li->state('received'); - return update_lineitem($mgr, $li); -} - -sub receive_lineitem { - my($mgr, $li_id, $skip_complete_check) = @_; - my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0; - - my $lid_ids = $mgr->editor->search_acq_lineitem_detail( - {lineitem => $li_id, recv_time => undef}, {idlist => 1}); - - for my $lid_id (@$lid_ids) { - receive_lineitem_detail($mgr, $lid_id, 1) or return 0; - } - - $mgr->add_li; - $li->state('received'); - - $li = update_lineitem($mgr, $li) or return 0; - $mgr->post_process( sub { create_lineitem_status_events($mgr, $li_id, 'aur.received'); }); - - my $po; - return 0 unless - $skip_complete_check or ( - $po = check_purchase_order_received($mgr, $li->purchase_order) - ); - - my $result = {"li" => {$li->id => {"state" => $li->state}}}; - $result->{"po"} = describe_affected_po($mgr->editor, $po) if ref $po; - return $result; -} - -sub rollback_receive_lineitem { - my($mgr, $li_id) = @_; - my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0; - - my $lid_ids = $mgr->editor->search_acq_lineitem_detail( - {lineitem => $li_id, recv_time => {'!=' => undef}}, {idlist => 1}); - - for my $lid_id (@$lid_ids) { - rollback_receive_lineitem_detail($mgr, $lid_id, 1) or return 0; - } - - $mgr->add_li; - $li->state('on-order'); - return update_lineitem($mgr, $li); -} - - -sub create_lineitem_status_events { - my($mgr, $li_id, $hook) = @_; - - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - $ses->connect; - my $user_reqs = $mgr->editor->search_acq_user_request([ - {lineitem => $li_id}, - {flesh => 1, flesh_fields => {aur => ['usr']}} - ]); - - for my $user_req (@$user_reqs) { - my $req = $ses->request('open-ils.trigger.event.autocreate', $hook, $user_req, $user_req->usr->home_ou); - $req->recv; - } - - $ses->disconnect; - return undef; -} - -# ---------------------------------------------------------------------------- -# Lineitem Detail -# ---------------------------------------------------------------------------- -sub create_lineitem_detail { - my($mgr, %args) = @_; - my $lid = Fieldmapper::acq::lineitem_detail->new; - $lid->$_($args{$_}) for keys %args; - $lid->clear_id; - $mgr->add_lid; - return $mgr->editor->create_acq_lineitem_detail($lid); -} - - -# flesh out any required data with default values where appropriate -sub complete_lineitem_detail { - my($mgr, $lid) = @_; - unless($lid->barcode) { - my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ'; - $lid->barcode($pfx.$lid->id); - } - - unless($lid->cn_label) { - my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ'; - $lid->cn_label($pfx.$lid->id); - } - - if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) { - $lid->location($loc); - } - - $lid->circ_modifier(get_default_circ_modifier($mgr, $lid->owning_lib)) - unless defined $lid->circ_modifier; - - $mgr->editor->update_acq_lineitem_detail($lid) or return 0; - return $lid; -} - -sub get_default_circ_modifier { - my($mgr, $org) = @_; - my $code = $mgr->cache($org, 'def_circ_mod'); - $code = $U->ou_ancestor_setting_value($org, 'acq.default_circ_modifier') unless defined $code; - return $mgr->cache($org, 'def_circ_mod', $code) if defined $code; - return undef; -} - -sub delete_lineitem_detail { - my($mgr, $lid) = @_; - $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid; - return $mgr->editor->delete_acq_lineitem_detail($lid); -} - - -sub receive_lineitem_detail { - my($mgr, $lid_id, $skip_complete_check) = @_; - my $e = $mgr->editor; - - my $lid = $e->retrieve_acq_lineitem_detail([ - $lid_id, - { flesh => 1, - flesh_fields => { - acqlid => ['fund_debit'] - } - } - ]) or return 0; - - return 1 if $lid->recv_time; - - $lid->recv_time('now'); - $e->update_acq_lineitem_detail($lid) or return 0; - - my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0; - $copy->status(OILS_COPY_STATUS_IN_PROCESS); - $copy->edit_date('now'); - $copy->editor($e->requestor->id); - $e->update_asset_copy($copy) or return 0; - - $mgr->add_lid; - - return 1 if $skip_complete_check; - - my $li = check_lineitem_received($mgr, $lid->lineitem) or return 0; - return 1 if $li == 1; # li not received - - return check_purchase_order_received($mgr, $li->purchase_order) or return 0; -} - - -sub rollback_receive_lineitem_detail { - my($mgr, $lid_id) = @_; - my $e = $mgr->editor; - - my $lid = $e->retrieve_acq_lineitem_detail([ - $lid_id, - { flesh => 1, - flesh_fields => { - acqlid => ['fund_debit'] - } - } - ]) or return 0; - - return 1 unless $lid->recv_time; - - $lid->clear_recv_time; - $e->update_acq_lineitem_detail($lid) or return 0; - - my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0; - $copy->status(OILS_COPY_STATUS_ON_ORDER); - $copy->edit_date('now'); - $copy->editor($e->requestor->id); - $e->update_asset_copy($copy) or return 0; - - $mgr->add_lid; - return $lid; -} - -# ---------------------------------------------------------------------------- -# Lineitem Attr -# ---------------------------------------------------------------------------- -sub set_lineitem_attr { - my($mgr, %args) = @_; - my $attr_type = $args{attr_type}; - - # first, see if it's already set. May just need to overwrite it - my $attr = $mgr->editor->search_acq_lineitem_attr({ - lineitem => $args{lineitem}, - attr_type => $args{attr_type}, - attr_name => $args{attr_name} - })->[0]; - - if($attr) { - $attr->attr_value($args{attr_value}); - return $attr if $mgr->editor->update_acq_lineitem_attr($attr); - return undef; - - } else { - - $attr = Fieldmapper::acq::lineitem_attr->new; - $attr->$_($args{$_}) for keys %args; - - unless($attr->definition) { - my $find = "search_acq_$attr_type"; - my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0; - $attr->definition($attr_def_id); - } - return $mgr->editor->create_acq_lineitem_attr($attr); - } -} - -# ---------------------------------------------------------------------------- -# Lineitem Debits -# ---------------------------------------------------------------------------- -sub create_lineitem_debits { - my ($mgr, $li, $dry_run) = @_; - - unless($li->estimated_unit_price) { - $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id)); - $mgr->editor->rollback; - return 0; - } - - unless($li->provider) { - $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id)); - $mgr->editor->rollback; - return 0; - } - - my $lid_ids = $mgr->editor->search_acq_lineitem_detail( - {lineitem => $li->id}, - {idlist=>1} - ); - - for my $lid_id (@$lid_ids) { - - my $lid = $mgr->editor->retrieve_acq_lineitem_detail([ - $lid_id, - { flesh => 1, - flesh_fields => {acqlid => ['fund']} - } - ]); - - create_lineitem_detail_debit($mgr, $li, $lid, $dry_run) or return 0; - } - - return 1; -} - - -# flesh li->provider -# flesh lid->fund -sub create_lineitem_detail_debit { - my ($mgr, $li, $lid, $dry_run, $no_translate) = @_; - - # don't create the debit if one already exists - return $mgr->editor->retrieve_acq_fund_debit($lid->fund_debit) if $lid->fund_debit; - - my $li_id = ref($li) ? $li->id : $li; - - unless(ref $li and ref $li->provider) { - $li = $mgr->editor->retrieve_acq_lineitem([ - $li_id, - { flesh => 1, - flesh_fields => {jub => ['provider']}, - } - ]); - } - - if(ref $lid) { - $lid->fund($mgr->editor->retrieve_acq_fund($lid->fund)) unless(ref $lid->fund); - } else { - $lid = $mgr->editor->retrieve_acq_lineitem_detail([ - $lid, - { flesh => 1, - flesh_fields => {acqlid => ['fund']} - } - ]); - } - - unless ($lid->fund) { - $mgr->editor->event( - new OpenILS::Event("ACQ_FUND_NOT_FOUND") # close enough - ); - return 0; - } - - my $amount = $li->estimated_unit_price; - if($li->provider->currency_type ne $lid->fund->currency_type and !$no_translate) { - - # At Fund debit creation time, translate into the currency of the fund - # TODO: org setting to disable automatic currency conversion at debit create time? - - $amount = $mgr->editor->json_query({ - from => [ - 'acq.exchange_ratio', - $li->provider->currency_type, # source currency - $lid->fund->currency_type, # destination currency - $li->estimated_unit_price # source amount - ] - })->[0]->{value}; - } - - my $debit = create_fund_debit( - $mgr, - $dry_run, - fund => $lid->fund->id, - origin_amount => $li->estimated_unit_price, - origin_currency_type => $li->provider->currency_type, - amount => $amount - ) or return 0; - - $lid->fund_debit($debit->id); - $lid->fund($lid->fund->id); - $mgr->editor->update_acq_lineitem_detail($lid) or return 0; - return $debit; -} - - -__PACKAGE__->register_method( - "method" => "fund_exceeds_balance_percent_api", - "api_name" => "open-ils.acq.fund.check_balance_percentages", - "signature" => { - "desc" => q/Determine whether a given fund exceeds its defined - "balance stop and warning percentages"/, - "params" => [ - {"desc" => "Authentication token", "type" => "string"}, - {"desc" => "Fund ID", "type" => "number"}, - {"desc" => "Theoretical debit amount (optional)", - "type" => "number"} - ], - "return" => {"desc" => q/An array of two values, for stop and warning, - in that order: 1 if fund exceeds that balance percentage, else 0/} - } -); - -sub fund_exceeds_balance_percent_api { - my ($self, $conn, $auth, $fund_id, $debit_amount) = @_; - - $debit_amount ||= 0; - - my $e = new_editor("authtoken" => $auth); - return $e->die_event unless $e->checkauth; - - my $fund = $e->retrieve_acq_fund($fund_id) or return $e->die_event; - return $e->die_event unless $e->allowed("VIEW_FUND", $fund->org); - - my $result = [ - fund_exceeds_balance_percent($fund, $debit_amount, $e, "stop"), - fund_exceeds_balance_percent($fund, $debit_amount, $e, "warning") - ]; - - $e->disconnect; - return $result; -} - -sub fund_exceeds_balance_percent { - my ($fund, $debit_amount, $e, $which) = @_; - - my ($method_name, $event_name) = @{{ - "warning" => [ - "balance_warning_percent", "ACQ_FUND_EXCEEDS_WARN_PERCENT" - ], - "stop" => [ - "balance_stop_percent", "ACQ_FUND_EXCEEDS_STOP_PERCENT" - ] - }->{$which}}; - - if ($fund->$method_name) { - my $balance = - $e->search_acq_fund_combined_balance({"fund" => $fund->id})->[0]; - my $allocations = - $e->search_acq_fund_allocation_total({"fund" => $fund->id})->[0]; - - $balance = ($balance) ? $balance->amount : 0; - $allocations = ($allocations) ? $allocations->amount : 0; - - if ( - $allocations == 0 || # if no allocations were ever made, assume we have hit the stop percent - ((($allocations - $balance + $debit_amount) / $allocations) * 100) > $fund->$method_name - ) { - $logger->info("fund would hit a limit: " . $fund->id . ", $balance, $debit_amount, $allocations, $method_name"); - $e->event( - new OpenILS::Event( - $event_name, - "payload" => { - "fund" => $fund, "debit_amount" => $debit_amount - } - ) - ); - return 1; - } - } - return 0; -} - -# ---------------------------------------------------------------------------- -# Fund Debit -# ---------------------------------------------------------------------------- -sub create_fund_debit { - my($mgr, $dry_run, %args) = @_; - - # Verify the fund is not being spent beyond the hard stop amount - my $fund = $mgr->editor->retrieve_acq_fund($args{fund}) or return 0; - - return 0 if - fund_exceeds_balance_percent( - $fund, $args{"amount"}, $mgr->editor, "stop" - ); - return 0 if - $dry_run and fund_exceeds_balance_percent( - $fund, $args{"amount"}, $mgr->editor, "warning" - ); - - my $debit = Fieldmapper::acq::fund_debit->new; - $debit->debit_type('purchase'); - $debit->encumbrance('t'); - $debit->$_($args{$_}) for keys %args; - $debit->clear_id; - $mgr->add_debit($debit->amount); - return $mgr->editor->create_acq_fund_debit($debit); -} - - -# ---------------------------------------------------------------------------- -# Picklist -# ---------------------------------------------------------------------------- -sub create_picklist { - my($mgr, %args) = @_; - my $picklist = Fieldmapper::acq::picklist->new; - $picklist->creator($mgr->editor->requestor->id); - $picklist->owner($picklist->creator); - $picklist->editor($picklist->creator); - $picklist->create_time('now'); - $picklist->edit_time('now'); - $picklist->org_unit($mgr->editor->requestor->ws_ou); - $picklist->owner($mgr->editor->requestor->id); - $picklist->$_($args{$_}) for keys %args; - $picklist->clear_id; - $mgr->picklist($picklist); - return $mgr->editor->create_acq_picklist($picklist); -} - -sub update_picklist { - my($mgr, $picklist) = @_; - $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist; - $picklist->edit_time('now'); - $picklist->editor($mgr->editor->requestor->id); - if ($mgr->editor->update_acq_picklist($picklist)) { - $picklist = $mgr->editor->retrieve_acq_picklist($mgr->editor->data); - $mgr->picklist($picklist); - return $picklist; - } else { - return undef; - } -} - -sub delete_picklist { - my($mgr, $picklist) = @_; - $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist; - - # delete all 'new' lineitems - my $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => 'new'}, {idlist => 1}); - for my $li_id (@$li_ids) { - my $li = $mgr->editor->retrieve_acq_lineitem($li_id); - return 0 unless delete_lineitem($mgr, $li); - $mgr->respond; - } - - # detach all non-'new' lineitems - $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}}, {idlist => 1}); - for my $li_id (@$li_ids) { - my $li = $mgr->editor->retrieve_acq_lineitem($li_id); - $li->clear_picklist; - return 0 unless update_lineitem($mgr, $li); - $mgr->respond; - } - - # remove any picklist-specific object perms - my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id}); - for my $op (@$ops) { - return 0 unless $mgr->editor->delete_usr_object_perm_map($op); - } - - return $mgr->editor->delete_acq_picklist($picklist); -} - -# ---------------------------------------------------------------------------- -# Purchase Order -# ---------------------------------------------------------------------------- -sub update_purchase_order { - my($mgr, $po) = @_; - $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po; - $po->editor($mgr->editor->requestor->id); - $po->edit_time('now'); - $mgr->purchase_order($po); - return $mgr->editor->retrieve_acq_purchase_order($mgr->editor->data) - if $mgr->editor->update_acq_purchase_order($po); - return undef; -} - -sub create_purchase_order { - my($mgr, %args) = @_; - - # verify the chosen provider is still active - my $provider = $mgr->editor->retrieve_acq_provider($args{provider}) or return 0; - unless($U->is_true($provider->active)) { - $logger->error("provider is not active. cannot create PO"); - $mgr->editor->event(OpenILS::Event->new('ACQ_PROVIDER_INACTIVE')); - return 0; - } - - my $po = Fieldmapper::acq::purchase_order->new; - $po->creator($mgr->editor->requestor->id); - $po->editor($mgr->editor->requestor->id); - $po->owner($mgr->editor->requestor->id); - $po->edit_time('now'); - $po->create_time('now'); - $po->state('pending'); - $po->ordering_agency($mgr->editor->requestor->ws_ou); - $po->$_($args{$_}) for keys %args; - $po->clear_id; - $mgr->purchase_order($po); - return $mgr->editor->create_acq_purchase_order($po); -} - -# ---------------------------------------------------------------------------- -# if all of the lineitems for this PO are received, -# mark the PO as received -# ---------------------------------------------------------------------------- -sub check_purchase_order_received { - my($mgr, $po_id) = @_; - - my $non_recv_li = $mgr->editor->search_acq_lineitem( - { purchase_order => $po_id, - state => {'!=' => 'received'} - }, {idlist=>1}); - - my $po = $mgr->editor->retrieve_acq_purchase_order($po_id); - return $po if @$non_recv_li; - - $po->state('received'); - return update_purchase_order($mgr, $po); -} - - -# ---------------------------------------------------------------------------- -# Bib, Callnumber, and Copy data -# ---------------------------------------------------------------------------- - -sub create_lineitem_assets { - my($mgr, $li_id) = @_; - my $evt; - - my $li = $mgr->editor->retrieve_acq_lineitem([ - $li_id, - { flesh => 1, - flesh_fields => {jub => ['purchase_order', 'attributes']} - } - ]) or return 0; - - # ----------------------------------------------------------------- - # first, create the bib record if necessary - # ----------------------------------------------------------------- - my $new_bib = 0; - unless($li->eg_bib_id) { - create_bib($mgr, $li) or return 0; - $new_bib = 1; - } - - - # ----------------------------------------------------------------- - # The lineitem is going live, promote user request holds to real holds - # ----------------------------------------------------------------- - promote_lineitem_holds($mgr, $li) or return 0; - - my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1}); - - # ----------------------------------------------------------------- - # for each lineitem_detail, create the volume if necessary, create - # a copy, and link them all together. - # ----------------------------------------------------------------- - my $first_cn; - for my $lid_id (@{$li_details}) { - - my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0; - next if $lid->eg_copy_id; - - # use the same callnumber label for all items within this lineitem - $lid->cn_label($first_cn) if $first_cn and not $lid->cn_label; - - # apply defaults if necessary - return 0 unless complete_lineitem_detail($mgr, $lid); - - $first_cn = $lid->cn_label unless $first_cn; - - my $org = $lid->owning_lib; - my $label = $lid->cn_label; - my $bibid = $li->eg_bib_id; - - my $volume = $mgr->cache($org, "cn.$bibid.$label"); - unless($volume) { - $volume = create_volume($mgr, $li, $lid) or return 0; - $mgr->cache($org, "cn.$bibid.$label", $volume); - } - create_copy($mgr, $volume, $lid, $li) or return 0; - } - - return { li => $li, new_bib => $new_bib }; -} - -sub create_bib { - my($mgr, $li) = @_; - - my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import( - $mgr->editor, - $li->marc, - undef, # bib source - undef, - 1, # override tcn collisions - ); - - if($U->event_code($record)) { - $mgr->editor->event($record); - $mgr->editor->rollback; - return 0; - } - - $li->eg_bib_id($record->id); - $mgr->add_bib; - return update_lineitem($mgr, $li); -} - -sub create_volume { - my($mgr, $li, $lid) = @_; - - my ($volume, $evt) = - OpenILS::Application::Cat::AssetCommon->find_or_create_volume( - $mgr->editor, - $lid->cn_label, - $li->eg_bib_id, - $lid->owning_lib - ); - - if($evt) { - $mgr->editor->event($evt); - return 0; - } - - return $volume; -} - -sub create_copy { - my($mgr, $volume, $lid, $li) = @_; - my $copy = Fieldmapper::asset::copy->new; - $copy->isnew(1); - $copy->loan_duration(2); - $copy->fine_level(2); - $copy->status(($lid->recv_time) ? OILS_COPY_STATUS_IN_PROCESS : OILS_COPY_STATUS_ON_ORDER); - $copy->barcode($lid->barcode); - $copy->location($lid->location); - $copy->call_number($volume->id); - $copy->circ_lib($volume->owning_lib); - $copy->circ_modifier($lid->circ_modifier); - - # AKA list price. We might need a $li->list_price field since - # estimated price is not necessarily the same as list price - $copy->price($li->estimated_unit_price); - - my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy); - if($evt) { - $mgr->editor->event($evt); - return 0; - } - - $mgr->add_copy; - $lid->eg_copy_id($copy->id); - $mgr->editor->update_acq_lineitem_detail($lid) or return 0; -} - - - - - - -# ---------------------------------------------------------------------------- -# Workflow: Build a selection list from a Z39.50 search -# ---------------------------------------------------------------------------- - -__PACKAGE__->register_method( - method => 'zsearch', - api_name => 'open-ils.acq.picklist.search.z3950', - stream => 1, - signature => { - desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Search definition', type => 'object'}, - {desc => 'Picklist name, optional', type => 'string'}, - ] - } -); - -sub zsearch { - my($self, $conn, $auth, $search, $name, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('CREATE_PICKLIST'); - - $search->{limit} ||= 10; - $options ||= {}; - - my $ses = OpenSRF::AppSession->create('open-ils.search'); - my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search); - - my $first = 1; - my $picklist; - my $mgr; - while(my $resp = $req->recv(timeout=>60)) { - - if($first) { - my $e = new_editor(requestor=>$e->requestor, xact=>1); - $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - $picklist = zsearch_build_pl($mgr, $name); - $first = 0; - } - - my $result = $resp->content; - my $count = $result->{count} || 0; - $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 ); - - for my $rec (@{$result->{records}}) { - - my $li = create_lineitem($mgr, - picklist => $picklist->id, - source_label => $result->{service}, - marc => $rec->{marcxml}, - eg_bib_id => $rec->{bibid} - ); - - if($$options{respond_li}) { - $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id})) - if $$options{flesh_attrs}; - $li->clear_marc if $$options{clear_marc}; - $mgr->respond(lineitem => $li); - } else { - $mgr->respond; - } - } - } - - $mgr->editor->commit; - return $mgr->respond_complete; -} - -sub zsearch_build_pl { - my($mgr, $name) = @_; - $name ||= ''; - - my $picklist = $mgr->editor->search_acq_picklist({ - owner => $mgr->editor->requestor->id, - name => $name - })->[0]; - - if($name eq '' and $picklist) { - return 0 unless delete_picklist($mgr, $picklist); - $picklist = undef; - } - - return update_picklist($mgr, $picklist) if $picklist; - return create_picklist($mgr, name => $name); -} - - -# ---------------------------------------------------------------------------- -# Workflow: Build a selection list / PO by importing a batch of MARC records -# ---------------------------------------------------------------------------- - -__PACKAGE__->register_method( - method => 'upload_records', - api_name => 'open-ils.acq.process_upload_records', - stream => 1, -); - -sub upload_records { - my($self, $conn, $auth, $key) = @_; - - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - - my $cache = OpenSRF::Utils::Cache->new; - - my $data = $cache->get_cache("vandelay_import_spool_$key"); - my $purpose = $data->{purpose}; - my $filename = $data->{path}; - my $provider = $data->{provider}; - my $picklist = $data->{picklist}; - my $create_po = $data->{create_po}; - my $activate_po = $data->{activate_po}; - my $ordering_agency = $data->{ordering_agency}; - my $create_assets = $data->{create_assets}; - my $po; - my $evt; - - unless(-r $filename) { - $logger->error("unable to read MARC file $filename"); - $e->rollback; - return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename}); - } - - $provider = $e->retrieve_acq_provider($provider) or return $e->die_event; - - if($picklist) { - $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event; - if($picklist->owner != $e->requestor->id) { - return $e->die_event unless - $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist); - } - $mgr->picklist($picklist); - } - - if($create_po) { - - $po = create_purchase_order($mgr, - ordering_agency => $ordering_agency, - provider => $provider->id, - state => 'on-order' - ) or return $mgr->editor->die_event; - } - - $logger->info("acq processing MARC file=$filename"); - - my $batch = new MARC::Batch ('USMARC', $filename); - $batch->strict_off; - - my $count = 0; - my @li_list; - - while(1) { - - my ($err, $xml, $r); - $count++; - - try { - $r = $batch->next; - } catch Error with { - $err = shift; - $logger->warn("Proccessing of record $count in set $key failed with error $err. Skipping this record"); - }; - - next if $err; - last unless $r; - - try { - ($xml = $r->as_xml_record()) =~ s/\n//sog; - $xml =~ s/^<\?xml.+\?\s*>//go; - $xml =~ s/>\s+entityize($xml); - $xml =~ s/[\x00-\x1f]//go; - - } catch Error with { - $err = shift; - $logger->warn("Proccessing XML of record $count in set $key failed with error $err. Skipping this record"); - }; - - next if $err or not $xml; - - my %args = ( - source_label => $provider->code, - provider => $provider->id, - marc => $xml, - ); - - $args{picklist} = $picklist->id if $picklist; - if($po) { - $args{purchase_order} = $po->id; - $args{state} = 'pending-order'; - } - - my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event; - $mgr->respond; - $li->provider($provider); # flesh it, we'll need it later - - import_lineitem_details($mgr, $ordering_agency, $li) or return $mgr->editor->die_event; - $mgr->respond; - - push(@li_list, $li->id); - $mgr->respond; - } - - my $die_event = activate_purchase_order_impl($mgr, $po->id) if $po and $activate_po; - return $die_event if $die_event; - - $e->commit; - unlink($filename); - $cache->delete_cache('vandelay_import_spool_' . $key); - - if ($create_assets) { - create_lineitem_list_assets($mgr, \@li_list) or return $e->die_event; - } - - return $mgr->respond_complete; -} - -sub import_lineitem_details { - my($mgr, $ordering_agency, $li) = @_; - - my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]}); - return 1 unless @$holdings; - my $org_path = $U->get_org_ancestors($ordering_agency); - $org_path = [ reverse (@$org_path) ]; - my $price; - - - my $idx = 1; - while(1) { - # create a lineitem detail for each copy in the data - - my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx); - last unless defined $compiled; - return 0 unless $compiled; - - # this takes the price of the last copy and uses it as the lineitem price - # need to determine if a given record would include different prices for the same item - $price = $$compiled{estimated_price}; - - last unless $$compiled{quantity}; - - for(1..$$compiled{quantity}) { - my $lid = create_lineitem_detail( - $mgr, - lineitem => $li->id, - owning_lib => $$compiled{owning_lib}, - cn_label => $$compiled{call_number}, - fund => $$compiled{fund}, - circ_modifier => $$compiled{circ_modifier}, - note => $$compiled{note}, - location => $$compiled{copy_location}, - collection_code => $$compiled{collection_code} - ) or return 0; - } - - $mgr->respond; - $idx++; - } - - $li->estimated_unit_price($price); - update_lineitem($mgr, $li) or return 0; - return 1; -} - -# return hash on success, 0 on error, undef on no more holdings -sub extract_lineitem_detail_data { - my($mgr, $org_path, $holdings, $index) = @_; - - my @data_list = grep { $_->{holding} eq $index } @$holdings; - return undef unless @data_list; - - my %compiled = map { $_->{attr} => $_->{data} } @data_list; - my $base_org = $$org_path[0]; - - my $killme = sub { - my $msg = shift; - $logger->error("Item import extraction error: $msg"); - $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled)); - $mgr->editor->rollback; - $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg)); - return 0; - }; - - # --------------------------------------------------------------------- - # Fund - if(my $code = $compiled{fund_code}) { - - my $fund = $mgr->cache($base_org, "fund.$code"); - unless($fund) { - # search up the org tree for the most appropriate fund - for my $org (@$org_path) { - $fund = $mgr->editor->search_acq_fund( - {org => $org, code => $code, year => DateTime->now->year}, {idlist => 1})->[0]; - last if $fund; - } - } - return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund; - $compiled{fund} = $fund; - $mgr->cache($base_org, "fund.$code", $fund); - } - - - # --------------------------------------------------------------------- - # Owning lib - if(my $sn = $compiled{owning_lib}) { - my $org_id = $mgr->cache($base_org, "orgsn.$sn") || - $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0]; - return $killme->("invalid owning_lib defined: $sn") unless $org_id; - $compiled{owning_lib} = $org_id; - $mgr->cache($$org_path[0], "orgsn.$sn", $org_id); - } - - - # --------------------------------------------------------------------- - # Circ Modifier - my $code = $compiled{circ_modifier}; - - if(defined $code) { - - # verify this is a valid circ modifier - return $killme->("invlalid circ_modifier $code") unless - defined $mgr->cache($base_org, "mod.$code") or - $mgr->editor->retrieve_config_circ_modifier($code); - - # if valid, cache for future tests - $mgr->cache($base_org, "mod.$code", $code); - - } else { - $compiled{circ_modifier} = get_default_circ_modifier($mgr, $base_org); - } - - - # --------------------------------------------------------------------- - # Shelving Location - if( my $name = $compiled{copy_location}) { - my $loc = $mgr->cache($base_org, "copy_loc.$name"); - unless($loc) { - for my $org (@$org_path) { - $loc = $mgr->editor->search_asset_copy_location( - {owning_lib => $org, name => $name}, {idlist => 1})->[0]; - last if $loc; - } - } - return $killme->("Invalid copy location $name") unless $loc; - $compiled{copy_location} = $loc; - $mgr->cache($base_org, "copy_loc.$name", $loc); - } - - return \%compiled; -} - - - -# ---------------------------------------------------------------------------- -# Workflow: Given an existing purchase order, import/create the bibs, -# callnumber and copy objects -# ---------------------------------------------------------------------------- - -__PACKAGE__->register_method( - method => 'create_po_assets', - api_name => 'open-ils.acq.purchase_order.assets.create', - signature => { - desc => q/Creates assets for each lineitem in the purchase order/, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'The purchase order id', type => 'number'}, - ], - return => {desc => 'Streams a total versus completed counts object, event on error'} - } -); - -sub create_po_assets { - my($self, $conn, $auth, $po_id) = @_; - - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - - my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event; - - my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1}); - - # it's ugly, but it's fast. Get the total count of lineitem detail objects to process - my $lid_total = $e->json_query({ - select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] }, - from => { - acqlid => { - jub => { - fkey => 'lineitem', - field => 'id', - join => {acqpo => {fkey => 'purchase_order', field => 'id'}} - } - } - }, - where => {'+acqpo' => {id => $po_id}} - })->[0]->{id}; - - $mgr->total(scalar(@$li_ids) + $lid_total); - - create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event; - - $e->xact_begin; - update_purchase_order($mgr, $po) or return $e->die_event; - $e->commit; - - return $mgr->respond_complete; -} - - - -__PACKAGE__->register_method( - method => 'create_purchase_order_api', - api_name => 'open-ils.acq.purchase_order.create', - signature => { - desc => 'Creates a new purchase order', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'purchase_order to create', type => 'object'} - ], - return => {desc => 'The purchase order id, Event on failure'} - } -); - -sub create_purchase_order_api { - my($self, $conn, $auth, $po, $args) = @_; - $args ||= {}; - - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency); - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - - # create the PO - my %pargs = (ordering_agency => $e->requestor->ws_ou); # default - $pargs{provider} = $po->provider if $po->provider; - $pargs{ordering_agency} = $po->ordering_agency if $po->ordering_agency; - $pargs{prepayment_required} = $po->prepayment_required if $po->prepayment_required; - - $po = create_purchase_order($mgr, %pargs) or return $e->die_event; - - my $li_ids = $$args{lineitems}; - - if($li_ids) { - - for my $li_id (@$li_ids) { - - my $li = $e->retrieve_acq_lineitem([ - $li_id, - {flesh => 1, flesh_fields => {jub => ['attributes']}} - ]) or return $e->die_event; - - $li->provider($po->provider); - $li->purchase_order($po->id); - $li->state('pending-order'); - update_lineitem($mgr, $li) or return $e->die_event; - $mgr->respond; - } - } - - # commit before starting the asset creation - $e->xact_commit; - - if($li_ids and $$args{create_assets}) { - create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event; - } - - return $mgr->respond_complete; -} - - - -__PACKAGE__->register_method( - method => 'update_lineitem_fund_batch', - api_name => 'open-ils.acq.lineitem.fund.update.batch', - stream => 1, - signature => { - desc => q/Given a set of lineitem IDS, updates the fund for all attached lineitem details/ - } -); - -sub update_lineitem_fund_batch { - my($self, $conn, $auth, $li_ids, $fund_id) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - for my $li_id (@$li_ids) { - my ($li, $evt) = fetch_and_check_li($e, $li_id, 'write'); - return $evt if $evt; - my $li_details = $e->search_acq_lineitem_detail({lineitem => $li_id}); - $_->fund($fund_id) and $_->ischanged(1) for @$li_details; - $evt = lineitem_detail_CUD_batch($mgr, $li_details); - return $evt if $evt; - $mgr->add_li; - $mgr->respond; - } - $e->commit; - return $mgr->respond_complete; -} - - - -__PACKAGE__->register_method( - method => 'lineitem_detail_CUD_batch_api', - api_name => 'open-ils.acq.lineitem_detail.cud.batch', - stream => 1, - signature => { - desc => q/Creates a new purchase order line item detail. / . - q/Additionally creates the associated fund_debit/, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'List of lineitem_details to create', type => 'array'}, - {desc => 'Create Debits. Used for creating post-po-asset-creation debits', type => 'bool'}, - ], - return => {desc => 'Streaming response of current position in the array'} - } -); - -__PACKAGE__->register_method( - method => 'lineitem_detail_CUD_batch_api', - api_name => 'open-ils.acq.lineitem_detail.cud.batch.dry_run', - stream => 1, - signature => { - desc => q/ - Dry run version of open-ils.acq.lineitem_detail.cud.batch. - In dry_run mode, updated fund_debit's the exceed the warning - percent return an event. - / - } -); - - -sub lineitem_detail_CUD_batch_api { - my($self, $conn, $auth, $li_details, $create_debits) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - my $dry_run = ($self->api_name =~ /dry_run/o); - my $evt = lineitem_detail_CUD_batch($mgr, $li_details, $create_debits, $dry_run); - return $evt if $evt; - $e->commit; - return $mgr->respond_complete; -} - - -sub lineitem_detail_CUD_batch { - my($mgr, $li_details, $create_debits, $dry_run) = @_; - - $mgr->total(scalar(@$li_details)); - my $e = $mgr->editor; - - my $li; - my %li_cache; - my $fund_cache = {}; - my $evt; - - for my $lid (@$li_details) { - - unless($li = $li_cache{$lid->lineitem}) { - ($li, $evt) = fetch_and_check_li($e, $lid->lineitem, 'write'); - return $evt if $evt; - } - - if($lid->isnew) { - $lid = create_lineitem_detail($mgr, %{$lid->to_bare_hash}) or return $e->die_event; - if($create_debits) { - $li->provider($e->retrieve_acq_provider($li->provider)) or return $e->die_event; - $lid->fund($e->retrieve_acq_fund($lid->fund)) or return $e->die_event; - create_lineitem_detail_debit($mgr, $li, $lid, 0, 1) or return $e->die_event; - } - - } elsif($lid->ischanged) { - return $evt if $evt = handle_changed_lid($e, $lid, $dry_run, $fund_cache); - - } elsif($lid->isdeleted) { - delete_lineitem_detail($mgr, $lid) or return $e->die_event; - } - - $mgr->respond(li => $li); - $li_cache{$lid->lineitem} = $li; - } - - return undef; -} - -sub handle_changed_lid { - my($e, $lid, $dry_run, $fund_cache) = @_; - - my $orig_lid = $e->retrieve_acq_lineitem_detail($lid->id) or return $e->die_event; - - # updating the fund, so update the debit - if($orig_lid->fund_debit and $orig_lid->fund != $lid->fund) { - - my $debit = $e->retrieve_acq_fund_debit($orig_lid->fund_debit); - my $new_fund = $$fund_cache{$lid->fund} = - $$fund_cache{$lid->fund} || $e->retrieve_acq_fund($lid->fund); - - # check the thresholds - return $e->die_event if - fund_exceeds_balance_percent($new_fund, $debit->amount, $e, "stop"); - return $e->die_event if $dry_run and - fund_exceeds_balance_percent($new_fund, $debit->amount, $e, "warning"); - - $debit->fund($new_fund->id); - $e->update_acq_fund_debit($debit) or return $e->die_event; - } - - $e->update_acq_lineitem_detail($lid) or return $e->die_event; - return undef; -} - - -__PACKAGE__->register_method( - method => 'receive_po_api', - api_name => 'open-ils.acq.purchase_order.receive' -); - -sub receive_po_api { - my($self, $conn, $auth, $po_id) = @_; - my $e = new_editor(xact => 1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - - my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event; - return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency); - - my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1}); - - for my $li_id (@$li_ids) { - receive_lineitem($mgr, $li_id) or return $e->die_event; - $mgr->respond; - } - - $po->state('received'); - update_purchase_order($mgr, $po) or return $e->die_event; - - $e->commit; - return $mgr->respond_complete; -} - - -# At the moment there's a lack of parallelism between the receive and unreceive -# API methods for POs and the API methods for LIs and LIDs. The methods for -# POs stream back objects as they act, whereas the methods for LIs and LIDs -# atomically return an object that describes only what changed (in LIs and LIDs -# themselves or in the objects to which to LIs and LIDs belong). -# -# The methods for LIs and LIDs work the way they do to faciliate the UI's -# maintaining correct information about the state of these things when a user -# wants to receive or unreceive these objects without refreshing their whole -# display. The UI feature for receiving and un-receiving a whole PO just -# refreshes the whole display, so this absence of parallelism in the UI is also -# relected in this module. -# -# This could be neatened in the future by making POs receive and unreceive in -# the same way the LIs and LIDs do. - -__PACKAGE__->register_method( - method => 'receive_lineitem_detail_api', - api_name => 'open-ils.acq.lineitem_detail.receive', - signature => { - desc => 'Mark a lineitem_detail as received', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'lineitem detail ID', type => 'number'} - ], - return => {desc => - "on success, object describing changes to LID and possibly " . - "to LI and PO; on error, Event" - } - } -); - -sub receive_lineitem_detail_api { - my($self, $conn, $auth, $lid_id) = @_; - - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - - my $fleshing = { - "flesh" => 2, "flesh_fields" => { - "acqlid" => ["lineitem"], "jub" => ["purchase_order"] - } - }; - - my $lid = $e->retrieve_acq_lineitem_detail([$lid_id, $fleshing]); - - return $e->die_event unless $e->allowed( - 'RECEIVE_PURCHASE_ORDER', $lid->lineitem->purchase_order->ordering_agency); - - # update ... - my $recvd = receive_lineitem_detail($mgr, $lid_id) or return $e->die_event; - - # .. and re-retrieve - $lid = $e->retrieve_acq_lineitem_detail([$lid_id, $fleshing]); - - # Now build result data structure. - my $result = {"lid" => {$lid->id => {"recv_time" => $lid->recv_time}}}; - - if (ref $recvd) { - if ($recvd->class_name =~ /::purchase_order/) { - $result->{"po"} = describe_affected_po($e, $recvd); - $result->{"li"} = { - $lid->lineitem->id => {"state" => $lid->lineitem->state} - }; - } elsif ($recvd->class_name =~ /::lineitem/) { - $result->{"li"} = {$recvd->id => {"state" => $recvd->state}}; - } - } - $result->{"po"} ||= - describe_affected_po($e, $lid->lineitem->purchase_order); - - $e->commit; - return $result; -} - -__PACKAGE__->register_method( - method => 'receive_lineitem_api', - api_name => 'open-ils.acq.lineitem.receive', - signature => { - desc => 'Mark a lineitem as received', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'lineitem ID', type => 'number'} - ], - return => {desc => - "on success, object describing changes to LI and possibly PO; " . - "on error, Event" - } - } -); - -sub receive_lineitem_api { - my($self, $conn, $auth, $li_id) = @_; - - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - - my $li = $e->retrieve_acq_lineitem([ - $li_id, { - flesh => 1, - flesh_fields => { - jub => ['purchase_order'] - } - } - ]) or return $e->die_event; - - return $e->die_event unless $e->allowed( - 'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency); - - my $res = receive_lineitem($mgr, $li_id) or return $e->die_event; - $e->commit; - $conn->respond_complete($res); - $mgr->run_post_response_hooks; -} - - -__PACKAGE__->register_method( - method => 'rollback_receive_po_api', - api_name => 'open-ils.acq.purchase_order.receive.rollback' -); - -sub rollback_receive_po_api { - my($self, $conn, $auth, $po_id) = @_; - my $e = new_editor(xact => 1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - - my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event; - return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency); - - my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1}); - - for my $li_id (@$li_ids) { - rollback_receive_lineitem($mgr, $li_id) or return $e->die_event; - $mgr->respond; - } - - $po->state('on-order'); - update_purchase_order($mgr, $po) or return $e->die_event; - - $e->commit; - return $mgr->respond_complete; -} - - -__PACKAGE__->register_method( - method => 'rollback_receive_lineitem_detail_api', - api_name => 'open-ils.acq.lineitem_detail.receive.rollback', - signature => { - desc => 'Mark a lineitem_detail as Un-received', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'lineitem detail ID', type => 'number'} - ], - return => {desc => - "on success, object describing changes to LID and possibly " . - "to LI and PO; on error, Event" - } - } -); - -sub rollback_receive_lineitem_detail_api { - my($self, $conn, $auth, $lid_id) = @_; - - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - - my $lid = $e->retrieve_acq_lineitem_detail([ - $lid_id, { - flesh => 2, - flesh_fields => { - acqlid => ['lineitem'], - jub => ['purchase_order'] - } - } - ]); - my $li = $lid->lineitem; - my $po = $li->purchase_order; - - return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency); - - my $result = {}; - - my $recvd = rollback_receive_lineitem_detail($mgr, $lid_id) - or return $e->die_event; - - if (ref $recvd) { - $result->{"lid"} = {$recvd->id => {"recv_time" => $recvd->recv_time}}; - } else { - $result->{"lid"} = {$lid->id => {"recv_time" => $lid->recv_time}}; - } - - if ($li->state eq "received") { - $li->state("on-order"); - $li = update_lineitem($mgr, $li) or return $e->die_event; - $result->{"li"} = {$li->id => {"state" => $li->state}}; - } - - if ($po->state eq "received") { - $po->state("on-order"); - $po = update_purchase_order($mgr, $po) or return $e->die_event; - } - $result->{"po"} = describe_affected_po($e, $po); - - $e->commit and return $result or return $e->die_event; -} - -__PACKAGE__->register_method( - method => 'rollback_receive_lineitem_api', - api_name => 'open-ils.acq.lineitem.receive.rollback', - signature => { - desc => 'Mark a lineitem as Un-received', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'lineitem ID', type => 'number'} - ], - return => {desc => - "on success, object describing changes to LI and possibly PO; " . - "on error, Event" - } - } -); - -sub rollback_receive_lineitem_api { - my($self, $conn, $auth, $li_id) = @_; - - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - - my $li = $e->retrieve_acq_lineitem([ - $li_id, { - "flesh" => 1, "flesh_fields" => {"jub" => ["purchase_order"]} - } - ]); - my $po = $li->purchase_order; - - return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency); - - $li = rollback_receive_lineitem($mgr, $li_id) or return $e->die_event; - - my $result = {"li" => {$li->id => {"state" => $li->state}}}; - if ($po->state eq "received") { - $po->state("on-order"); - $po = update_purchase_order($mgr, $po) or return $e->die_event; - } - $result->{"po"} = describe_affected_po($e, $po); - - $e->commit and return $result or return $e->die_event; -} - - -__PACKAGE__->register_method( - method => 'set_lineitem_price_api', - api_name => 'open-ils.acq.lineitem.price.set', - signature => { - desc => 'Set lineitem price. If debits already exist, update them as well', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'lineitem ID', type => 'number'} - ], - return => {desc => 'status blob, Event on error'} - } -); - -sub set_lineitem_price_api { - my($self, $conn, $auth, $li_id, $price) = @_; - - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - - my ($li, $evt) = fetch_and_check_li($e, $li_id, 'write'); - return $evt if $evt; - - $li->estimated_unit_price($price); - update_lineitem($mgr, $li) or return $e->die_event; - - my $lid_ids = $e->search_acq_lineitem_detail( - {lineitem => $li_id, fund_debit => {'!=' => undef}}, - {idlist => 1} - ); - - for my $lid_id (@$lid_ids) { - - my $lid = $e->retrieve_acq_lineitem_detail([ - $lid_id, { - flesh => 1, flesh_fields => {acqlid => ['fund', 'fund_debit']}} - ]); - - $lid->fund_debit->amount($price); - $e->update_acq_fund_debit($lid->fund_debit) or return $e->die_event; - $mgr->add_lid; - $mgr->respond; - } - - $e->commit; - return $mgr->respond_complete; -} - - -__PACKAGE__->register_method( - method => 'clone_picklist_api', - api_name => 'open-ils.acq.picklist.clone', - signature => { - desc => 'Clones a picklist, including lineitem and lineitem details', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Picklist ID', type => 'number'}, - {desc => 'New Picklist Name', type => 'string'} - ], - return => {desc => 'status blob, Event on error'} - } -); - -sub clone_picklist_api { - my($self, $conn, $auth, $pl_id, $name) = @_; - - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - - my $old_pl = $e->retrieve_acq_picklist($pl_id); - my $new_pl = create_picklist($mgr, %{$old_pl->to_bare_hash}, name => $name) or return $e->die_event; - - my $li_ids = $e->search_acq_lineitem({picklist => $pl_id}, {idlist => 1}); - - for my $li_id (@$li_ids) { - - # copy the lineitems - my $li = $e->retrieve_acq_lineitem($li_id); - my $new_li = create_lineitem($mgr, %{$li->to_bare_hash}, picklist => $new_pl->id) or return $e->die_event; - - my $lid_ids = $e->search_acq_lineitem_detail({lineitem => $li_id}, {idlist => 1}); - for my $lid_id (@$lid_ids) { - - # copy the lineitem details - my $lid = $e->retrieve_acq_lineitem_detail($lid_id); - create_lineitem_detail($mgr, %{$lid->to_bare_hash}, lineitem => $new_li->id) or return $e->die_event; - } - - $mgr->respond; - } - - $e->commit; - return $mgr->respond_complete; -} - - -__PACKAGE__->register_method( - method => 'merge_picklist_api', - api_name => 'open-ils.acq.picklist.merge', - signature => { - desc => 'Merges 2 or more picklists into a single list', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Lead Picklist ID', type => 'number'}, - {desc => 'List of subordinate picklist IDs', type => 'array'} - ], - return => {desc => 'status blob, Event on error'} - } -); - -sub merge_picklist_api { - my($self, $conn, $auth, $lead_pl, $pl_list) = @_; - - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - - # XXX perms on each picklist modified - - $lead_pl = $e->retrieve_acq_picklist($lead_pl) or return $e->die_event; - # point all of the lineitems at the lead picklist - my $li_ids = $e->search_acq_lineitem({picklist => $pl_list}, {idlist => 1}); - - for my $li_id (@$li_ids) { - my $li = $e->retrieve_acq_lineitem($li_id); - $li->picklist($lead_pl); - update_lineitem($mgr, $li) or return $e->die_event; - $mgr->respond; - } - - # now delete the subordinate lists - for my $pl_id (@$pl_list) { - my $pl = $e->retrieve_acq_picklist($pl_id); - $e->delete_acq_picklist($pl) or return $e->die_event; - } - - update_picklist($mgr, $lead_pl) or return $e->die_event; - - $e->commit; - return $mgr->respond_complete; -} - - -__PACKAGE__->register_method( - method => 'delete_picklist_api', - api_name => 'open-ils.acq.picklist.delete', - signature => { - desc => q/Deletes a picklist. It also deletes any lineitems in the "new" state. / . - q/Other attached lineitems are detached/, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Picklist ID to delete', type => 'number'} - ], - return => {desc => '1 on success, Event on error'} - } -); - -sub delete_picklist_api { - my($self, $conn, $auth, $picklist_id) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - my $pl = $e->retrieve_acq_picklist($picklist_id) or return $e->die_event; - delete_picklist($mgr, $pl) or return $e->die_event; - $e->commit; - return $mgr->respond_complete; -} - - - -__PACKAGE__->register_method( - method => 'activate_purchase_order', - api_name => 'open-ils.acq.purchase_order.activate.dry_run' -); - -__PACKAGE__->register_method( - method => 'activate_purchase_order', - api_name => 'open-ils.acq.purchase_order.activate', - signature => { - desc => q/Activates a purchase order. This updates the status of the PO / . - q/and Lineitems to 'on-order'. Activated PO's are ready for EDI delivery if appropriate./, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Purchase ID', type => 'number'} - ], - return => {desc => '1 on success, Event on error'} - } -); - -sub activate_purchase_order { - my($self, $conn, $auth, $po_id) = @_; - - my $dry_run = ($self->api_name =~ /\.dry_run/) ? 1 : 0; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); - my $die_event = activate_purchase_order_impl($mgr, $po_id, $dry_run); - return $e->die_event if $die_event; - if ($dry_run) { - $e->rollback; - } else { - $e->commit; - } - $conn->respond_complete(1); - $mgr->run_post_response_hooks; - return undef; -} - -sub activate_purchase_order_impl { - my ($mgr, $po_id, $dry_run) = @_; - my $e = $mgr->editor; - - my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event; - return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency); - - my $provider = $e->retrieve_acq_provider($po->provider); - - $po->state('on-order'); - $po->order_date('now'); - update_purchase_order($mgr, $po) or return $e->die_event; - - my $query = [ - { - purchase_order => $po_id, - state => [qw/pending-order new order-ready/] - }, - {limit => 1} - ]; - - while( my $li_id = $e->search_acq_lineitem($query, {idlist => 1})->[0] ) { - - my $li; - if($dry_run) { - $li = $e->retrieve_acq_lineitem($li_id); - } else { - # can't activate a PO w/o assets. Create lineitem assets as necessary - my $data = create_lineitem_assets($mgr, $li_id) or return $e->die_event; - $li = $data->{li}; - } - - $li->state('on-order'); - $li->claim_policy($provider->default_claim_policy) - if $provider->default_claim_policy and !$li->claim_policy; - create_lineitem_debits($mgr, $li, $dry_run) or return $e->die_event; - update_lineitem($mgr, $li) or return $e->die_event; - $mgr->post_process( sub { create_lineitem_status_events($mgr, $li->id, 'aur.ordered'); }); - $mgr->respond; - } - - for my $po_item (@{$e->search_acq_po_item({purchase_order => $po_id})}) { - - my $debit = create_fund_debit( - $mgr, - $dry_run, - debit_type => 'direct_charge', # to match invoicing - origin_amount => $po_item->estimated_cost, - origin_currency_type => $e->retrieve_acq_fund($po_item->fund)->currency_type, - amount => $po_item->estimated_cost, - fund => $po_item->fund - ) or return $e->die_event; - $po_item->fund_debit($debit->id); - $e->update_acq_po_item($po_item) or return $e->die_event; - $mgr->respond; - } - - # tell the world we activated a PO - $U->create_events_for_hook('acqpo.activated', $po, $po->ordering_agency) unless $dry_run; - - return undef; -} - - -__PACKAGE__->register_method( - method => 'split_purchase_order_by_lineitems', - api_name => 'open-ils.acq.purchase_order.split_by_lineitems', - signature => { - desc => q/Splits a PO into many POs, 1 per lineitem. Only works for / . - q/POs a) with more than one lineitems, and b) in the "pending" state./, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Purchase order ID', type => 'number'} - ], - return => {desc => 'list of new PO IDs on success, Event on error'} - } -); - -sub split_purchase_order_by_lineitems { - my ($self, $conn, $auth, $po_id) = @_; - - my $e = new_editor("xact" => 1, "authtoken" => $auth); - return $e->die_event unless $e->checkauth; - - my $po = $e->retrieve_acq_purchase_order([ - $po_id, { - "flesh" => 1, - "flesh_fields" => {"acqpo" => [qw/lineitems notes/]} - } - ]) or return $e->die_event; - - return $e->die_event - unless $e->allowed("CREATE_PURCHASE_ORDER", $po->ordering_agency); - - unless ($po->state eq "pending") { - $e->rollback; - return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_LATE"); - } - - unless (@{$po->lineitems} > 1) { - $e->rollback; - return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_SHORT"); - } - - # To split an existing PO into many, it seems unwise to just delete the - # original PO, so we'll instead detach all of the original POs' lineitems - # but the first, then create new POs for each of the remaining LIs, and - # then attach the LIs to their new POs. - - my @po_ids = ($po->id); - my @moving_li = @{$po->lineitems}; - shift @moving_li; # discard first LI - - foreach my $li (@moving_li) { - my $new_po = $po->clone; - $new_po->clear_id; - $new_po->clear_name; - $new_po->creator($e->requestor->id); - $new_po->editor($e->requestor->id); - $new_po->owner($e->requestor->id); - $new_po->edit_time("now"); - $new_po->create_time("now"); - - $new_po = $e->create_acq_purchase_order($new_po); - - # Clone any notes attached to the old PO and attach to the new one. - foreach my $note (@{$po->notes}) { - my $new_note = $note->clone; - $new_note->clear_id; - $new_note->edit_time("now"); - $new_note->purchase_order($new_po->id); - $e->create_acq_po_note($new_note); - } - - $li->edit_time("now"); - $li->purchase_order($new_po->id); - $e->update_acq_lineitem($li); - - push @po_ids, $new_po->id; - } - - $po->edit_time("now"); - $e->update_acq_purchase_order($po); - - return \@po_ids if $e->commit; - return $e->die_event; -} - - -sub not_cancelable { - my $o = shift; - (ref $o eq "HASH" and $o->{"textcode"} eq "ACQ_NOT_CANCELABLE"); -} - -__PACKAGE__->register_method( - method => "cancel_purchase_order_api", - api_name => "open-ils.acq.purchase_order.cancel", - signature => { - desc => q/Cancels an on-order purchase order/, - params => [ - {desc => "Authentication token", type => "string"}, - {desc => "PO ID to cancel", type => "number"}, - {desc => "Cancel reason ID", type => "number"} - ], - return => {desc => q/Object describing changed POs, LIs and LIDs - on success; Event on error./} - } -); - -sub cancel_purchase_order_api { - my ($self, $conn, $auth, $po_id, $cancel_reason) = @_; - - my $e = new_editor("xact" => 1, "authtoken" => $auth); - return $e->die_event unless $e->checkauth; - my $mgr = new OpenILS::Application::Acq::BatchManager( - "editor" => $e, "conn" => $conn - ); - - $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or - return new OpenILS::Event( - "BAD_PARAMS", "note" => "Provide cancel reason ID" - ); - - my $result = cancel_purchase_order($mgr, $po_id, $cancel_reason) or - return $e->die_event; - if (not_cancelable($result)) { # event not from CStoreEditor - $e->rollback; - return $result; - } elsif ($result == -1) { - $e->rollback; - return new OpenILS::Event("ACQ_ALREADY_CANCELED"); - } - - $e->commit or return $e->die_event; - - # XXX create purchase order status events? - - if ($mgr->{post_commit}) { - foreach my $func (@{$mgr->{post_commit}}) { - $func->(); - } - } - - return $result; -} - -sub cancel_purchase_order { - my ($mgr, $po_id, $cancel_reason) = @_; - - my $po = $mgr->editor->retrieve_acq_purchase_order($po_id) or return 0; - - # XXX is "cancelled" a typo? It's not correct US spelling, anyway. - # Depending on context, this may not warrant an event. - return -1 if $po->state eq "cancelled"; - - # But this always does. - return new OpenILS::Event( - "ACQ_NOT_CANCELABLE", "note" => "purchase_order $po_id" - ) unless ($po->state eq "on-order" or $po->state eq "pending"); - - return 0 unless - $mgr->editor->allowed("CREATE_PURCHASE_ORDER", $po->ordering_agency); - - $po->state("cancelled"); - $po->cancel_reason($cancel_reason->id); - - my $li_ids = $mgr->editor->search_acq_lineitem( - {"purchase_order" => $po_id}, {"idlist" => 1} - ); - - my $result = {"li" => {}, "lid" => {}}; - foreach my $li_id (@$li_ids) { - my $li_result = cancel_lineitem($mgr, $li_id, $cancel_reason) - or return 0; - - next if $li_result == -1; # already canceled:skip. - return $li_result if not_cancelable($li_result); # not cancelable:stop. - - # Merge in each LI result (there's only going to be - # one per call to cancel_lineitem). - my ($k, $v) = each %{$li_result->{"li"}}; - $result->{"li"}->{$k} = $v; - - # Merge in each LID result (there may be many per call to - # cancel_lineitem). - while (($k, $v) = each %{$li_result->{"lid"}}) { - $result->{"lid"}->{$k} = $v; - } - } - - # TODO who/what/where/how do we indicate this change for electronic orders? - # TODO return changes to encumbered/spent - # TODO maybe cascade up from smaller object to container object if last - # smaller object in the container has been canceled? - - update_purchase_order($mgr, $po) or return 0; - $result->{"po"} = { - $po_id => {"state" => $po->state, "cancel_reason" => $cancel_reason} - }; - return $result; -} - - -__PACKAGE__->register_method( - method => "cancel_lineitem_api", - api_name => "open-ils.acq.lineitem.cancel", - signature => { - desc => q/Cancels an on-order lineitem/, - params => [ - {desc => "Authentication token", type => "string"}, - {desc => "Lineitem ID to cancel", type => "number"}, - {desc => "Cancel reason ID", type => "number"} - ], - return => {desc => q/Object describing changed LIs and LIDs on success; - Event on error./} - } -); - -__PACKAGE__->register_method( - method => "cancel_lineitem_api", - api_name => "open-ils.acq.lineitem.cancel.batch", - signature => { - desc => q/Batched version of open-ils.acq.lineitem.cancel/, - return => {desc => q/Object describing changed LIs and LIDs on success; - Event on error./} - } -); - -sub cancel_lineitem_api { - my ($self, $conn, $auth, $li_id, $cancel_reason) = @_; - - my $batched = $self->api_name =~ /\.batch/; - - my $e = new_editor("xact" => 1, "authtoken" => $auth); - return $e->die_event unless $e->checkauth; - my $mgr = new OpenILS::Application::Acq::BatchManager( - "editor" => $e, "conn" => $conn - ); - - $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or - return new OpenILS::Event( - "BAD_PARAMS", "note" => "Provide cancel reason ID" - ); - - my ($result, $maybe_event); - - if ($batched) { - $result = {"li" => {}, "lid" => {}}; - foreach my $one_li_id (@$li_id) { - my $one = cancel_lineitem($mgr, $one_li_id, $cancel_reason) or - return $e->die_event; - if (not_cancelable($one)) { - $maybe_event = $one; - } elsif ($result == -1) { - $maybe_event = new OpenILS::Event("ACQ_ALREADY_CANCELED"); - } else { - my ($k, $v); - if ($one->{"li"}) { - while (($k, $v) = each %{$one->{"li"}}) { - $result->{"li"}->{$k} = $v; - } - } - if ($one->{"lid"}) { - while (($k, $v) = each %{$one->{"lid"}}) { - $result->{"lid"}->{$k} = $v; - } - } - } - } - } else { - $result = cancel_lineitem($mgr, $li_id, $cancel_reason) or - return $e->die_event; - - if (not_cancelable($result)) { - $e->rollback; - return $result; - } elsif ($result == -1) { - $e->rollback; - return new OpenILS::Event("ACQ_ALREADY_CANCELED"); - } - } - - if ($batched and not scalar keys %{$result->{"li"}}) { - $e->rollback; - return $maybe_event; - } else { - $e->commit or return $e->die_event; - # create_lineitem_status_events should handle array li_id ok - create_lineitem_status_events($mgr, $li_id, "aur.cancelled"); - - if ($mgr->{post_commit}) { - foreach my $func (@{$mgr->{post_commit}}) { - $func->(); - } - } - - return $result; - } -} - -sub cancel_lineitem { - my ($mgr, $li_id, $cancel_reason) = @_; - my $li = $mgr->editor->retrieve_acq_lineitem([ - $li_id, {flesh => 1, flesh_fields => {jub => ['purchase_order']}} - ]) or return 0; - - return 0 unless $mgr->editor->allowed( - "CREATE_PURCHASE_ORDER", $li->purchase_order->ordering_agency - ); - - # Depending on context, this may not warrant an event. - return -1 if $li->state eq "cancelled"; - - # But this always does. - return new OpenILS::Event( - "ACQ_NOT_CANCELABLE", "note" => "lineitem $li_id" - ) unless ( - (! $li->purchase_order) or ( - $li->purchase_order and ( - $li->state eq "on-order" or $li->state eq "pending-order" - ) - ) - ); - - $li->state("cancelled"); - $li->cancel_reason($cancel_reason->id); - - my $lids = $mgr->editor->search_acq_lineitem_detail([{ - "lineitem" => $li_id - }, { - flesh => 1, - flesh_fields => { acqlid => ['eg_copy_id'] } - }]); - - my $result = {"lid" => {}}; - my $copies = []; - foreach my $lid (@$lids) { - my $lid_result = cancel_lineitem_detail($mgr, $lid->id, $cancel_reason) - or return 0; - - # gathering any real copies for deletion - if ($lid->eg_copy_id) { - $lid->eg_copy_id->isdeleted('t'); - push @$copies, $lid->eg_copy_id; - } - - next if $lid_result == -1; # already canceled: just skip it. - return $lid_result if not_cancelable($lid_result); # not cxlable: stop. - - # Merge in each LID result (there's only going to be one per call to - # cancel_lineitem_detail). - my ($k, $v) = each %{$lid_result->{"lid"}}; - $result->{"lid"}->{$k} = $v; - } - - # Attempt to delete the gathered copies (this will also handle volume deletion and bib deletion) - # Delete empty bibs according org unit setting - my $force_delete_empty_bib = $U->ou_ancestor_setting_value( - $mgr->editor->requestor->ws_ou, 'cat.bib.delete_on_no_copy_via_acq_lineitem_cancel', $mgr->editor); - if (scalar(@$copies)>0) { - my $override = 1; - my $delete_stats = undef; - my $retarget_holds = []; - my $cat_evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies( - $mgr->editor, $override, undef, $copies, $delete_stats, $retarget_holds,$force_delete_empty_bib); - - if( $cat_evt ) { - $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($cat_evt)); - return new OpenILS::Event( - "ACQ_NOT_CANCELABLE", "note" => "lineitem $li_id", "payload" => $cat_evt - ); - } - - # We can't do the following and stay within the same transaction, but that's okay, the hold targeter will pick these up later. - #my $ses = OpenSRF::AppSession->create('open-ils.circ'); - #$ses->request('open-ils.circ.hold.reset.batch', $auth, $retarget_holds); - } - - # if we have a bib, check to see whether it has been deleted. if so, cancel any active holds targeting that bib - if ($li->eg_bib_id) { - my $bib = $mgr->editor->retrieve_biblio_record_entry($li->eg_bib_id) or return new OpenILS::Event( - "ACQ_NOT_CANCELABLE", "note" => "Could not retrieve bib " . $li->eg_bib_id . " for lineitem $li_id" - ); - if ($U->is_true($bib->deleted)) { - my $holds = $mgr->editor->search_action_hold_request( - { cancel_time => undef, - fulfillment_time => undef, - target => $li->eg_bib_id - } - ); - - my %cached_usr_home_ou = (); - - for my $hold (@$holds) { - - $logger->info("Cancelling hold ".$hold->id. - " due to acq lineitem cancellation."); - - $hold->cancel_time('now'); - $hold->cancel_cause(5); # 'Staff forced'--we may want a new hold cancel cause reason for this - $hold->cancel_note('Corresponding Acquistion Lineitem/Purchase Order was cancelled.'); - unless($mgr->editor->update_action_hold_request($hold)) { - my $evt = $mgr->editor->event; - $logger->error("Error updating hold ". $evt->textcode .":". $evt->desc .":". $evt->stacktrace); - return new OpenILS::Event( - "ACQ_NOT_CANCELABLE", "note" => "Could not cancel hold " . $hold->id . " for lineitem $li_id", "payload" => $evt - ); - } - if (! defined $mgr->{post_commit}) { # we need a mechanism for creating trigger events, but only if the transaction gets committed - $mgr->{post_commit} = []; - } - push @{ $mgr->{post_commit} }, sub { - my $home_ou = $cached_usr_home_ou{$hold->usr}; - if (! $home_ou) { - my $user = $mgr->editor->retrieve_actor_user($hold->usr); # FIXME: how do we want to handle failures here? - $home_ou = $user->home_ou; - $cached_usr_home_ou{$hold->usr} = $home_ou; - } - $U->create_events_for_hook('hold_request.cancel.cancelled_order', $hold, $home_ou); - }; - } - } - } - - update_lineitem($mgr, $li) or return 0; - $result->{"li"} = { - $li_id => { - "state" => $li->state, - "cancel_reason" => $cancel_reason - } - }; - return $result; -} - - -__PACKAGE__->register_method( - method => "cancel_lineitem_detail_api", - api_name => "open-ils.acq.lineitem_detail.cancel", - signature => { - desc => q/Cancels an on-order lineitem detail/, - params => [ - {desc => "Authentication token", type => "string"}, - {desc => "Lineitem detail ID to cancel", type => "number"}, - {desc => "Cancel reason ID", type => "number"} - ], - return => {desc => q/Object describing changed LIDs on success; - Event on error./} - } -); - -sub cancel_lineitem_detail_api { - my ($self, $conn, $auth, $lid_id, $cancel_reason) = @_; - - my $e = new_editor("xact" => 1, "authtoken" => $auth); - return $e->die_event unless $e->checkauth; - my $mgr = new OpenILS::Application::Acq::BatchManager( - "editor" => $e, "conn" => $conn - ); - - $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or - return new OpenILS::Event( - "BAD_PARAMS", "note" => "Provide cancel reason ID" - ); - - my $result = cancel_lineitem_detail($mgr, $lid_id, $cancel_reason) or - return $e->die_event; - - if (not_cancelable($result)) { - $e->rollback; - return $result; - } elsif ($result == -1) { - $e->rollback; - return new OpenILS::Event("ACQ_ALREADY_CANCELED"); - } - - $e->commit or return $e->die_event; - - # XXX create lineitem detail status events? - return $result; -} - -sub cancel_lineitem_detail { - my ($mgr, $lid_id, $cancel_reason) = @_; - my $lid = $mgr->editor->retrieve_acq_lineitem_detail([ - $lid_id, { - "flesh" => 2, - "flesh_fields" => { - "acqlid" => ["lineitem"], "jub" => ["purchase_order"] - } - } - ]) or return 0; - - # Depending on context, this may not warrant an event. - return -1 if $lid->cancel_reason; - - # But this always does. - return new OpenILS::Event( - "ACQ_NOT_CANCELABLE", "note" => "lineitem_detail $lid_id" - ) unless ( - (! $lid->lineitem->purchase_order) or - ( - (not $lid->recv_time) and - $lid->lineitem and - $lid->lineitem->purchase_order and ( - $lid->lineitem->state eq "on-order" or - $lid->lineitem->state eq "pending-order" - ) - ) - ); - - return 0 unless $mgr->editor->allowed( - "CREATE_PURCHASE_ORDER", - $lid->lineitem->purchase_order->ordering_agency - ) or (! $lid->lineitem->purchase_order); - - $lid->cancel_reason($cancel_reason->id); - - unless($U->is_true($cancel_reason->keep_debits)) { - my $debit_id = $lid->fund_debit; - $lid->clear_fund_debit; - - if($debit_id) { - # item is cancelled. Remove the fund debit. - my $debit = $mgr->editor->retrieve_acq_fund_debit($debit_id); - if (!$U->is_true($debit->encumbrance)) { - $mgr->editor->rollback; - return OpenILS::Event->new('ACQ_NOT_CANCELABLE', - note => "Debit is marked as paid: $debit_id"); - } - $mgr->editor->delete_acq_fund_debit($debit) or return $mgr->editor->die_event; - } - } - - # XXX LIDs don't have either an editor or a edit_time field. Should we - # update these on the LI when we alter an LID? - $mgr->editor->update_acq_lineitem_detail($lid) or return 0; - - return {"lid" => {$lid_id => {"cancel_reason" => $cancel_reason}}}; -} - - -__PACKAGE__->register_method( - method => 'user_requests', - api_name => 'open-ils.acq.user_request.retrieve.by_user_id', - stream => 1, - signature => { - desc => 'Retrieve fleshed user requests and related data for a given user.', - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'User ID of the owner, or array of IDs', }, - { desc => 'Options hash (optional) with any of the keys: order_by, limit, offset, state (of the lineitem)', - type => 'object' - } - ], - return => { - desc => 'Fleshed user requests and related data', - type => 'object' - } - } -); - -__PACKAGE__->register_method( - method => 'user_requests', - api_name => 'open-ils.acq.user_request.retrieve.by_home_ou', - stream => 1, - signature => { - desc => 'Retrieve fleshed user requests and related data for a given org unit or units.', - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'Org unit ID, or array of IDs', }, - { desc => 'Options hash (optional) with any of the keys: order_by, limit, offset, state (of the lineitem)', - type => 'object' - } - ], - return => { - desc => 'Fleshed user requests and related data', - type => 'object' - } - } -); - -sub user_requests { - my($self, $conn, $auth, $search_value, $options) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - my $rid = $e->requestor->id; - $options ||= {}; - - my $query = { - "select"=>{"aur"=>["id"],"au"=>["home_ou", {column => 'id', alias => 'usr_id'} ]}, - "from"=>{ "aur" => { "au" => {}, "jub" => { "type" => "left" } } }, - "where"=>{ - "+jub"=> { - "-or" => [ - {"id"=>undef}, # this with the left-join pulls in requests without lineitems - {"state"=>["new","on-order","pending-order"]} # FIXME - probably needs softcoding - ] - } - }, - "order_by"=>[{"class"=>"aur", "field"=>"request_date", "direction"=>"desc"}] - }; - - foreach (qw/ order_by limit offset /) { - $query->{$_} = $options->{$_} if defined $options->{$_}; - } - if (defined $options->{'state'}) { - $query->{'where'}->{'+jub'}->{'-or'}->[1]->{'state'} = $options->{'state'}; - } - - if ($self->api_name =~ /by_user_id/) { - $query->{'where'}->{'usr'} = $search_value; - } else { - $query->{'where'}->{'+au'} = { 'home_ou' => $search_value }; - } - - my $pertinent_ids = $e->json_query($query); - - my %perm_test = (); - for my $id_blob (@$pertinent_ids) { - if ($rid != $id_blob->{usr_id}) { - if (!defined $perm_test{ $id_blob->{home_ou} }) { - $perm_test{ $id_blob->{home_ou} } = $e->allowed( ['user_request.view'], $id_blob->{home_ou} ); - } - if (!$perm_test{ $id_blob->{home_ou} }) { - next; # failed test - } - } - my $aur_obj = $e->retrieve_acq_user_request([ - $id_blob->{id}, - {flesh => 1, flesh_fields => { "aur" => [ 'lineitem' ] } } - ]); - if (! $aur_obj) { next; } - - if ($aur_obj->lineitem()) { - $aur_obj->lineitem()->clear_marc(); - } - $conn->respond($aur_obj); - } - - return undef; -} - -__PACKAGE__->register_method ( - method => 'update_user_request', - api_name => 'open-ils.acq.user_request.cancel.batch', - stream => 1, - signature => { - desc => 'If given a cancel reason, will update the request with that reason, otherwise, this will delete the request altogether. The ' . - 'intention is for staff interfaces or processes to provide cancel reasons, and for patron interfaces to just delete the requests.' , - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'ID or array of IDs for the user requests to cancel' }, - { desc => 'Cancel Reason ID (optional)', type => 'string' } - ], - return => { - desc => 'progress object, event on error', - } - } -); -__PACKAGE__->register_method ( - method => 'update_user_request', - api_name => 'open-ils.acq.user_request.set_no_hold.batch', - stream => 1, - signature => { - desc => 'Remove the hold from a user request or set of requests', - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'ID or array of IDs for the user requests to modify' } - ], - return => { - desc => 'progress object, event on error', - } - } -); - -sub update_user_request { - my($self, $conn, $auth, $aur_ids, $cancel_reason) = @_; - my $e = new_editor(xact => 1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - my $rid = $e->requestor->id; - - my $x = 1; - my %perm_test = (); - for my $id (@$aur_ids) { - - my $aur_obj = $e->retrieve_acq_user_request([ - $id, - { flesh => 1, - flesh_fields => { "aur" => ['lineitem', 'usr'] } - } - ]) or return $e->die_event; - - my $context_org = $aur_obj->usr()->home_ou(); - $aur_obj->usr( $aur_obj->usr()->id() ); - - if ($rid != $aur_obj->usr) { - if (!defined $perm_test{ $context_org }) { - $perm_test{ $context_org } = $e->allowed( ['user_request.update'], $context_org ); - } - if (!$perm_test{ $context_org }) { - next; # failed test - } - } - - if($self->api_name =~ /set_no_hold/) { - if ($U->is_true($aur_obj->hold)) { - $aur_obj->hold(0); - $e->update_acq_user_request($aur_obj) or return $e->die_event; - } - } - - if($self->api_name =~ /cancel/) { - if ( $cancel_reason ) { - $aur_obj->cancel_reason( $cancel_reason ); - $e->update_acq_user_request($aur_obj) or return $e->die_event; - create_user_request_events( $e, [ $aur_obj ], 'aur.rejected' ); - } else { - $e->delete_acq_user_request($aur_obj); - } - } - - $conn->respond({maximum => scalar(@$aur_ids), progress => $x++}); - } - - $e->commit; - return {complete => 1}; -} - -__PACKAGE__->register_method ( - method => 'new_user_request', - api_name => 'open-ils.acq.user_request.create', - signature => { - desc => 'Create a new user request object in the DB', - param => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'User request data hash. Hash keys match the fields for the "aur" object', type => 'object' } - ], - return => { - desc => 'The created user request object, or event on error' - } - } -); - -sub new_user_request { - my($self, $conn, $auth, $form_data) = @_; - my $e = new_editor(xact => 1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - my $rid = $e->requestor->id; - my $target_user_fleshed; - if (! defined $$form_data{'usr'}) { - $$form_data{'usr'} = $rid; - } - if ($$form_data{'usr'} != $rid) { - # See if the requestor can place the request on behalf of a different user. - $target_user_fleshed = $e->retrieve_actor_user($$form_data{'usr'}) or return $e->die_event; - $e->allowed('user_request.create', $target_user_fleshed->home_ou) or return $e->die_event; - } else { - $target_user_fleshed = $e->requestor; - $e->allowed('CREATE_PURCHASE_REQUEST') or return $e->die_event; - } - if (! defined $$form_data{'pickup_lib'}) { - if ($target_user_fleshed->ws_ou) { - $$form_data{'pickup_lib'} = $target_user_fleshed->ws_ou; - } else { - $$form_data{'pickup_lib'} = $target_user_fleshed->home_ou; - } - } - if (! defined $$form_data{'request_type'}) { - $$form_data{'request_type'} = 1; # Books - } - my $aur_obj = new Fieldmapper::acq::user_request; - $aur_obj->isnew(1); - $aur_obj->usr( $$form_data{'usr'} ); - $aur_obj->request_date( 'now' ); - for my $field ( keys %$form_data ) { - if (defined $$form_data{$field} and $field !~ /^(id|lineitem|eg_bib|request_date|cancel_reason)$/) { - $aur_obj->$field( $$form_data{$field} ); - } - } - - $aur_obj = $e->create_acq_user_request($aur_obj) or return $e->die_event; - - $e->commit and create_user_request_events( $e, [ $aur_obj ], 'aur.created' ); - - return $aur_obj; -} - -sub create_user_request_events { - my($e, $user_reqs, $hook) = @_; - - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - $ses->connect; - - my %cached_usr_home_ou = (); - for my $user_req (@$user_reqs) { - my $home_ou = $cached_usr_home_ou{$user_req->usr}; - if (! $home_ou) { - my $user = $e->retrieve_actor_user($user_req->usr) or return $e->die_event; - $home_ou = $user->home_ou; - $cached_usr_home_ou{$user_req->usr} = $home_ou; - } - my $req = $ses->request('open-ils.trigger.event.autocreate', $hook, $user_req, $home_ou); - $req->recv; - } - - $ses->disconnect; - return undef; -} - - -__PACKAGE__->register_method( - method => "po_note_CUD_batch", - api_name => "open-ils.acq.po_note.cud.batch", - stream => 1, - signature => { - desc => q/Manage purchase order notes/, - params => [ - {desc => "Authentication token", type => "string"}, - {desc => "List of po_notes to manage", type => "array"}, - ], - return => {desc => "Stream of successfully managed objects"} - } -); - -sub po_note_CUD_batch { - my ($self, $conn, $auth, $notes) = @_; - - my $e = new_editor("xact"=> 1, "authtoken" => $auth); - return $e->die_event unless $e->checkauth; - # XXX perms - - my $total = @$notes; - my $count = 0; - - foreach my $note (@$notes) { - - $note->editor($e->requestor->id); - $note->edit_time("now"); - - if ($note->isnew) { - $note->creator($e->requestor->id); - $note = $e->create_acq_po_note($note) or return $e->die_event; - } elsif ($note->isdeleted) { - $e->delete_acq_po_note($note) or return $e->die_event; - } elsif ($note->ischanged) { - $e->update_acq_po_note($note) or return $e->die_event; - } - - unless ($note->isdeleted) { - $note = $e->retrieve_acq_po_note($note->id) or - return $e->die_event; - } - - $conn->respond( - {"maximum" => $total, "progress" => ++$count, "note" => $note} - ); - } - - $e->commit and $conn->respond_complete or return $e->die_event; -} - - -# retrieves a lineitem, fleshes its PO and PL, checks perms -sub fetch_and_check_li { - my $e = shift; - my $li_id = shift; - my $perm_mode = shift || 'read'; - - my $li = $e->retrieve_acq_lineitem([ - $li_id, - { flesh => 1, - flesh_fields => {jub => ['purchase_order', 'picklist']} - } - ]) or return $e->die_event; - - if(my $po = $li->purchase_order) { - my $perms = ($perm_mode eq 'read') ? 'VIEW_PURCHASE_ORDER' : 'CREATE_PURCHASE_ORDER'; - return ($li, $e->die_event) unless $e->allowed($perms, $po->ordering_agency); - - } elsif(my $pl = $li->picklist) { - my $perms = ($perm_mode eq 'read') ? 'VIEW_PICKLIST' : 'CREATE_PICKLIST'; - return ($li, $e->die_event) unless $e->allowed($perms, $pl->org_unit); - } - - return ($li); -} - - -__PACKAGE__->register_method( - method => "clone_distrib_form", - api_name => "open-ils.acq.distribution_formula.clone", - stream => 1, - signature => { - desc => q/Clone a distribution formula/, - params => [ - {desc => "Authentication token", type => "string"}, - {desc => "Original formula ID", type => 'integer'}, - {desc => "Name of new formula", type => 'string'}, - ], - return => {desc => "ID of newly created formula"} - } -); - -sub clone_distrib_form { - my($self, $client, $auth, $form_id, $new_name) = @_; - - my $e = new_editor("xact"=> 1, "authtoken" => $auth); - return $e->die_event unless $e->checkauth; - - my $old_form = $e->retrieve_acq_distribution_formula($form_id) or return $e->die_event; - return $e->die_event unless $e->allowed('ADMIN_ACQ_DISTRIB_FORMULA', $old_form->owner); - - my $new_form = Fieldmapper::acq::distribution_formula->new; - - $new_form->owner($old_form->owner); - $new_form->name($new_name); - $e->create_acq_distribution_formula($new_form) or return $e->die_event; - - my $entries = $e->search_acq_distribution_formula_entry({formula => $form_id}); - for my $entry (@$entries) { - my $new_entry = Fieldmapper::acq::distribution_formula_entry->new; - $new_entry->$_($entry->$_()) for $entry->real_fields; - $new_entry->formula($new_form->id); - $new_entry->clear_id; - $e->create_acq_distribution_formula_entry($new_entry) or return $e->die_event; - } - - $e->commit; - return $new_form->id; -} - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Picklist.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq/Picklist.pm deleted file mode 100644 index 3780d933b3..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Picklist.pm +++ /dev/null @@ -1,558 +0,0 @@ -package OpenILS::Application::Acq::Picklist; -use base qw/OpenILS::Application/; -use strict; use warnings; - -use OpenSRF::EX q/:try/; -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Const qw/:const/; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Event; -use OpenILS::Application::AppUtils; -use OpenSRF::Utils::Cache; -use MARC::Record; -use MARC::Batch; -use MARC::File::XML; -use MIME::Base64; -use Digest::MD5 qw/md5_hex/; -use OpenILS::Application::Acq::Financials; -use DateTime; - -my $U = 'OpenILS::Application::AppUtils'; - - -__PACKAGE__->register_method( - method => 'create_picklist', - api_name => 'open-ils.acq.picklist.create', - signature => { - desc => 'Creates a new picklist', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Picklist object to create', type => 'object'} - ], - return => {desc => 'The ID of the new picklist'} - } -); - -sub create_picklist { - my($self, $conn, $auth, $picklist) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - $picklist->creator($e->requestor->id); - $picklist->editor($e->requestor->id); - $picklist->org_unit($e->requestor->ws_ou) unless $picklist->org_unit; - return $e->die_event unless $e->allowed('CREATE_PICKLIST', $picklist->org_unit); - return OpenILS::Event->new('BAD_PARAMS') - unless $e->requestor->id == $picklist->owner; - $e->create_acq_picklist($picklist) or return $e->die_event; - $e->commit; - return $picklist->id; -} - - -__PACKAGE__->register_method( - method => 'update_picklist', - api_name => 'open-ils.acq.picklist.update', - signature => { - desc => 'Updates a new picklist', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Picklist object to update', type => 'object'} - ], - return => {desc => '1 on success, Event on error'} - } -); - -sub update_picklist { - my($self, $conn, $auth, $picklist) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - - # don't let them change the owner - my $o_picklist = $e->retrieve_acq_picklist($picklist->id) - or return $e->die_event; - if($o_picklist->owner != $e->requestor->id) { - return $e->die_event unless - $e->allowed('UPDATE_PICKLIST', $o_picklist->org_unit); - } - return OpenILS::Event->new('BAD_PARAMS') unless $o_picklist->org_unit == $picklist->org_unit; - - $picklist->edit_time('now'); - $picklist->editor($e->requestor->id); - $e->update_acq_picklist($picklist) or return $e->die_event; - $e->commit; - return 1; -} - -__PACKAGE__->register_method( - method => 'retrieve_picklist', - api_name => 'open-ils.acq.picklist.retrieve', - authoritative => 1, - signature => { - desc => 'Retrieves a picklist', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Picklist ID to retrieve', type => 'number'}, - {desc => 'Options hash, including "flesh_lineitem_count" to get the count of attached entries', type => 'hash'}, - ], - return => {desc => 'Picklist object on success, Event on error'} - } -); - -sub retrieve_picklist { - my($self, $conn, $auth, $picklist_id, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - return retrieve_picklist_impl($e, $picklist_id, $options); -} - -sub retrieve_picklist_impl { - my ($e, $picklist_id, $options) = @_; - $options ||= {}; - - my $picklist = $e->retrieve_acq_picklist($picklist_id) - or return $e->event; - - $picklist->entry_count(retrieve_lineitem_count($e, $picklist_id)) - if $$options{flesh_lineitem_count}; - - if($e->requestor->id != $picklist->owner) { - return $e->event unless - $e->allowed('VIEW_PICKLIST', $picklist->org_unit, $picklist); - } - - $picklist->owner($e->retrieve_actor_user($picklist->owner)) - if($$options{flesh_owner}); - $picklist->owner($e->retrieve_actor_user($picklist->owner)->usrname) - if($$options{flesh_username}); - - return $picklist; -} - - -# Returns the number of entries associated with this picklist -sub retrieve_lineitem_count { - my($e, $picklist_id) = @_; - my $count = $e->json_query({ - select => { - jub => [{transform => 'count', column => 'id', alias => 'count'}] - }, - from => 'jub', - where => {picklist => $picklist_id}} - ); - return $count->[0]->{count}; -} - - - -__PACKAGE__->register_method( - method => 'retrieve_picklist_name', - api_name => 'open-ils.acq.picklist.name.retrieve', - authoritative => 1, - signature => { - desc => 'Retrieves a picklist by name. Owner is implied by the caller', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Picklist name to retrieve', type => 'string'}, - ], - return => {desc => 'Picklist object on success, null on not found'} - } -); - -sub retrieve_picklist_name { - my($self, $conn, $auth, $name) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - my $picklist = $e->search_acq_picklist( - {name => $name, owner => $e->requestor->id})->[0]; - if($e->requestor->id != $picklist->owner) { - return $e->event unless - $e->allowed('VIEW_PICKLIST', $picklist->org_unit, $picklist); - } - return $picklist; -} - - - -__PACKAGE__->register_method( - method => 'retrieve_user_picklist', - api_name => 'open-ils.acq.picklist.user.retrieve', - stream => 1, - signature => { - desc => 'Retrieves a user\'s picklists', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Options, including "idlist", whch forces the return - of a list of IDs instead of objects', type => 'hash'}, - ], - return => {desc => 'Picklist object on success, Event on error'} - } -); - -sub retrieve_user_picklist { - my($self, $conn, $auth, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->die_event unless $e->checkauth; - $options ||= {}; - - # don't grab the PL with name == "", because that is the designated temporary picklist - my $list = $e->search_acq_picklist([ - { - owner => $e->requestor->id, - name => {'!=' => ''} - }, { - order_by => $$options{order_by} || {acqpl => 'edit_time DESC'}, - limit => $$options{limit} || 10, - offset => $$options{offset} || 0, - } - ], - {idlist=>1} - ); - - for my $id (@$list) { - if($$options{idlist}) { - $conn->respond($id); - } else { - my $pl = $e->retrieve_acq_picklist($id); - $pl->entry_count(retrieve_lineitem_count($e, $id)) if $$options{flesh_lineitem_count}; - $pl->owner($e->retrieve_actor_user($pl->owner)) if $$options{flesh_owner}; - $pl->owner($e->retrieve_actor_user($pl->owner)->usrname) if $$options{flesh_username}; - $conn->respond($pl); - } - } - - return undef; -} - - -__PACKAGE__->register_method( - method => 'retrieve_all_user_picklist', - api_name => 'open-ils.acq.picklist.user.all.retrieve', - stream => 1, - signature => { - desc => 'Retrieves all of the picklists a user is allowed to see', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Options, including "idlist", whch forces the return - of a list of IDs instead of objects', type => 'hash'}, - ], - return => {desc => 'Picklist objects on success, Event on error'} - } -); - -sub retrieve_all_user_picklist { - my($self, $conn, $auth, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - my $my_list = $e->search_acq_picklist( - {owner=>$e->requestor->id, name=>{'!='=>''}}, {idlist=>1}); - - my $picklist_ids = $e->objects_allowed('VIEW_PICKLIST', 'acqpl'); - my $p_orgs = $U->user_has_work_perm_at($e, 'VIEW_PICKLIST', {descendants =>1}); - my $picklist_ids_2 = $e->search_acq_picklist( - {name=>{'!='=>''}, org_unit => $p_orgs}, {idlist=>1}); - - return undef unless @$my_list or @$picklist_ids or @$picklist_ids_2; - - my @list = (@$my_list, @$picklist_ids, @$picklist_ids_2); - my %dedup; - $dedup{$_} = 1 for @list; - @list = keys %dedup; - - return \@list if $$options{idlist}; - - for my $pl (@list) { - my $picklist = $e->retrieve_acq_picklist($pl) or return $e->event; - $picklist->entry_count(retrieve_lineitem_count($e, $picklist->id)) - if($$options{flesh_lineitem_count}); - $picklist->owner($e->retrieve_actor_user($picklist->owner)) - if $$options{flesh_owner}; - $picklist->owner($e->retrieve_actor_user($picklist->owner)->usrname) - if $$options{flesh_username}; - $conn->respond($picklist); - } - - return undef; -} - -__PACKAGE__->register_method( - method => 'retrieve_pl_lineitem', - api_name => 'open-ils.acq.lineitem.picklist.retrieve', - stream => 1, - signature => { - desc => 'Retrieves lineitem objects according to picklist', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Picklist ID whose entries to retrieve', type => 'number'}, - {desc => q/Options, including - "sort_attr", which defines the attribute to sort on; - "sort_attr_type", which defines the attribute type sort on; - "sort_dir", which defines the sort order between "asc" and "desc"; - "limit", retrieval limit; - "offset", retrieval offset; - "idlist", return a list of IDs instead of objects - "flesh_attrs", additionaly return the list of flattened attributes - "clear_marc", discards the raw MARC data to reduce data size - "flesh_notes", flesh lineitem notes - "flesh_cancel_reason", flesh cancel_reason - /, - type => 'hash'} - ], - return => {desc => 'Array of lineitem objects or IDs, on success, Event on error'} - } -); - - -my $PL_ENTRY_JSON_QUERY = { - select => {jub => ["id"], "acqlia" => ["attr_value"]}, - "from" => { - "jub" => { - "acqlia" => { - "fkey" => "id", - "field" => "lineitem", - "type" => "left", - "filter" => { - "attr_type" => "lineitem_marc_attr_definition", - "attr_name" => "author" - } - } - } - }, - "order_by" => {"acqlia" => {"attr_value" => {"direction"=>"asc"}}}, - "limit" => 10, - "where" => {"+jub" => {"picklist"=>2}}, - "offset" => 0 -}; - -sub retrieve_pl_lineitem { - my($self, $conn, $auth, $picklist_id, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - # collect the retrieval options - my $sort_attr = $$options{sort_attr} || 'title'; - my $sort_attr_type = $$options{sort_attr_type} || 'lineitem_marc_attr_definition'; - my $sort_dir = $$options{sort_dir} || 'asc'; - my $limit = $$options{limit} || 10; - my $offset = $$options{offset} || 0; - - $PL_ENTRY_JSON_QUERY->{where}->{'+jub'}->{picklist} = $picklist_id; - $PL_ENTRY_JSON_QUERY->{from}->{jub}->{acqlia}->{filter}->{attr_name} = $sort_attr; - $PL_ENTRY_JSON_QUERY->{from}->{jub}->{acqlia}->{filter}->{attr_type} = $sort_attr_type; - $PL_ENTRY_JSON_QUERY->{order_by}->{acqlia}->{attr_value}->{direction} = $sort_dir; - $PL_ENTRY_JSON_QUERY->{limit} = $limit; - $PL_ENTRY_JSON_QUERY->{offset} = $offset; - - my $entries = $e->json_query($PL_ENTRY_JSON_QUERY); - - my @ids; - for my $entry (@$entries) { - push(@ids, $entry->{id}) unless grep { $_ eq $entry->{id} } @ids; - } - - for my $id (@ids) { - if($$options{idlist}) { - $conn->respond($id); - next; - } - - my $entry; - my $flesh = {}; - if($$options{flesh_attrs} or $$options{flesh_notes} or $$options{flesh_cancel_reason}) { - $flesh = {flesh => 2, flesh_fields => {jub => []}}; - if($$options{flesh_notes}) { - push(@{$flesh->{flesh_fields}->{jub}}, 'lineitem_notes'); - $flesh->{flesh_fields}->{acqlin} = ['alert_text']; - } - push(@{$flesh->{flesh_fields}->{jub}}, 'attributes') if $$options{flesh_attrs}; - push @{$flesh->{flesh_fields}->{jub}}, 'cancel_reason' if $$options{flesh_cancel_reason}; - } - - $entry = $e->retrieve_acq_lineitem([$id, $flesh]); - my $details = $e->search_acq_lineitem_detail({lineitem => $id}, {idlist=>1}); - $entry->item_count(scalar(@$details)); - $entry->clear_marc if $$options{clear_marc}; - $conn->respond($entry); - } - - return undef; -} - -=head comment -request open-ils.cstore open-ils.cstore.json_query.atomic {"select":{"jub":[{"transform":"count", "attregate":1, "column":"id","alias":"count"}]}, "from":"jub","where":{"picklist":1}} -=cut - - - -__PACKAGE__->register_method( - method => "record_distribution_formula_application", - api_name => "open-ils.acq.distribution_formula.record_application", - signature => { - desc => "Record the application (which actually happens on the " . - "client side) of a distribution formula to a PO or a PL", - params => [ - {desc => "Authentication token", type => "string"}, - {desc => "Formulae applied", "type" => "array"}, - {desc => "Lineitem ID", "type" => "number"} - ], - return => {desc => "acqdfa IDs on success; event on failure"} - } -); - -sub record_distribution_formula_application { - my ($self, $conn, $auth, $formulae, $li_id) = @_; - - my $e = new_editor("authtoken" => $auth, "xact" => 1); - return $e->die_event unless $e->checkauth; - - # We need this to determine relevant OU for testing permissions... - my $li = $e->retrieve_acq_lineitem([ - $li_id, { - "flesh" => 1, - "flesh_fields" => {"jub" => [qw/purchase_order picklist/]} - } - ]) or return $e->die_event; - - # ... which we do here. - my $ou; - if ($li->purchase_order) { - $ou = $li->purchase_order->ordering_agency; - } elsif ($li->picklist) { - $ou = $li->picklist->org_unit; - } else { - $e->rollback; - return new OpenILS::Event("BAD_PARAMS"); - } - - return $e->die_event unless $e->allowed("CREATE_PURCHASE_ORDER", $ou); - - # Just deal with it if $formulate is a scalar instead of an array. - $formulae = [ $formulae ] if not ref $formulae; - - my @results = (); - foreach (@{$formulae}) { - my $acqdfa = new Fieldmapper::acq::distribution_formula_application; - - $acqdfa->creator($e->requestor->id); - $acqdfa->formula($_); - $acqdfa->lineitem($li_id); - - $acqdfa = $e->create_acq_distribution_formula_application($acqdfa) - or return $e->die_event; - push @results, $acqdfa->id; - } - - $e->commit or return $e->die_event; - \@results; -} - - -__PACKAGE__->register_method( - method => 'ranged_distrib_formulas', - api_name => 'open-ils.acq.distribution_formula.ranged.retrieve', - stream => 1, - signature => { - desc => 'Ranged distribution formulas, fleshed with entries', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => "offset", type => "number"}, - {desc => "limit", type => "number"} - ], - return => {desc => 'List of distribution formulas'} - } -); - -sub ranged_distrib_formulas { - my ($self, $conn, $auth, $offset, $limit) = @_; - - $offset ||= 0; - $limit ||= 10; - - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - my $orgs = $U->user_has_work_perm_at($e, 'CREATE_PICKLIST', {descendants =>1}); - - my $forms = $e->search_acq_distribution_formula([ - {owner => $orgs}, - { - flesh => 1, - flesh_fields => {acqdf => ['entries']}, - order_by => {acqdf => "name"}, - limit => $limit, - offset => $offset - } - ]) or return $e->die_event; - - for (@$forms) { - - # how many times has this DF been used - my $count = $e->json_query({ - select => {acqdfa => [{column => 'formula', aggregate => 1, transform => 'count', alias => 'count'}]}, - from => 'acqdfa', - where => {formula => $_->id} - })->[0]; - - $_->use_count($count->{count}); - $conn->respond($_); - } - - return undef; -} - -__PACKAGE__->register_method( - method => "ranged_distrib_formula_applications", - api_name => "open-ils.acq.distribution_formula_application.ranged.retrieve", - stream => 1, - signature => { - desc => "Ranged distribution formulas applications, fleshed with formulas and users", - params => [ - {desc => "Authentication token", type => "string"}, - {desc => "Lineitem Id", type => "number"} - ], - return => {desc => "List of distribution formula applications"} - } -); - -sub ranged_distrib_formula_applications { - my ($self, $conn, $auth, $li_id) = @_; - - my $e = new_editor("authtoken" => $auth); - return $e->event unless $e->checkauth; - - my $li = $e->retrieve_acq_lineitem([ - $li_id, { - "flesh" => 1, - "flesh_fields" => {"jub" => [qw/purchase_order picklist/]} - } - ]) or return $e->die_event; - - if ($li->picklist) { - return $e->die_event unless $e->allowed( - "VIEW_PICKLIST", $li->picklist->org_unit - ); - } elsif ($li->purchase_order) { - return $e->die_event unless $e->allowed( - "VIEW_PURCHASE_ORDER", $li->purchase_order->ordering_agency - ); - } else { - # For the moment no use cases are forseen for using this - # method with LIs that don't belong to a PL or a PO. - $e->disconnect; - return new OpenILS::Event("BAD_PARAMS", "note" => "Freestanding LI"); - } - - my $dfa = $e->search_acq_distribution_formula_application([ - {"lineitem" => $li_id}, - {"flesh" => 1, "flesh_fields" => {"acqdfa" => [qw/formula creator/]}} - ]); - - $conn->respond($_) foreach (@$dfa); - - $e->disconnect; - undef; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Provider.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq/Provider.pm deleted file mode 100644 index 10d96cbfc5..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Provider.pm +++ /dev/null @@ -1,189 +0,0 @@ -package OpenILS::Application::Acq::Provider; -use base qw/OpenILS::Application/; -use strict; use warnings; - -use OpenILS::Event; -use OpenILS::Const qw/:const/; -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Application::AppUtils; - -my $U = 'OpenILS::Application::AppUtils'; - -__PACKAGE__->register_method( - method => 'create_provider', - api_name => 'open-ils.acq.provider.create', - signature => { - desc => 'Creates a new provider', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'provider object to create', type => 'object'} - ], - return => {desc => 'The ID of the new provider'} - } -); - -sub create_provider { - my($self, $conn, $auth, $provider) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('ADMIN_PROVIDER', $provider->owner); - $e->create_acq_provider($provider) or return $e->die_event; - $e->commit; - return $provider->id; -} - - - -__PACKAGE__->register_method( - method => 'retrieve_provider', - api_name => 'open-ils.acq.provider.retrieve', - authoritative => 1, - signature => { - desc => 'Retrieves a new provider', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'provider ID', type => 'number'} - ], - return => {desc => 'The provider object on success, Event on failure'} - } -); - -sub retrieve_provider { - my($self, $conn, $auth, $provider_id) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - my $provider = $e->retrieve_acq_provider($provider_id) or return $e->event; - return $e->event unless $e->allowed( - ['ADMIN_PROVIDER', 'MANAGE_PROVIDER', 'VIEW_PROVIDER'], $provider->owner, $provider); - return $provider; -} - - -__PACKAGE__->register_method( - method => 'retrieve_org_providers', - api_name => 'open-ils.acq.provider.org.retrieve', - stream => 1, - signature => { - desc => 'Retrieves all the providers associated with an org unit that the requestor has access to see', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'List of org Unit IDs. If no IDs are provided, this method returns the - full set of funding sources this user has permission to view', type => 'number'}, - {desc => q/Limiting permission. this permission is used find the work-org tree from which - the list of orgs is generated if no org ids are provided. - The default is ADMIN_PROVIDER/, type => 'string'}, - ], - return => {desc => 'The provider objects on success, empty array otherwise'} - } -); - -sub retrieve_org_providers { - my($self, $conn, $auth, $org_id_list, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - my $limit_perm = ($$options{limit_perm}) ? $$options{limit_perm} : 'ADMIN_PROVIDER'; - - return OpenILS::Event->new('BAD_PARAMS') - unless $limit_perm =~ /(ADMIN|MANAGE|VIEW)_PROVIDER/; - - my $org_ids = ($org_id_list and @$org_id_list) ? $org_id_list : - $U->user_has_work_perm_at($e, $limit_perm, {descendants =>1}); - - return [] unless @$org_ids; - $conn->respond($_) for @{ - $e->search_acq_provider([ - {owner => $org_ids, active => 't'}, - {order_by => {acqpro => 'code'}} - ]) - }; - - return undef; -} - -__PACKAGE__->register_method( - method => 'retrieve_provider_attr_def', - api_name => 'open-ils.acq.lineitem_provider_attr_definition.provider.retrieve', - stream => 1, - signature => { - desc => 'Retrieves all of the lineitem_provider_attr_definition for a given provider', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Provider ID', type => 'number'} - ], - return => {desc => 'Streams a of lineitem_provider_attr_definition objects'} - } -); - -sub retrieve_provider_attr_def { - my($self, $conn, $auth, $prov_id) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - my $provider = $e->retrieve_acq_provider($prov_id) - or return $e->event; - return $e->event unless $e->allowed('ADMIN_PROVIDER', $provider->owner); - for my $id (@{$e->search_acq_lineitem_provider_attr_definition({provider=>$prov_id},{idlist=>1})}) { - $conn->respond($e->retrieve_acq_lineitem_provider_attr_definition($id)); - } - - return undef; -} - -__PACKAGE__->register_method( - method => 'create_provider_attr_def', - api_name => 'open-ils.acq.lineitem_provider_attr_definition.create', - signature => { - desc => 'Retrieves all of the lineitem_provider_attr_definition for a given provider', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Provider ID', type => 'number'} - ], - return => {desc => 'Streams a of lineitem_provider_attr_definition objects'} - } -); - -sub create_provider_attr_def { - my($self, $conn, $auth, $attr_def) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - my $provider = $e->retrieve_acq_provider($attr_def->provider) - or return $e->die_event; - return $e->die_event unless $e->allowed('ADMIN_PROVIDER', $provider->owner); - $e->create_acq_lineitem_provider_attr_definition($attr_def) - or return $e->die_event; - $e->commit; - return $attr_def->id; -} - -__PACKAGE__->register_method( - method => 'delete_provider_attr_def', - api_name => 'open-ils.acq.lineitem_provider_attr_definition.delete', - signature => { - desc => 'Deletes a lineitem_provider_attr_definition', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'ID', type => 'number'} - ], - return => {desc => '1 on success, event on failure'} - } -); - -sub delete_provider_attr_def { - my($self, $conn, $auth, $id) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - my $attr_def = $e->retrieve_acq_lineitem_provider_attr_definition($id) - or return $e->die_event; - my $provider = $e->retrieve_acq_provider($attr_def->provider) - or return $e->die_event; - return $e->die_event unless $e->allowed('ADMIN_PROVIDER', $provider->owner); - $e->delete_acq_lineitem_provider_attr_definition($attr_def) - or return $e->die_event; - $e->commit; - return 1; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Search.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq/Search.pm deleted file mode 100644 index b6f267c903..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Search.pm +++ /dev/null @@ -1,616 +0,0 @@ -package OpenILS::Application::Acq::Search; -use base "OpenILS::Application"; - -use strict; -use warnings; - -use OpenSRF::AppSession; -use OpenSRF::Utils::Logger qw/:logger/; -use OpenILS::Event; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Application::Acq::Lineitem; -use OpenILS::Application::Acq::Financials; -use OpenILS::Application::Acq::Picklist; -use OpenILS::Application::Acq::Invoice; -use OpenILS::Application::Acq::Order; - -my %RETRIEVERS = ( - "lineitem" => - \&{"OpenILS::Application::Acq::Lineitem::retrieve_lineitem_impl"}, - "picklist" => - \&{"OpenILS::Application::Acq::Picklist::retrieve_picklist_impl"}, - "purchase_order" => \&{ - "OpenILS::Application::Acq::Financials::retrieve_purchase_order_impl" - }, - "invoice" => \&{ - "OpenILS::Application::Acq::Invoice::fetch_invoice_impl" - }, -); - -sub F { $Fieldmapper::fieldmap->{"Fieldmapper::" . $_[0]}; } - -# This subroutine returns 1 if the argument is a) a scalar OR -# b) an array of ONLY scalars. Otherwise it returns 0. -sub check_1d_max { - my ($o) = @_; - return 1 unless ref $o; - if (ref($o) eq "ARRAY") { - foreach (@$o) { return 0 if ref $_; } - return 1; - } - 0; -} - -# Returns 1 if and only if argument is an array of exactly two scalars. -sub could_be_range { - my ($o) = @_; - if (ref $o eq "ARRAY") { - return 1 if (scalar(@$o) == 2 && (!ref $o->[0] && !ref $o->[1])); - } - 0; -} - -sub castdate { - my ($value, $gte, $lte) = @_; - - my $op = "="; - $op = ">=" if $gte; - $op = "<=" if $lte; - - +{$op => {"transform" => "date", "value" => $value}}; -} - -sub prepare_acqlia_search_and { - my ($acqlia) = @_; - - my @phrases = (); - foreach my $unit (@{$acqlia}) { - my $subquery = { - "select" => {"acqlia" => ["id"]}, - "from" => "acqlia", - "where" => {"-and" => [{"lineitem" => {"=" => {"+jub" => "id"}}}]} - }; - - # castdate not supported for acqlia fields: they're all type text - my ($k, $v, $fuzzy, $between, $not) = breakdown_term($unit); - my $point = $subquery->{"where"}->{"-and"}; - my $term_clause; - - push @$point, {"definition" => $k}; - - if ($fuzzy and not ref $v) { - push @$point, {"attr_value" => {"ilike" => "%" . $v . "%"}}; - } elsif ($between and could_be_range($v)) { - push @$point, {"attr_value" => {"between" => $v}}; - } elsif (check_1d_max($v)) { - push @$point, {"attr_value" => $v}; - } else { - next; - } - - my $operator = $not ? "-not-exists" : "-exists"; - push @phrases, {$operator => $subquery}; - } - @phrases; -} - -sub prepare_acqlia_search_or { - my ($acqlia) = @_; - - my $point = []; - my $result = {"+acqlia" => {"-or" => $point}}; - - foreach my $unit (@$acqlia) { - # castdate not supported for acqlia fields: they're all type text - my ($k, $v, $fuzzy, $between, $not) = breakdown_term($unit); - my $term_clause; - if ($fuzzy and not ref $v) { - $term_clause = { - "-and" => { - "definition" => $k, - "attr_value" => {"ilike" => "%" . $v . "%"} - } - }; - } elsif ($between and could_be_range($v)) { - $term_clause = { - "-and" => { - "definition" => $k, "attr_value" => {"between" => $v} - } - }; - } elsif (check_1d_max($v)) { - $term_clause = { - "-and" => {"definition" => $k, "attr_value" => $v} - }; - } else { - next; - } - - push @$point, $not ? {"-not" => $term_clause} : $term_clause; - } - $result; -} - -sub breakdown_term { - my ($term) = @_; - - my $key = (grep { !/^__/ } keys %$term)[0]; - ( - $key, $term->{$key}, - $term->{"__fuzzy"} ? 1 : 0, - $term->{"__between"} ? 1 : 0, - $term->{"__not"} ? 1 : 0, - $term->{"__castdate"} ? 1 : 0, - $term->{"__gte"} ? 1 : 0, - $term->{"__lte"} ? 1 : 0 - ); -} - -sub get_fm_links_by_hint { - my ($hint) = @_; - foreach my $field (values %{$Fieldmapper::fieldmap}) { - return $field->{"links"} if $field->{"hint"} eq $hint; - } - undef; -} - -sub gen_au_term { - my ($value, $n) = @_; - +{ - "-or" => [ - {"+au$n" => {"usrname" => $value}}, - {"+au$n" => {"first_given_name" => $value}}, - {"+au$n" => {"second_given_name" => $value}}, - {"+au$n" => {"family_name" => $value}}, - {"+ac$n" => {"barcode" => $value}} - ] - }; -} - -# go through the terms hash, find keys that correspond to fields links -# to actor.usr, and rewrite the search as one that searches not by -# actor.usr.id but by any of these user properties: card barcode, username, -# given names and family name. -sub prepare_au_terms { - my ($terms, $join_num) = @_; - - my @joins = (); - my $nots = 0; - $join_num ||= 0; - - foreach my $conj (qw/-and -or/) { - next unless exists $terms->{$conj}; - - my @new_outer_terms = (); - HINT_UNIT: foreach my $hint_unit (@{$terms->{$conj}}) { - my $hint = (keys %$hint_unit)[0]; - (my $plain_hint = $hint) =~ y/+//d; - if ($hint eq "-not") { - $hint_unit = $hint_unit->{$hint}; - $nots++; - redo HINT_UNIT; - } - - if (my $links = get_fm_links_by_hint($plain_hint) and - $plain_hint ne "acqlia") { - my @new_terms = (); - my ($attr, $value) = breakdown_term($hint_unit->{$hint}); - if ($links->{$attr} and - $links->{$attr}->{"class"} eq "au") { - push @joins, [$plain_hint, $attr, $join_num]; - my $au_term = gen_au_term($value, $join_num); - if ($nots > 0) { - $au_term = {"-not" => $au_term}; - $nots--; - } - push @new_outer_terms, $au_term; - $join_num++; - delete $hint_unit->{$hint}; - } - } - if ($nots > 0) { - $hint_unit = {"-not" => $hint_unit}; - $nots--; - } - push @new_outer_terms, $hint_unit if scalar keys %$hint_unit; - } - $terms->{$conj} = [ @new_outer_terms ]; - } - @joins; -} - -sub prepare_terms { - my ($terms, $is_and) = @_; - - my $conj = $is_and ? "-and" : "-or"; - my $outer_clause = {}; - - foreach my $class (qw/acqpo acqpl acqinv jub/) { - next if not exists $terms->{$class}; - - $outer_clause->{$conj} = [] unless $outer_clause->{$conj}; - foreach my $unit (@{$terms->{$class}}) { - my ($k, $v, $fuzzy, $between, $not, $castdate, $gte, $lte) = - breakdown_term($unit); - - my $term_clause; - if ($fuzzy and not ref $v) { - $term_clause = {$k => {"ilike" => "%" . $v . "%"}}; - } elsif ($between and could_be_range($v)) { - $term_clause = {$k => {"between" => $v}}; - } elsif (check_1d_max($v)) { - $v = castdate($v, $gte, $lte) if $castdate; - $term_clause = {$k => $v}; - } else { - next; - } - - my $clause = {"+" . $class => $term_clause}; - $clause = {"-not" => $clause} if $not; - push @{$outer_clause->{$conj}}, $clause; - } - } - - if ($terms->{"acqlia"}) { - push @{$outer_clause->{$conj}}, - $is_and ? prepare_acqlia_search_and($terms->{"acqlia"}) : - prepare_acqlia_search_or($terms->{"acqlia"}); - } - - return undef unless scalar keys %$outer_clause; - $outer_clause; -} - -sub add_au_joins { - my ($from) = shift; - - my $n = 0; - foreach my $join (@_) { - my ($hint, $attr, $num) = @$join; - my $start; - if ($hint eq "jub") { - $start = $from->{$hint}; - } elsif ($hint eq "acqinv") { - $start = $from->{"jub"}->{"acqie"}->{"join"}->{$hint}; - } else { - $start = $from->{"jub"}->{$hint}; - } - my $clause = { - "class" => "au", - "type" => "left", - "field" => "id", - "fkey" => $attr, - "join" => { - "ac$num" => { - "class" => "ac", - "type" => "left", - "field" => "id", - "fkey" => "card" - } - } - }; - if ($hint eq "jub") { - $start->{"au$num"} = $clause; - } else { - $start->{"join"} ||= {}; - $start->{"join"}->{"au$num"} = $clause; - } - $n++; - } - $n; -} - -__PACKAGE__->register_method( - method => "unified_search", - api_name => "open-ils.acq.lineitem.unified_search", - stream => 1, - signature => { - desc => q/Returns lineitems based on flexible search terms./, - params => [ - {desc => "Authentication token", type => "string"}, - {desc => "Field/value pairs for AND'ing", type => "object"}, - {desc => "Field/value pairs for OR'ing", type => "object"}, - {desc => "Conjunction between AND pairs and OR pairs " . - "(can be 'and' or 'or')", type => "string"}, - {desc => "Retrieval options (clear_marc, flesh_notes, etc) " . - "- XXX detail all the options", - type => "object"} - ], - return => {desc => "A stream of LIs on success, Event on failure"} - } -); - -__PACKAGE__->register_method( - method => "unified_search", - api_name => "open-ils.acq.purchase_order.unified_search", - stream => 1, - signature => { - desc => q/Returns purchase orders based on flexible search terms. - See open-ils.acq.lineitem.unified_search/, - return => {desc => "A stream of POs on success, Event on failure"} - } -); - -__PACKAGE__->register_method( - method => "unified_search", - api_name => "open-ils.acq.picklist.unified_search", - stream => 1, - signature => { - desc => q/Returns pick lists based on flexible search terms. - See open-ils.acq.lineitem.unified_search/, - return => {desc => "A stream of PLs on success, Event on failure"} - } -); - -__PACKAGE__->register_method( - method => "unified_search", - api_name => "open-ils.acq.invoice.unified_search", - stream => 1, - signature => { - desc => q/Returns invoices lists based on flexible search terms. - See open-ils.acq.lineitem.unified_search/, - return => {desc => "A stream of invoices on success, Event on failure"} - } -); - -sub unified_search { - my ($self, $conn, $auth, $and_terms, $or_terms, $conj, $options) = @_; - $options ||= {}; - - my $e = new_editor("authtoken" => $auth); - return $e->die_event unless $e->checkauth; - - # What kind of object are we returning? Important: (\w+) had better be - # a legit acq classname particle, so don't register any crazy api_names. - my $ret_type = ($self->api_name =~ /cq.(\w+).un/)[0]; - my $retriever = $RETRIEVERS{$ret_type}; - my $hint = F("acq::$ret_type")->{"hint"}; - - my $select_clause = { - $hint => [{"column" => "id", "transform" => "distinct"}] - }; - - if ($options->{"order_by"}) { - # What's the point of this block? When using ORDER BY in conjuction - # with SELECT DISTINCT, the fields present in ORDER BY have to also - # be in the SELECT clause. This will take _one_ such field and add - # it to the SELECT clause as needed. - my ($order_by, $class, $field); - unless ( - ($order_by = $options->{"order_by"}->[0]) && - ($class = $order_by->{"class"}) =~ /^[\da-z_]+$/ && - ($field = $order_by->{"field"}) =~ /^[\da-z_]+$/ - ) { - $e->disconnect; - return new OpenILS::Event( - "BAD_PARAMS", "note" => -q/order_by clause must be of the long form, like: -"order_by": [{"class": "foo", "field": "bar", "direction": "asc"}]/ - ); - } else { - $select_clause->{$class} ||= []; - push @{$select_clause->{$class}}, $field; - } - } - - my $query = { - "select" => $select_clause, - "from" => { - "jub" => { - "acqpo" => { - "type" => "full", - "field" => "id", - "fkey" => "purchase_order" - }, - "acqpl" => { - "type" => "full", - "field" => "id", - "fkey" => "picklist" - }, - "acqie" => { - "type" => "full", - "field" => "lineitem", - "fkey" => "id", - "join" => { - "acqinv" => { - "type" => "full", - "fkey" => "invoice", - "field" => "id" - } - } - } - } - }, - "order_by" => ($options->{"order_by"} || {$hint => {"id" => {}}}), - "offset" => ($options->{"offset"} || 0) - }; - - $query->{"limit"} = $options->{"limit"} if $options->{"limit"}; - - # XXX for the future? but it doesn't quite work as is. -# # Remove anything in temporary picklists from search results. -# $and_terms ||= {}; -# $and_terms->{"acqpl"} ||= []; -# push @{$and_terms->{"acqpl"}}, {"name" => "", "__not" => 1}; - - $and_terms = prepare_terms($and_terms, 1); - $or_terms = prepare_terms($or_terms, 0) and do { - $query->{"from"}->{"jub"}->{"acqlia"} = { - "type" => "left", "field" => "lineitem", "fkey" => "id", - }; - }; - - my $offset = add_au_joins($query->{"from"}, prepare_au_terms($and_terms)); - add_au_joins($query->{"from"}, prepare_au_terms($or_terms, $offset)); - - if ($and_terms and $or_terms) { - $query->{"where"} = { - "-" . (lc $conj eq "or" ? "or" : "and") => [$and_terms, $or_terms] - }; - } elsif ($and_terms) { - $query->{"where"} = $and_terms; - } elsif ($or_terms) { - $query->{"where"} = $or_terms; - } else { - $e->disconnect; - return new OpenILS::Event("BAD_PARAMS", "desc" => "No usable terms"); - } - - my $results = $e->json_query($query) or return $e->die_event; - my @id_list = map { $_->{"id"} } (grep { $_->{"id"} } @$results); - - if ($options->{"id_list"}) { - $conn->respond($_) foreach @id_list; - } else { - $conn->respond($retriever->($e, $_, $options)) foreach @id_list; - } - - $e->disconnect; - undef; -} - -__PACKAGE__->register_method( - method => "bib_search", - api_name => "open-ils.acq.biblio.wrapped_search", - stream => 1, - signature => { - desc => q/Returns new lineitems for each matching bib record/, - params => [ - {desc => "Authentication token", type => "string"}, - {desc => "search string", type => "string"}, - {desc => "search options", type => "object"} - ], - return => {desc => "A stream of LIs on success, Event on failure"} - } -); - -__PACKAGE__->register_method( - method => "bib_search", - api_name => "open-ils.acq.biblio.create_by_id", - stream => 1, - signature => { - desc => q/Returns new lineitems for each matching bib record/, - params => [ - {desc => "Authentication token", type => "string"}, - {desc => "list of bib IDs", type => "array"}, - {desc => "options (for lineitem fleshing)", type => "object"} - ], - return => {desc => "A stream of LIs on success, Event on failure"} - } -); - -# This is very similar to zsearch() in Order.pm -sub bib_search { - my ($self, $conn, $auth, $search, $opts) = @_; - - my $e = new_editor("authtoken" => $auth, "xact" => 1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed("CREATE_PICKLIST"); - - my $mgr = new OpenILS::Application::Acq::BatchManager( - "editor" => $e, "conn" => $conn - ); - - $opts ||= {}; - - my $picklist; - my @li_ids = (); - if ($self->api_name =~ /create_by_id/) { - $search = [ sort @$search ]; # for consitency - my $bibs = $e->search_biblio_record_entry( - {"id" => $search}, {"order_by" => {"bre" => ["id"]}} - ) or return $e->die_event; - - if ($opts->{"reuse_picklist"}) { - $picklist = $e->retrieve_acq_picklist($opts->{"reuse_picklist"}) or - return $e->die_event; - return $e->die_event unless - $e->allowed("UPDATE_PICKLIST", $picklist->org_unit); - - # If we're reusing an existing picklist, we don't need to - # create new lineitems for any bib records for which we already - - my $already_have = $e->search_acq_lineitem({ - "picklist" => $picklist->id, - "eg_bib_id" => [ map { $_->id } @$bibs ] - }) or return $e->die_event; - - # So in that case we a) save the lineitem id's of the relevant - # items that already exist so that we can return those items later, - # and b) remove the bib id's in question from our list of bib - # id's to lineitemize. - if (@$already_have) { - push @li_ids, $_->id foreach (@$already_have); - my @new_bibs = (); - foreach my $bib (@$bibs) { - push @new_bibs, $bib unless - grep { $_->eg_bib_id == $bib->id } @$already_have; - } - $bibs = [ @new_bibs ]; - } - } else { - $picklist = OpenILS::Application::Acq::Order::zsearch_build_pl($mgr, undef) - or return $e->die_event; - } - - $conn->respond($picklist->id); - - push @li_ids, map { - OpenILS::Application::Acq::Order::create_lineitem( - $mgr, - "picklist" => $picklist->id, - "source_label" => "native-evergreen-catalog", - "marc" => $_->marc, - "eg_bib_id" => $_->id - )->id; - } (@$bibs); - } else { - $opts->{"limit"} ||= 10; - - my $ses = create OpenSRF::AppSession("open-ils.search"); - my $req = $ses->request( - "open-ils.search.biblio.multiclass.query.staff", $opts, $search - ); - - my $count = 0; - while (my $resp = $req->recv("timeout" => 60)) { - $picklist = OpenILS::Application::Acq::Order::zsearch_build_pl( - $mgr, undef - ) unless $count++; - - my $result = $resp->content; - next if not ref $result; - - # The result object contains a whole heck of a lot more information - # than just bib IDs, so maybe we could tell the client something - # useful (progress meter at least) in the future... - push @li_ids, map { - my $bib = $_->[0]; - OpenILS::Application::Acq::Order::create_lineitem( - $mgr, - "picklist" => $picklist->id, - "source_label" => "native-evergreen-catalog", - "marc" => $e->retrieve_biblio_record_entry($bib)->marc, - "eg_bib_id" => $bib - )->id; - } (@{$result->{"ids"}}); - } - $ses->disconnect; - } - - $e->commit; - - $logger->info("created @li_ids new lineitems for picklist $picklist"); - - # new editor, but still using transaction to ensure correct retrieval - # in a replicated setup - $e = new_editor("authtoken" => $auth, xact => 1) or return $e->die_event; - return $e->die_event unless $e->checkauth; - $conn->respond($RETRIEVERS{"lineitem"}->($e, $_, $opts)) foreach @li_ids; - $e->rollback; - $e->disconnect; - - undef; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Actor.pm b/Open-ILS/src/perlmods/OpenILS/Application/Actor.pm deleted file mode 100644 index fa75db451c..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Actor.pm +++ /dev/null @@ -1,4292 +0,0 @@ -package OpenILS::Application::Actor; -use OpenILS::Application; -use base qw/OpenILS::Application/; -use strict; use warnings; -use Data::Dumper; -$Data::Dumper::Indent = 0; -use OpenILS::Event; - -use Digest::MD5 qw(md5_hex); - -use OpenSRF::EX qw(:try); -use OpenILS::Perm; - -use OpenILS::Application::AppUtils; - -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::ModsParser; -use OpenSRF::Utils::Logger qw/$logger/; -use OpenSRF::Utils qw/:datetime/; -use OpenSRF::Utils::SettingsClient; - -use OpenSRF::Utils::Cache; - -use OpenSRF::Utils::JSON; -use DateTime; -use DateTime::Format::ISO8601; -use OpenILS::Const qw/:const/; - -use OpenILS::Application::Actor::Container; -use OpenILS::Application::Actor::ClosedDates; -use OpenILS::Application::Actor::UserGroups; -use OpenILS::Application::Actor::Friends; -use OpenILS::Application::Actor::Stage; - -use OpenILS::Utils::CStoreEditor qw/:funcs/; -use OpenILS::Utils::Penalty; -use List::Util qw/max/; - -use UUID::Tiny qw/:std/; - -sub initialize { - OpenILS::Application::Actor::Container->initialize(); - OpenILS::Application::Actor::UserGroups->initialize(); - OpenILS::Application::Actor::ClosedDates->initialize(); -} - -my $apputils = "OpenILS::Application::AppUtils"; -my $U = $apputils; - -sub _d { warn "Patron:\n" . Dumper(shift()); } - -my $cache; -my $set_user_settings; -my $set_ou_settings; - - -#__PACKAGE__->register_method( -# method => "allowed_test", -# api_name => "open-ils.actor.allowed_test", -#); -#sub allowed_test { -# my($self, $conn, $auth, $orgid, $permcode) = @_; -# my $e = new_editor(authtoken => $auth); -# return $e->die_event unless $e->checkauth; -# -# return { -# orgid => $orgid, -# permcode => $permcode, -# result => $e->allowed($permcode, $orgid) -# }; -#} - -__PACKAGE__->register_method( - method => "update_user_setting", - api_name => "open-ils.actor.patron.settings.update", -); -sub update_user_setting { - my($self, $conn, $auth, $user_id, $settings) = @_; - my $e = new_editor(xact => 1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - - $user_id = $e->requestor->id unless defined $user_id; - - unless($e->requestor->id == $user_id) { - my $user = $e->retrieve_actor_user($user_id) or return $e->die_event; - return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou); - } - - for my $name (keys %$settings) { - my $val = $$settings{$name}; - my $set = $e->search_actor_user_setting({usr => $user_id, name => $name})->[0]; - - if(defined $val) { - $val = OpenSRF::Utils::JSON->perl2JSON($val); - if($set) { - $set->value($val); - $e->update_actor_user_setting($set) or return $e->die_event; - } else { - $set = Fieldmapper::actor::user_setting->new; - $set->usr($user_id); - $set->name($name); - $set->value($val); - $e->create_actor_user_setting($set) or return $e->die_event; - } - } elsif($set) { - $e->delete_actor_user_setting($set) or return $e->die_event; - } - } - - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - method => "set_ou_settings", - api_name => "open-ils.actor.org_unit.settings.update", - signature => { - desc => "Updates the value for a given org unit setting. The permission to update " . - "an org unit setting is either the UPDATE_ORG_UNIT_SETTING_ALL, or a specific " . - "permission specified in the update_perm column of the config.org_unit_setting_type " . - "table's row corresponding to the setting being changed." , - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Org unit ID', type => 'number'}, - {desc => 'Hash of setting name-value pairs', type => 'object'} - ], - return => {desc => '1 on success, Event on error'} - } -); - -sub set_ou_settings { - my( $self, $client, $auth, $org_id, $settings ) = @_; - - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - - my $all_allowed = $e->allowed("UPDATE_ORG_UNIT_SETTING_ALL", $org_id); - - for my $name (keys %$settings) { - my $val = $$settings{$name}; - - my $type = $e->retrieve_config_org_unit_setting_type([ - $name, - {flesh => 1, flesh_fields => {'coust' => ['update_perm']}} - ]) or return $e->die_event; - my $set = $e->search_actor_org_unit_setting({org_unit => $org_id, name => $name})->[0]; - - # If there is no relevant permission, the default assumption will - # be, "no, the caller cannot change that value." - return $e->die_event unless ($all_allowed || - ($type->update_perm && $e->allowed($type->update_perm->code, $org_id))); - - if(defined $val) { - $val = OpenSRF::Utils::JSON->perl2JSON($val); - if($set) { - $set->value($val); - $e->update_actor_org_unit_setting($set) or return $e->die_event; - } else { - $set = Fieldmapper::actor::org_unit_setting->new; - $set->org_unit($org_id); - $set->name($name); - $set->value($val); - $e->create_actor_org_unit_setting($set) or return $e->die_event; - } - } elsif($set) { - $e->delete_actor_org_unit_setting($set) or return $e->die_event; - } - } - - $e->commit; - return 1; -} - -__PACKAGE__->register_method( - method => "user_settings", - authoritative => 1, - api_name => "open-ils.actor.patron.settings.retrieve", -); -sub user_settings { - my( $self, $client, $auth, $user_id, $setting ) = @_; - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - $user_id = $e->requestor->id unless defined $user_id; - - my $patron = $e->retrieve_actor_user($user_id) or return $e->event; - if($e->requestor->id != $user_id) { - return $e->event unless $e->allowed('VIEW_USER', $patron->home_ou); - } - - sub get_setting { - my($e, $user_id, $setting) = @_; - my $val = $e->search_actor_user_setting({usr => $user_id, name => $setting})->[0]; - return undef unless $val; # XXX this should really return undef, but needs testing - return OpenSRF::Utils::JSON->JSON2perl($val->value); - } - - if($setting) { - if(ref $setting eq 'ARRAY') { - my %settings; - $settings{$_} = get_setting($e, $user_id, $_) for @$setting; - return \%settings; - } else { - return get_setting($e, $user_id, $setting); - } - } else { - my $s = $e->search_actor_user_setting({usr => $user_id}); - return { map { ( $_->name => OpenSRF::Utils::JSON->JSON2perl($_->value) ) } @$s }; - } -} - - -__PACKAGE__->register_method( - method => "ranged_ou_settings", - api_name => "open-ils.actor.org_unit_setting.values.ranged.retrieve", - signature => { - desc => "Retrieves all org unit settings for the given org_id, up to whatever limit " . - "is implied for retrieving OU settings by the authenticated users' permissions.", - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Org unit ID', type => 'number'}, - ], - return => {desc => 'A hashref of "ranged" settings, event on error'} - } -); -sub ranged_ou_settings { - my( $self, $client, $auth, $org_id ) = @_; - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - my %ranged_settings; - my $org_list = $U->get_org_ancestors($org_id); - my $settings = $e->search_actor_org_unit_setting({org_unit => $org_list}); - $org_list = [ reverse @$org_list ]; - - # start at the context org and capture the setting value - # without clobbering settings we've already captured - for my $this_org_id (@$org_list) { - - my @sets = grep { $_->org_unit == $this_org_id } @$settings; - - for my $set (@sets) { - my $type = $e->retrieve_config_org_unit_setting_type([ - $set->name, - {flesh => 1, flesh_fields => {coust => ['view_perm']}} - ]); - - # If there is no relevant permission, the default assumption will - # be, "yes, the caller can have that value." - if ($type && $type->view_perm) { - next if not $e->allowed($type->view_perm->code, $org_id); - } - - $ranged_settings{$set->name} = OpenSRF::Utils::JSON->JSON2perl($set->value) - unless defined $ranged_settings{$set->name}; - } - } - - return \%ranged_settings; -} - - - -__PACKAGE__->register_method( - api_name => 'open-ils.actor.ou_setting.ancestor_default', - method => 'ou_ancestor_setting', - signature => { - desc => 'Get the org unit setting value associated with the setting name as seen from the specified org unit. ' . - 'IF AND ONLY IF an authentication token is provided, this method will make sure that the given ' . - 'user has permission to view that setting, if there is a permission associated with the setting.' , - params => [ - { desc => 'Org unit ID', type => 'number' }, - { desc => 'setting name', type => 'string' }, - { desc => 'authtoken (optional)', type => 'string' } - ], - return => {desc => 'A value for the org unit setting, or undef'} - } -); - -# ------------------------------------------------------------------ -# Attempts to find the org setting value for a given org. if not -# found at the requested org, searches up the org tree until it -# finds a parent that has the requested setting. -# when found, returns { org => $id, value => $value } -# otherwise, returns NULL -# ------------------------------------------------------------------ -sub ou_ancestor_setting { - my( $self, $client, $orgid, $name, $auth ) = @_; - return $U->ou_ancestor_setting($orgid, $name, undef, $auth); -} - -__PACKAGE__->register_method( - api_name => 'open-ils.actor.ou_setting.ancestor_default.batch', - method => 'ou_ancestor_setting_batch', - signature => { - desc => 'Get org unit setting name => value pairs for a list of names, as seen from the specified org unit. ' . - 'IF AND ONLY IF an authentication token is provided, this method will make sure that the given ' . - 'user has permission to view that setting, if there is a permission associated with the setting.' , - params => [ - { desc => 'Org unit ID', type => 'number' }, - { desc => 'setting name list', type => 'array' }, - { desc => 'authtoken (optional)', type => 'string' } - ], - return => {desc => 'A hash with name => value pairs for the org unit settings'} - } -); -sub ou_ancestor_setting_batch { - my( $self, $client, $orgid, $name_list, $auth ) = @_; - my %values; - $values{$_} = $U->ou_ancestor_setting($orgid, $_, undef, $auth) for @$name_list; - return \%values; -} - - - -__PACKAGE__->register_method( - method => "update_patron", - api_name => "open-ils.actor.patron.update", - signature => { - desc => q/ - Update an existing user, or create a new one. Related objects, - like cards, addresses, survey responses, and stat cats, - can be updated by attaching them to the user object in their - respective fields. For examples, the billing address object - may be inserted into the 'billing_address' field, etc. For each - attached object, indicate if the object should be created, - updated, or deleted using the built-in 'isnew', 'ischanged', - and 'isdeleted' fields on the object. - /, - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'Patron data object', type => 'object' } - ], - return => {desc => 'A fleshed user object, event on error'} - } -); - -sub update_patron { - my( $self, $client, $user_session, $patron ) = @_; - - my $session = $apputils->start_db_session(); - - $logger->info($patron->isnew ? "Creating new patron..." : "Updating Patron: " . $patron->id); - - my( $user_obj, $evt ) = $U->checkses($user_session); - return $evt if $evt; - - $evt = check_group_perm($session, $user_obj, $patron); - return $evt if $evt; - - - # $new_patron is the patron in progress. $patron is the original patron - # passed in with the method. new_patron will change as the components - # of patron are added/updated. - - my $new_patron; - - # unflesh the real items on the patron - $patron->card( $patron->card->id ) if(ref($patron->card)); - $patron->billing_address( $patron->billing_address->id ) - if(ref($patron->billing_address)); - $patron->mailing_address( $patron->mailing_address->id ) - if(ref($patron->mailing_address)); - - # create/update the patron first so we can use his id - if($patron->isnew()) { - ( $new_patron, $evt ) = _add_patron($session, _clone_patron($patron), $user_obj); - return $evt if $evt; - } else { $new_patron = $patron; } - - ( $new_patron, $evt ) = _add_update_addresses($session, $patron, $new_patron, $user_obj); - return $evt if $evt; - - ( $new_patron, $evt ) = _add_update_cards($session, $patron, $new_patron, $user_obj); - return $evt if $evt; - - ( $new_patron, $evt ) = _add_survey_responses($session, $patron, $new_patron, $user_obj); - return $evt if $evt; - - # re-update the patron if anything has happened to him during this process - if($new_patron->ischanged()) { - ( $new_patron, $evt ) = _update_patron($session, $new_patron, $user_obj); - return $evt if $evt; - } - - ($new_patron, $evt) = _create_stat_maps($session, $user_session, $patron, $new_patron, $user_obj); - return $evt if $evt; - - ($new_patron, $evt) = _create_perm_maps($session, $user_session, $patron, $new_patron, $user_obj); - return $evt if $evt; - - $apputils->commit_db_session($session); - - $evt = apply_invalid_addr_penalty($patron); - return $evt if $evt; - - my $tses = OpenSRF::AppSession->create('open-ils.trigger'); - if($patron->isnew) { - $tses->request('open-ils.trigger.event.autocreate', 'au.create', $new_patron, $new_patron->home_ou); - } else { - $tses->request('open-ils.trigger.event.autocreate', 'au.update', $new_patron, $new_patron->home_ou); - } - - return flesh_user($new_patron->id(), new_editor(requestor => $user_obj, xact => 1)); -} - -sub apply_invalid_addr_penalty { - my $patron = shift; - my $e = new_editor(xact => 1); - - # grab the invalid address penalty if set - my $penalties = OpenILS::Utils::Penalty->retrieve_usr_penalties($e, $patron->id, $patron->home_ou); - - my ($addr_penalty) = grep - { $_->standing_penalty->name eq 'INVALID_PATRON_ADDRESS' } @$penalties; - - # do we enforce invalid address penalty - my $enforce = $U->ou_ancestor_setting_value( - $patron->home_ou, 'circ.patron_invalid_address_apply_penalty') || 0; - - my $addrs = $e->search_actor_user_address( - {usr => $patron->id, valid => 'f', id => {'>' => 0}}, {idlist => 1}); - my $addr_count = scalar(@$addrs); - - if($addr_count == 0 and $addr_penalty) { - - # regardless of any settings, remove the penalty when the user has no invalid addresses - $e->delete_actor_user_standing_penalty($addr_penalty) or return $e->die_event; - $e->commit; - - } elsif($enforce and $addr_count > 0 and !$addr_penalty) { - - my $ptype = $e->retrieve_config_standing_penalty(29) or return $e->die_event; - my $depth = $ptype->org_depth; - my $ctx_org = $U->org_unit_ancestor_at_depth($patron->home_ou, $depth) if defined $depth; - $ctx_org = $patron->home_ou unless defined $ctx_org; - - my $penalty = Fieldmapper::actor::user_standing_penalty->new; - $penalty->usr($patron->id); - $penalty->org_unit($ctx_org); - $penalty->standing_penalty(OILS_PENALTY_INVALID_PATRON_ADDRESS); - - $e->create_actor_user_standing_penalty($penalty) or return $e->die_event; - $e->commit; - - } else { - $e->rollback; - } - - return undef; -} - - -sub flesh_user { - my $id = shift; - my $e = shift; - my $home_ou = shift; - - my $fields = [ - "cards", - "card", - "standing_penalties", - "addresses", - "billing_address", - "mailing_address", - "stat_cat_entries" - ]; - push @$fields, "home_ou" if $home_ou; - return new_flesh_user($id, $fields, $e ); -} - - - - - - -# clone and clear stuff that would break the database -sub _clone_patron { - my $patron = shift; - - my $new_patron = $patron->clone; - # clear these - $new_patron->clear_billing_address(); - $new_patron->clear_mailing_address(); - $new_patron->clear_addresses(); - $new_patron->clear_card(); - $new_patron->clear_cards(); - $new_patron->clear_id(); - $new_patron->clear_isnew(); - $new_patron->clear_ischanged(); - $new_patron->clear_isdeleted(); - $new_patron->clear_stat_cat_entries(); - $new_patron->clear_permissions(); - $new_patron->clear_standing_penalties(); - - return $new_patron; -} - - -sub _add_patron { - - my $session = shift; - my $patron = shift; - my $user_obj = shift; - - my $evt = $U->check_perms($user_obj->id, $patron->home_ou, 'CREATE_USER'); - return (undef, $evt) if $evt; - - my $ex = $session->request( - 'open-ils.storage.direct.actor.user.search.usrname', $patron->usrname())->gather(1); - if( $ex and @$ex ) { - return (undef, OpenILS::Event->new('USERNAME_EXISTS')); - } - - $logger->info("Creating new user in the DB with username: ".$patron->usrname()); - - my $id = $session->request( - "open-ils.storage.direct.actor.user.create", $patron)->gather(1); - return (undef, $U->DB_UPDATE_FAILED($patron)) unless $id; - - $logger->info("Successfully created new user [$id] in DB"); - - return ( $session->request( - "open-ils.storage.direct.actor.user.retrieve", $id)->gather(1), undef ); -} - - -sub check_group_perm { - my( $session, $requestor, $patron ) = @_; - my $evt; - - # first let's see if the requestor has - # priveleges to update this user in any way - if( ! $patron->isnew ) { - my $p = $session->request( - 'open-ils.storage.direct.actor.user.retrieve', $patron->id )->gather(1); - - # If we are the requestor (trying to update our own account) - # and we are not trying to change our profile, we're good - if( $p->id == $requestor->id and - $p->profile == $patron->profile ) { - return undef; - } - - - $evt = group_perm_failed($session, $requestor, $p); - return $evt if $evt; - } - - # They are allowed to edit this patron.. can they put the - # patron into the group requested? - $evt = group_perm_failed($session, $requestor, $patron); - return $evt if $evt; - return undef; -} - - -sub group_perm_failed { - my( $session, $requestor, $patron ) = @_; - - my $perm; - my $grp; - my $grpid = $patron->profile; - - do { - - $logger->debug("user update looking for group perm for group $grpid"); - $grp = $session->request( - 'open-ils.storage.direct.permission.grp_tree.retrieve', $grpid )->gather(1); - return OpenILS::Event->new('PERMISSION_GRP_TREE_NOT_FOUND') unless $grp; - - } while( !($perm = $grp->application_perm) and ($grpid = $grp->parent) ); - - $logger->info("user update checking perm $perm on user ". - $requestor->id." for update/create on user username=".$patron->usrname); - - my $evt = $U->check_perms($requestor->id, $patron->home_ou, $perm); - return $evt if $evt; - return undef; -} - - - -sub _update_patron { - my( $session, $patron, $user_obj, $noperm) = @_; - - $logger->info("Updating patron ".$patron->id." in DB"); - - my $evt; - - if(!$noperm) { - $evt = $U->check_perms($user_obj->id, $patron->home_ou, 'UPDATE_USER'); - return (undef, $evt) if $evt; - } - - # update the password by itself to avoid the password protection magic - if( $patron->passwd ) { - my $s = $session->request( - 'open-ils.storage.direct.actor.user.remote_update', - {id => $patron->id}, {passwd => $patron->passwd})->gather(1); - return (undef, $U->DB_UPDATE_FAILED($patron)) unless defined($s); - $patron->clear_passwd; - } - - if(!$patron->ident_type) { - $patron->clear_ident_type; - $patron->clear_ident_value; - } - - $evt = verify_last_xact($session, $patron); - return (undef, $evt) if $evt; - - my $stat = $session->request( - "open-ils.storage.direct.actor.user.update",$patron )->gather(1); - return (undef, $U->DB_UPDATE_FAILED($patron)) unless defined($stat); - - return ($patron); -} - -sub verify_last_xact { - my( $session, $patron ) = @_; - return undef unless $patron->id and $patron->id > 0; - my $p = $session->request( - 'open-ils.storage.direct.actor.user.retrieve', $patron->id)->gather(1); - my $xact = $p->last_xact_id; - return undef unless $xact; - $logger->info("user xact = $xact, saving with xact " . $patron->last_xact_id); - return OpenILS::Event->new('XACT_COLLISION') - if $xact != $patron->last_xact_id; - return undef; -} - - -sub _check_dup_ident { - my( $session, $patron ) = @_; - - return undef unless $patron->ident_value; - - my $search = { - ident_type => $patron->ident_type, - ident_value => $patron->ident_value, - }; - - $logger->debug("patron update searching for dup ident values: " . - $patron->ident_type . ':' . $patron->ident_value); - - $search->{id} = {'!=' => $patron->id} if $patron->id and $patron->id > 0; - - my $dups = $session->request( - 'open-ils.storage.direct.actor.user.search_where.atomic', $search )->gather(1); - - - return OpenILS::Event->new('PATRON_DUP_IDENT1', payload => $patron ) - if $dups and @$dups; - - return undef; -} - - -sub _add_update_addresses { - - my $session = shift; - my $patron = shift; - my $new_patron = shift; - - my $evt; - - my $current_id; # id of the address before creation - - for my $address (@{$patron->addresses()}) { - - next unless ref $address; - $current_id = $address->id(); - - if( $patron->billing_address() and - $patron->billing_address() == $current_id ) { - $logger->info("setting billing addr to $current_id"); - $new_patron->billing_address($address->id()); - $new_patron->ischanged(1); - } - - if( $patron->mailing_address() and - $patron->mailing_address() == $current_id ) { - $new_patron->mailing_address($address->id()); - $logger->info("setting mailing addr to $current_id"); - $new_patron->ischanged(1); - } - - - if($address->isnew()) { - - $address->usr($new_patron->id()); - - ($address, $evt) = _add_address($session,$address); - return (undef, $evt) if $evt; - - # we need to get the new id - if( $patron->billing_address() and - $patron->billing_address() == $current_id ) { - $new_patron->billing_address($address->id()); - $logger->info("setting billing addr to $current_id"); - $new_patron->ischanged(1); - } - - if( $patron->mailing_address() and - $patron->mailing_address() == $current_id ) { - $new_patron->mailing_address($address->id()); - $logger->info("setting mailing addr to $current_id"); - $new_patron->ischanged(1); - } - - } elsif($address->ischanged() ) { - - ($address, $evt) = _update_address($session, $address); - return (undef, $evt) if $evt; - - } elsif($address->isdeleted() ) { - - if( $address->id() == $new_patron->mailing_address() ) { - $new_patron->clear_mailing_address(); - ($new_patron, $evt) = _update_patron($session, $new_patron); - return (undef, $evt) if $evt; - } - - if( $address->id() == $new_patron->billing_address() ) { - $new_patron->clear_billing_address(); - ($new_patron, $evt) = _update_patron($session, $new_patron); - return (undef, $evt) if $evt; - } - - $evt = _delete_address($session, $address); - return (undef, $evt) if $evt; - } - } - - return ( $new_patron, undef ); -} - - -# adds an address to the db and returns the address with new id -sub _add_address { - my($session, $address) = @_; - $address->clear_id(); - - $logger->info("Creating new address at street ".$address->street1); - - # put the address into the database - my $id = $session->request( - "open-ils.storage.direct.actor.user_address.create", $address )->gather(1); - return (undef, $U->DB_UPDATE_FAILED($address)) unless $id; - - $address->id( $id ); - return ($address, undef); -} - - -sub _update_address { - my( $session, $address ) = @_; - - $logger->info("Updating address ".$address->id." in the DB"); - - my $stat = $session->request( - "open-ils.storage.direct.actor.user_address.update", $address )->gather(1); - - return (undef, $U->DB_UPDATE_FAILED($address)) unless defined($stat); - return ($address, undef); -} - - - -sub _add_update_cards { - - my $session = shift; - my $patron = shift; - my $new_patron = shift; - - my $evt; - - my $virtual_id; #id of the card before creation - for my $card (@{$patron->cards()}) { - - $card->usr($new_patron->id()); - - if(ref($card) and $card->isnew()) { - - $virtual_id = $card->id(); - ( $card, $evt ) = _add_card($session,$card); - return (undef, $evt) if $evt; - - #if(ref($patron->card)) { $patron->card($patron->card->id); } - if($patron->card() == $virtual_id) { - $new_patron->card($card->id()); - $new_patron->ischanged(1); - } - - } elsif( ref($card) and $card->ischanged() ) { - $evt = _update_card($session, $card); - return (undef, $evt) if $evt; - } - } - - return ( $new_patron, undef ); -} - - -# adds an card to the db and returns the card with new id -sub _add_card { - my( $session, $card ) = @_; - $card->clear_id(); - - $logger->info("Adding new patron card ".$card->barcode); - - my $id = $session->request( - "open-ils.storage.direct.actor.card.create", $card )->gather(1); - return (undef, $U->DB_UPDATE_FAILED($card)) unless $id; - $logger->info("Successfully created patron card $id"); - - $card->id($id); - return ( $card, undef ); -} - - -# returns event on error. returns undef otherwise -sub _update_card { - my( $session, $card ) = @_; - $logger->info("Updating patron card ".$card->id); - - my $stat = $session->request( - "open-ils.storage.direct.actor.card.update", $card )->gather(1); - return $U->DB_UPDATE_FAILED($card) unless defined($stat); - return undef; -} - - - - -# returns event on error. returns undef otherwise -sub _delete_address { - my( $session, $address ) = @_; - - $logger->info("Deleting address ".$address->id." from DB"); - - my $stat = $session->request( - "open-ils.storage.direct.actor.user_address.delete", $address )->gather(1); - - return $U->DB_UPDATE_FAILED($address) unless defined($stat); - return undef; -} - - - -sub _add_survey_responses { - my ($session, $patron, $new_patron) = @_; - - $logger->info( "Updating survey responses for patron ".$new_patron->id ); - - my $responses = $patron->survey_responses; - - if($responses) { - - $_->usr($new_patron->id) for (@$responses); - - my $evt = $U->simplereq( "open-ils.circ", - "open-ils.circ.survey.submit.user_id", $responses ); - - return (undef, $evt) if defined($U->event_code($evt)); - - } - - return ( $new_patron, undef ); -} - - -sub _create_stat_maps { - - my($session, $user_session, $patron, $new_patron) = @_; - - my $maps = $patron->stat_cat_entries(); - - for my $map (@$maps) { - - my $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.update"; - - if ($map->isdeleted()) { - $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.delete"; - - } elsif ($map->isnew()) { - $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.create"; - $map->clear_id; - } - - - $map->target_usr($new_patron->id); - - #warn " - $logger->info("Updating stat entry with method $method and map $map"); - - my $stat = $session->request($method, $map)->gather(1); - return (undef, $U->DB_UPDATE_FAILED($map)) unless defined($stat); - - } - - return ($new_patron, undef); -} - -sub _create_perm_maps { - - my($session, $user_session, $patron, $new_patron) = @_; - - my $maps = $patron->permissions; - - for my $map (@$maps) { - - my $method = "open-ils.storage.direct.permission.usr_perm_map.update"; - if ($map->isdeleted()) { - $method = "open-ils.storage.direct.permission.usr_perm_map.delete"; - } elsif ($map->isnew()) { - $method = "open-ils.storage.direct.permission.usr_perm_map.create"; - $map->clear_id; - } - - - $map->usr($new_patron->id); - - #warn( "Updating permissions with method $method and session $user_session and map $map" ); - $logger->info( "Updating permissions with method $method and map $map" ); - - my $stat = $session->request($method, $map)->gather(1); - return (undef, $U->DB_UPDATE_FAILED($map)) unless defined($stat); - - } - - return ($new_patron, undef); -} - - -__PACKAGE__->register_method( - method => "set_user_work_ous", - api_name => "open-ils.actor.user.work_ous.update", -); - -sub set_user_work_ous { - my $self = shift; - my $client = shift; - my $ses = shift; - my $maps = shift; - - my( $requestor, $evt ) = $apputils->checksesperm( $ses, 'ASSIGN_WORK_ORG_UNIT' ); - return $evt if $evt; - - my $session = $apputils->start_db_session(); - - for my $map (@$maps) { - - my $method = "open-ils.storage.direct.permission.usr_work_ou_map.update"; - if ($map->isdeleted()) { - $method = "open-ils.storage.direct.permission.usr_work_ou_map.delete"; - } elsif ($map->isnew()) { - $method = "open-ils.storage.direct.permission.usr_work_ou_map.create"; - $map->clear_id; - } - - #warn( "Updating permissions with method $method and session $ses and map $map" ); - $logger->info( "Updating work_ou map with method $method and map $map" ); - - my $stat = $session->request($method, $map)->gather(1); - $logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat); - - } - - $apputils->commit_db_session($session); - - return scalar(@$maps); -} - - -__PACKAGE__->register_method( - method => "set_user_perms", - api_name => "open-ils.actor.user.permissions.update", -); - -sub set_user_perms { - my $self = shift; - my $client = shift; - my $ses = shift; - my $maps = shift; - - my $session = $apputils->start_db_session(); - - my( $user_obj, $evt ) = $U->checkses($ses); - return $evt if $evt; - - my $perms = $session->request('open-ils.storage.permission.user_perms.atomic', $user_obj->id)->gather(1); - - my $all = undef; - $all = 1 if ($U->is_true($user_obj->super_user())); - $all = 1 unless ($U->check_perms($user_obj->id, $user_obj->home_ou, 'EVERYTHING')); - - for my $map (@$maps) { - - my $method = "open-ils.storage.direct.permission.usr_perm_map.update"; - if ($map->isdeleted()) { - $method = "open-ils.storage.direct.permission.usr_perm_map.delete"; - } elsif ($map->isnew()) { - $method = "open-ils.storage.direct.permission.usr_perm_map.create"; - $map->clear_id; - } - - next if (!$all and !grep { $_->perm eq $map->perm and $U->is_true($_->grantable) and $_->depth <= $map->depth } @$perms); - #warn( "Updating permissions with method $method and session $ses and map $map" ); - $logger->info( "Updating permissions with method $method and map $map" ); - - my $stat = $session->request($method, $map)->gather(1); - $logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat); - - } - - $apputils->commit_db_session($session); - - return scalar(@$maps); -} - - -__PACKAGE__->register_method( - method => "user_retrieve_by_barcode", - authoritative => 1, - api_name => "open-ils.actor.user.fleshed.retrieve_by_barcode",); - -sub user_retrieve_by_barcode { - my($self, $client, $auth, $barcode, $flesh_home_ou) = @_; - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - my $card = $e->search_actor_card({barcode => $barcode})->[0] - or return $e->event; - - my $user = flesh_user($card->usr, $e, $flesh_home_ou); - return $e->event unless $e->allowed( - "VIEW_USER", $flesh_home_ou ? $user->home_ou->id : $user->home_ou - ); - return $user; -} - - - -__PACKAGE__->register_method( - method => "get_user_by_id", - authoritative => 1, - api_name => "open-ils.actor.user.retrieve", -); - -sub get_user_by_id { - my ($self, $client, $auth, $id) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - my $user = $e->retrieve_actor_user($id) or return $e->event; - return $e->event unless $e->allowed('VIEW_USER', $user->home_ou); - return $user; -} - - -__PACKAGE__->register_method( - method => "get_org_types", - api_name => "open-ils.actor.org_types.retrieve", -); -sub get_org_types { - return $U->get_org_types(); -} - - -__PACKAGE__->register_method( - method => "get_user_ident_types", - api_name => "open-ils.actor.user.ident_types.retrieve", -); -my $ident_types; -sub get_user_ident_types { - return $ident_types if $ident_types; - return $ident_types = - new_editor()->retrieve_all_config_identification_type(); -} - - -__PACKAGE__->register_method( - method => "get_org_unit", - api_name => "open-ils.actor.org_unit.retrieve", -); - -sub get_org_unit { - my( $self, $client, $user_session, $org_id ) = @_; - my $e = new_editor(authtoken => $user_session); - if(!$org_id) { - return $e->event unless $e->checkauth; - $org_id = $e->requestor->ws_ou; - } - my $o = $e->retrieve_actor_org_unit($org_id) - or return $e->event; - return $o; -} - -__PACKAGE__->register_method( - method => "search_org_unit", - api_name => "open-ils.actor.org_unit_list.search", -); - -sub search_org_unit { - - my( $self, $client, $field, $value ) = @_; - - my $list = OpenILS::Application::AppUtils->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.actor.org_unit.search.atomic", - { $field => $value } ); - - return $list; -} - - -# build the org tree - -__PACKAGE__->register_method( - method => "get_org_tree", - api_name => "open-ils.actor.org_tree.retrieve", - argc => 0, - note => "Returns the entire org tree structure", -); - -sub get_org_tree { - my $self = shift; - my $client = shift; - return $U->get_org_tree($client->session->session_locale); -} - - -__PACKAGE__->register_method( - method => "get_org_descendants", - api_name => "open-ils.actor.org_tree.descendants.retrieve" -); - -# depth is optional. org_unit is the id -sub get_org_descendants { - my( $self, $client, $org_unit, $depth ) = @_; - - if(ref $org_unit eq 'ARRAY') { - $depth ||= []; - my @trees; - for my $i (0..scalar(@$org_unit)-1) { - my $list = $U->simple_scalar_request( - "open-ils.storage", - "open-ils.storage.actor.org_unit.descendants.atomic", - $org_unit->[$i], $depth->[$i] ); - push(@trees, $U->build_org_tree($list)); - } - return \@trees; - - } else { - my $orglist = $apputils->simple_scalar_request( - "open-ils.storage", - "open-ils.storage.actor.org_unit.descendants.atomic", - $org_unit, $depth ); - return $U->build_org_tree($orglist); - } -} - - -__PACKAGE__->register_method( - method => "get_org_ancestors", - api_name => "open-ils.actor.org_tree.ancestors.retrieve" -); - -# depth is optional. org_unit is the id -sub get_org_ancestors { - my( $self, $client, $org_unit, $depth ) = @_; - my $orglist = $apputils->simple_scalar_request( - "open-ils.storage", - "open-ils.storage.actor.org_unit.ancestors.atomic", - $org_unit, $depth ); - return $U->build_org_tree($orglist); -} - - -__PACKAGE__->register_method( - method => "get_standings", - api_name => "open-ils.actor.standings.retrieve" -); - -my $user_standings; -sub get_standings { - return $user_standings if $user_standings; - return $user_standings = - $apputils->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.config.standing.search.atomic", - { id => { "!=" => undef } } - ); -} - - -__PACKAGE__->register_method( - method => "get_my_org_path", - api_name => "open-ils.actor.org_unit.full_path.retrieve" -); - -sub get_my_org_path { - my( $self, $client, $auth, $org_id ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - $org_id = $e->requestor->ws_ou unless defined $org_id; - - return $apputils->simple_scalar_request( - "open-ils.storage", - "open-ils.storage.actor.org_unit.full_path.atomic", - $org_id ); -} - - -__PACKAGE__->register_method( - method => "patron_adv_search", - api_name => "open-ils.actor.patron.search.advanced" -); -sub patron_adv_search { - my( $self, $client, $auth, $search_hash, - $search_limit, $search_sort, $include_inactive, $search_depth ) = @_; - - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_USER'); - return $U->storagereq( - "open-ils.storage.actor.user.crazy_search", $search_hash, - $search_limit, $search_sort, $include_inactive, $e->requestor->ws_ou, $search_depth); -} - - -__PACKAGE__->register_method( - method => "update_passwd", - api_name => "open-ils.actor.user.password.update", - signature => { - desc => "Update the operator's password", - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'New password', type => 'string' }, - { desc => 'Current password', type => 'string' } - ], - return => {desc => '1 on success, Event on error or incorrect current password'} - } -); - -__PACKAGE__->register_method( - method => "update_passwd", - api_name => "open-ils.actor.user.username.update", - signature => { - desc => "Update the operator's username", - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'New username', type => 'string' } - ], - return => {desc => '1 on success, Event on error'} - } -); - -__PACKAGE__->register_method( - method => "update_passwd", - api_name => "open-ils.actor.user.email.update", - signature => { - desc => "Update the operator's email address", - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'New email address', type => 'string' } - ], - return => {desc => '1 on success, Event on error'} - } -); - -sub update_passwd { - my( $self, $conn, $auth, $new_val, $orig_pw ) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - - my $db_user = $e->retrieve_actor_user($e->requestor->id) - or return $e->die_event; - my $api = $self->api_name; - - if( $api =~ /password/o ) { - # make sure the original password matches the in-database password - if (md5_hex($orig_pw) ne $db_user->passwd) { - $e->rollback; - return new OpenILS::Event('INCORRECT_PASSWORD'); - } - $db_user->passwd($new_val); - - } else { - - # if we don't clear the password, the user will be updated with - # a hashed version of the hashed version of their password - $db_user->clear_passwd; - - if( $api =~ /username/o ) { - - # make sure no one else has this username - my $exist = $e->search_actor_user({usrname=>$new_val},{idlist=>1}); - if (@$exist) { - $e->rollback; - return new OpenILS::Event('USERNAME_EXISTS'); - } - $db_user->usrname($new_val); - - } elsif( $api =~ /email/o ) { - $db_user->email($new_val); - } - } - - $e->update_actor_user($db_user) or return $e->die_event; - $e->commit; - return 1; -} - - - -__PACKAGE__->register_method( - method => "check_user_perms", - api_name => "open-ils.actor.user.perm.check", - notes => <<" NOTES"); - Takes a login session, user id, an org id, and an array of perm type strings. For each - perm type, if the user does *not* have the given permission it is added - to a list which is returned from the method. If all permissions - are allowed, an empty list is returned - if the logged in user does not match 'user_id', then the logged in user must - have VIEW_PERMISSION priveleges. - NOTES - -sub check_user_perms { - my( $self, $client, $login_session, $user_id, $org_id, $perm_types ) = @_; - - my( $staff, $evt ) = $apputils->checkses($login_session); - return $evt if $evt; - - if($staff->id ne $user_id) { - if( $evt = $apputils->check_perms( - $staff->id, $org_id, 'VIEW_PERMISSION') ) { - return $evt; - } - } - - my @not_allowed; - for my $perm (@$perm_types) { - if($apputils->check_perms($user_id, $org_id, $perm)) { - push @not_allowed, $perm; - } - } - - return \@not_allowed -} - -__PACKAGE__->register_method( - method => "check_user_perms2", - api_name => "open-ils.actor.user.perm.check.multi_org", - notes => q/ - Checks the permissions on a list of perms and orgs for a user - @param authtoken The login session key - @param user_id The id of the user to check - @param orgs The array of org ids - @param perms The array of permission names - @return An array of [ orgId, permissionName ] arrays that FAILED the check - if the logged in user does not match 'user_id', then the logged in user must - have VIEW_PERMISSION priveleges. - /); - -sub check_user_perms2 { - my( $self, $client, $authtoken, $user_id, $orgs, $perms ) = @_; - - my( $staff, $target, $evt ) = $apputils->checkses_requestor( - $authtoken, $user_id, 'VIEW_PERMISSION' ); - return $evt if $evt; - - my @not_allowed; - for my $org (@$orgs) { - for my $perm (@$perms) { - if($apputils->check_perms($user_id, $org, $perm)) { - push @not_allowed, [ $org, $perm ]; - } - } - } - - return \@not_allowed -} - - -__PACKAGE__->register_method( - method => 'check_user_perms3', - api_name => 'open-ils.actor.user.perm.highest_org', - notes => q/ - Returns the highest org unit id at which a user has a given permission - If the requestor does not match the target user, the requestor must have - 'VIEW_PERMISSION' rights at the home org unit of the target user - @param authtoken The login session key - @param userid The id of the user in question - @param perm The permission to check - @return The org unit highest in the org tree within which the user has - the requested permission - /); - -sub check_user_perms3 { - my($self, $client, $authtoken, $user_id, $perm) = @_; - my $e = new_editor(authtoken=>$authtoken); - return $e->event unless $e->checkauth; - - my $tree = $U->get_org_tree(); - - unless($e->requestor->id == $user_id) { - my $user = $e->retrieve_actor_user($user_id) - or return $e->event; - return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou); - return $U->find_highest_perm_org($perm, $user_id, $user->home_ou, $tree ); - } - - return $U->find_highest_perm_org($perm, $user_id, $e->requestor->ws_ou, $tree); -} - -__PACKAGE__->register_method( - method => 'user_has_work_perm_at', - api_name => 'open-ils.actor.user.has_work_perm_at', - authoritative => 1, - signature => { - desc => q/ - Returns a set of org unit IDs which represent the highest orgs in - the org tree where the user has the requested permission. The - purpose of this method is to return the smallest set of org units - which represent the full expanse of the user's ability to perform - the requested action. The user whose perms this method should - check is implied by the authtoken. /, - params => [ - {desc => 'authtoken', type => 'string'}, - {desc => 'permission name', type => 'string'}, - {desc => q/user id, optional. If present, check perms for - this user instead of the logged in user/, type => 'number'}, - ], - return => {desc => 'An array of org IDs'} - } -); - -sub user_has_work_perm_at { - my($self, $conn, $auth, $perm, $user_id) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - if(defined $user_id) { - my $user = $e->retrieve_actor_user($user_id) or return $e->event; - return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou); - } - return $U->user_has_work_perm_at($e, $perm, undef, $user_id); -} - -__PACKAGE__->register_method( - method => 'user_has_work_perm_at_batch', - api_name => 'open-ils.actor.user.has_work_perm_at.batch', - authoritative => 1, -); - -sub user_has_work_perm_at_batch { - my($self, $conn, $auth, $perms, $user_id) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - if(defined $user_id) { - my $user = $e->retrieve_actor_user($user_id) or return $e->event; - return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou); - } - my $map = {}; - $map->{$_} = $U->user_has_work_perm_at($e, $_) for @$perms; - return $map; -} - - - -__PACKAGE__->register_method( - method => 'check_user_perms4', - api_name => 'open-ils.actor.user.perm.highest_org.batch', - notes => q/ - Returns the highest org unit id at which a user has a given permission - If the requestor does not match the target user, the requestor must have - 'VIEW_PERMISSION' rights at the home org unit of the target user - @param authtoken The login session key - @param userid The id of the user in question - @param perms An array of perm names to check - @return An array of orgId's representing the org unit - highest in the org tree within which the user has the requested permission - The arrah of orgId's has matches the order of the perms array - /); - -sub check_user_perms4 { - my( $self, $client, $authtoken, $userid, $perms ) = @_; - - my( $staff, $target, $org, $evt ); - - ( $staff, $target, $evt ) = $apputils->checkses_requestor( - $authtoken, $userid, 'VIEW_PERMISSION' ); - return $evt if $evt; - - my @arr; - return [] unless ref($perms); - my $tree = $U->get_org_tree(); - - for my $p (@$perms) { - push( @arr, $U->find_highest_perm_org( $p, $userid, $target->home_ou, $tree ) ); - } - return \@arr; -} - - -__PACKAGE__->register_method( - method => "user_fines_summary", - api_name => "open-ils.actor.user.fines.summary", - authoritative => 1, - signature => { - desc => 'Returns a short summary of the users total open fines, ' . - 'excluding voided fines Params are login_session, user_id' , - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'User ID', type => 'string'} # number? - ], - return => { - desc => "a 'mous' object, event on error", - } - } -); - -sub user_fines_summary { - my( $self, $client, $auth, $user_id ) = @_; - - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - if( $user_id ne $e->requestor->id ) { - my $user = $e->retrieve_actor_user($user_id) or return $e->event; - return $e->event unless - $e->allowed('VIEW_USER_FINES_SUMMARY', $user->home_ou); - } - - return $e->search_money_open_user_summary({usr => $user_id})->[0]; -} - - -__PACKAGE__->register_method( - method => "user_opac_vitals", - api_name => "open-ils.actor.user.opac.vital_stats", - argc => 1, - authoritative => 1, - signature => { - desc => 'Returns a short summary of the users vital stats, including ' . - 'identification information, accumulated balance, number of holds, ' . - 'and current open circulation stats' , - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Optional User ID, for use in the staff client', type => 'number'} # number? - ], - return => { - desc => "An object with four properties: user, fines, checkouts and holds." - } - } -); - -sub user_opac_vitals { - my( $self, $client, $auth, $user_id ) = @_; - - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - $user_id ||= $e->requestor->id; - - my $user = $e->retrieve_actor_user( $user_id ); - - my ($fines) = $self - ->method_lookup('open-ils.actor.user.fines.summary') - ->run($auth => $user_id); - return $fines if (defined($U->event_code($fines))); - - if (!$fines) { - $fines = new Fieldmapper::money::open_user_summary (); - $fines->balance_owed(0.00); - $fines->total_owed(0.00); - $fines->total_paid(0.00); - $fines->usr($user_id); - } - - my ($holds) = $self - ->method_lookup('open-ils.actor.user.hold_requests.count') - ->run($auth => $user_id); - return $holds if (defined($U->event_code($holds))); - - my ($out) = $self - ->method_lookup('open-ils.actor.user.checked_out.count') - ->run($auth => $user_id); - return $out if (defined($U->event_code($out))); - - return { - user => { - first_given_name => $user->first_given_name, - second_given_name => $user->second_given_name, - family_name => $user->family_name, - alias => $user->alias, - usrname => $user->usrname - }, - fines => $fines->to_bare_hash, - checkouts => $out, - holds => $holds - }; -} - - -##### a small consolidation of related method registrations -my $common_params = [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'User ID', type => 'string' }, - { desc => 'Transactions type (optional, defaults to all)', type => 'string' }, - { desc => 'Options hash. May contain limit and offset for paged results.', type => 'object' }, -]; -my %methods = ( - 'open-ils.actor.user.transactions' => '', - 'open-ils.actor.user.transactions.fleshed' => '', - 'open-ils.actor.user.transactions.have_charge' => ' that have an initial charge', - 'open-ils.actor.user.transactions.have_charge.fleshed' => ' that have an initial charge', - 'open-ils.actor.user.transactions.have_balance' => ' that have an outstanding balance', - 'open-ils.actor.user.transactions.have_balance.fleshed' => ' that have an outstanding balance', -); - -foreach (keys %methods) { - my %args = ( - method => "user_transactions", - api_name => $_, - signature => { - desc => 'For a given user, retrieve a list of ' - . (/\.fleshed/ ? 'fleshed ' : '') - . 'transactions' . $methods{$_} - . ' optionally limited to transactions of a given type.', - params => $common_params, - return => { - desc => "List of objects, or event on error. Each object is a hash containing: transaction, circ, record. " - . 'These represent the relevant (mbts) transaction, attached circulation and title pointed to in the circ, respectively.', - } - } - ); - /\.have_balance/ and $args{authoritative} = 1; # FIXME: I don't know why have_charge isn't authoritative - __PACKAGE__->register_method(%args); -} - -# Now for the counts -%methods = ( - 'open-ils.actor.user.transactions.count' => '', - 'open-ils.actor.user.transactions.have_charge.count' => ' that have an initial charge', - 'open-ils.actor.user.transactions.have_balance.count' => ' that have an outstanding balance', -); - -foreach (keys %methods) { - my %args = ( - method => "user_transactions", - api_name => $_, - signature => { - desc => 'For a given user, retrieve a count of open ' - . 'transactions' . $methods{$_} - . ' optionally limited to transactions of a given type.', - params => $common_params, - return => { desc => "Integer count of transactions, or event on error" } - } - ); - /\.have_balance/ and $args{authoritative} = 1; # FIXME: I don't know why have_charge isn't authoritative - __PACKAGE__->register_method(%args); -} - -__PACKAGE__->register_method( - method => "user_transactions", - api_name => "open-ils.actor.user.transactions.have_balance.total", - authoritative => 1, - signature => { - desc => 'For a given user, retrieve the total balance owed for open transactions,' - . ' optionally limited to transactions of a given type.', - params => $common_params, - return => { desc => "Decimal balance value, or event on error" } - } -); - - -sub user_transactions { - my( $self, $client, $login_session, $user_id, $type, $options ) = @_; - $options ||= {}; - - my( $user_obj, $target, $evt ) = $apputils->checkses_requestor( - $login_session, $user_id, 'VIEW_USER_TRANSACTIONS' ); - return $evt if $evt; - - my $api = $self->api_name(); - - my $filter = ($api =~ /have_balance/o) ? - { 'balance_owed' => { '<>' => 0 } }: - { 'total_owed' => { '>' => 0 } }; - - my ($trans) = $self->method_lookup( - 'open-ils.actor.user.transactions.history.still_open') - ->run( $login_session, $user_id, $type, $filter, $options ); - - if($api =~ /total/o) { - my $total = 0.0; - for my $t (@$trans) { - $total += $t->balance_owed; - } - - $logger->debug("Total balance owed by user $user_id: $total"); - return $total; - } - - ($api =~ /count/o ) and return scalar @$trans; - ($api !~ /fleshed/o) and return $trans; - - my @resp; - for my $t (@$trans) { - - if( $t->xact_type ne 'circulation' ) { - push @resp, {transaction => $t}; - next; - } - - my $circ = $apputils->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.action.circulation.retrieve", - $t->id ); - - next unless $circ; - - my $title = $apputils->simple_scalar_request( - "open-ils.storage", - "open-ils.storage.fleshed.biblio.record_entry.retrieve_by_copy", - $circ->target_copy ); - - next unless $title; - - my $u = OpenILS::Utils::ModsParser->new(); - $u->start_mods_batch($title->marc()); - my $mods = $u->finish_mods_batch(); - $mods->doc_id($title->id) if $mods; - - push @resp, {transaction => $t, circ => $circ, record => $mods }; - - } - - return \@resp; -} - - -__PACKAGE__->register_method( - method => "user_transaction_retrieve", - api_name => "open-ils.actor.user.transaction.fleshed.retrieve", - argc => 1, - notes => "Returns a fleshed transaction record" -); - -__PACKAGE__->register_method( - method => "user_transaction_retrieve", - api_name => "open-ils.actor.user.transaction.retrieve", - argc => 1, - notes => "Returns a transaction record" -); - -sub user_transaction_retrieve { - my( $self, $client, $login_session, $bill_id ) = @_; - - # I think I'm deprecated... make sure. phasefx says, "No, I'll use you :) - - my $trans = $apputils->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.money.billable_transaction_summary.retrieve", - $bill_id - ); - - my( $user_obj, $target, $evt ) = $apputils->checkses_requestor( - $login_session, $trans->usr, 'VIEW_USER_TRANSACTIONS' ); - return $evt if $evt; - - my $api = $self->api_name(); - if($api !~ /fleshed/o) { return $trans; } - - if( $trans->xact_type ne 'circulation' ) { - $logger->debug("Returning non-circ transaction"); - return {transaction => $trans}; - } - - my $circ = $apputils->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.action.circulation.retrieve", - $trans->id ); - - return {transaction => $trans} unless $circ; - $logger->debug("Found the circ transaction"); - - my $title = $apputils->simple_scalar_request( - "open-ils.storage", - "open-ils.storage.fleshed.biblio.record_entry.retrieve_by_copy", - $circ->target_copy ); - - return {transaction => $trans, circ => $circ } unless $title; - $logger->debug("Found the circ title"); - - my $mods; - my $copy = $apputils->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.asset.copy.retrieve", - $circ->target_copy ); - - try { - my $u = OpenILS::Utils::ModsParser->new(); - $u->start_mods_batch($title->marc()); - $mods = $u->finish_mods_batch(); - } otherwise { - if ($title->id == OILS_PRECAT_RECORD) { - $mods = new Fieldmapper::metabib::virtual_record; - $mods->doc_id(OILS_PRECAT_RECORD); - $mods->title($copy->dummy_title); - $mods->author($copy->dummy_author); - } - }; - - $logger->debug("MODSized the circ title"); - - return {transaction => $trans, circ => $circ, record => $mods, copy => $copy }; -} - - -__PACKAGE__->register_method( - method => "hold_request_count", - api_name => "open-ils.actor.user.hold_requests.count", - authoritative => 1, - argc => 1, - notes => 'Returns hold ready/total counts' -); - -sub hold_request_count { - my( $self, $client, $login_session, $userid ) = @_; - - my( $user_obj, $target, $evt ) = $apputils->checkses_requestor( - $login_session, $userid, 'VIEW_HOLD' ); - return $evt if $evt; - - - my $holds = $apputils->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.action.hold_request.search.atomic", - { - usr => $userid, - fulfillment_time => {"=" => undef }, - cancel_time => undef, - } - ); - - my @ready; - for my $h (@$holds) { - next unless $h->capture_time and $h->current_copy; - - my $copy = $apputils->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.asset.copy.retrieve", - $h->current_copy - ); - - if ($copy and $copy->status == 8) { - push @ready, $h; - } - } - - return { total => scalar(@$holds), ready => scalar(@ready) }; -} - -__PACKAGE__->register_method( - method => "checked_out", - api_name => "open-ils.actor.user.checked_out", - authoritative => 1, - argc => 2, - signature => { - desc => "For a given user, returns a structure of circulations objects sorted by out, overdue, lost, claims_returned, long_overdue. " - . "A list of IDs are returned of each type. Circs marked lost, long_overdue, and claims_returned will not be 'finished' " - . "(i.e., outstanding balance or some other pending action on the circ). " - . "The .count method also includes a 'total' field which sums all open circs.", - params => [ - { desc => 'Authentication Token', type => 'string'}, - { desc => 'User ID', type => 'string'}, - ], - return => { - desc => 'Returns event on error, or an object with ID lists, like: ' - . '{"out":[12552,451232], "claims_returned":[], "long_overdue":[23421] "overdue":[], "lost":[]}' - }, - } -); - -__PACKAGE__->register_method( - method => "checked_out", - api_name => "open-ils.actor.user.checked_out.count", - authoritative => 1, - argc => 2, - signature => q/@see open-ils.actor.user.checked_out/ -); - -sub checked_out { - my( $self, $conn, $auth, $userid ) = @_; - - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - if( $userid ne $e->requestor->id ) { - my $user = $e->retrieve_actor_user($userid) or return $e->event; - unless($e->allowed('VIEW_CIRCULATIONS', $user->home_ou)) { - - # see if there is a friend link allowing circ.view perms - my $allowed = OpenILS::Application::Actor::Friends->friend_perm_allowed( - $e, $userid, $e->requestor->id, 'circ.view'); - return $e->event unless $allowed; - } - } - - my $count = $self->api_name =~ /count/; - return _checked_out( $count, $e, $userid ); -} - -sub _checked_out { - my( $iscount, $e, $userid ) = @_; - - my %result = ( - out => [], - overdue => [], - lost => [], - claims_returned => [], - long_overdue => [] - ); - my $meth = 'retrieve_action_open_circ_'; - - if ($iscount) { - $meth .= 'count'; - %result = ( - out => 0, - overdue => 0, - lost => 0, - claims_returned => 0, - long_overdue => 0 - ); - } else { - $meth .= 'list'; - } - - my $data = $e->$meth($userid); - - if ($data) { - if ($iscount) { - $result{$_} += $data->$_() for (keys %result); - $result{total} += $data->$_() for (keys %result); - } else { - for my $k (keys %result) { - $result{$k} = [ grep { $_ > 0 } split( ',', $data->$k()) ]; - } - } - } - - return \%result; -} - - - -__PACKAGE__->register_method( - method => "checked_in_with_fines", - api_name => "open-ils.actor.user.checked_in_with_fines", - authoritative => 1, - argc => 2, - signature => q/@see open-ils.actor.user.checked_out/ -); - -sub checked_in_with_fines { - my( $self, $conn, $auth, $userid ) = @_; - - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - if( $userid ne $e->requestor->id ) { - return $e->event unless $e->allowed('VIEW_CIRCULATIONS'); - } - - # money is owed on these items and they are checked in - my $open = $e->search_action_circulation( - { - usr => $userid, - xact_finish => undef, - checkin_time => { "!=" => undef }, - } - ); - - - my( @lost, @cr, @lo ); - for my $c (@$open) { - push( @lost, $c->id ) if $c->stop_fines eq 'LOST'; - push( @cr, $c->id ) if $c->stop_fines eq 'CLAIMSRETURNED'; - push( @lo, $c->id ) if $c->stop_fines eq 'LONGOVERDUE'; - } - - return { - lost => \@lost, - claims_returned => \@cr, - long_overdue => \@lo - }; -} - - -sub _sigmaker { - my ($api, $desc, $auth) = @_; - $desc = $desc ? (" " . $desc) : ''; - my $ids = ($api =~ /ids$/) ? 1 : 0; - my @sig = ( - argc => 1, - method => "user_transaction_history", - api_name => "open-ils.actor.user.transactions.$api", - signature => { - desc => "For a given User ID, returns a list of billable transaction" . - ($ids ? " id" : '') . - "s$desc, optionally filtered by type and/or fields in money.billable_xact_summary. " . - "The VIEW_USER_TRANSACTIONS permission is required to view another user's transactions", - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'User ID', type => 'number'}, - {desc => 'Transaction type (optional)', type => 'number'}, - {desc => 'Hash of Billable Transaction Summary filters (optional)', type => 'object'} - ], - return => { - desc => 'List of transaction' . ($ids ? " id" : '') . 's, Event on error' - }, - } - ); - $auth and push @sig, (authoritative => 1); - return @sig; -} - -my %hist_methods = ( - 'history' => '', - 'history.have_charge' => 'that have an initial charge', - 'history.still_open' => 'that are not finished', -); -my %auth_hist_methods = ( - 'history.have_balance' => 'that have a balance', - 'history.have_bill' => 'that have billings', - 'history.have_bill_or_payment' => 'that have non-zero-sum billings or at least 1 payment', -); -foreach (keys %hist_methods) { - __PACKAGE__->register_method(_sigmaker($_, $hist_methods{$_})); - __PACKAGE__->register_method(_sigmaker("$_.ids", $hist_methods{$_})); -} -foreach (keys %auth_hist_methods) { - __PACKAGE__->register_method(_sigmaker($_, $auth_hist_methods{$_}, 1)); - __PACKAGE__->register_method(_sigmaker("$_.ids", $auth_hist_methods{$_}, 1)); -} - -sub user_transaction_history { - my( $self, $conn, $auth, $userid, $type, $filter, $options ) = @_; - $filter ||= {}; - $options ||= {}; - - my $e = new_editor(authtoken=>$auth); - return $e->die_event unless $e->checkauth; - - if ($e->requestor->id ne $userid) { - return $e->die_event unless $e->allowed('VIEW_USER_TRANSACTIONS'); - } - - my $api = $self->api_name; - my @xact_finish = (xact_finish => undef ) if ($api =~ /history\.still_open$/); # What about history.still_open.ids? - - if(defined($type)) { - $filter->{'xact_type'} = $type; - } - - if($api =~ /have_bill_or_payment/o) { - - # transactions that have a non-zero sum across all billings or at least 1 payment - $filter->{'-or'} = { - 'balance_owed' => { '<>' => 0 }, - 'last_payment_ts' => { '<>' => undef } - }; - - } elsif( $api =~ /have_balance/o) { - - # transactions that have a non-zero overall balance - $filter->{'balance_owed'} = { '<>' => 0 }; - - } elsif( $api =~ /have_charge/o) { - - # transactions that have at least 1 billing, regardless of whether it was voided - $filter->{'last_billing_ts'} = { '<>' => undef }; - - } elsif( $api =~ /have_bill/o) { # needs to be an elsif, or we double-match have_bill_or_payment! - - # transactions that have non-zero sum across all billings. This will exclude - # xacts where all billings have been voided - $filter->{'total_owed'} = { '<>' => 0 }; - } - - my $options_clause = { order_by => { mbt => 'xact_start DESC' } }; - $options_clause->{'limit'} = $options->{'limit'} if $options->{'limit'}; - $options_clause->{'offset'} = $options->{'offset'} if $options->{'offset'}; - - my $mbts = $e->search_money_billable_transaction_summary( - [ - { usr => $userid, @xact_finish, %$filter }, - $options_clause - ] - ); - - if ($api =~ /\.ids/) { - return [map {$_->id} @$mbts]; - } else { - return $mbts; - } -} - - - -__PACKAGE__->register_method( - method => "user_perms", - api_name => "open-ils.actor.permissions.user_perms.retrieve", - argc => 1, - notes => "Returns a list of permissions" -); - -sub user_perms { - my( $self, $client, $authtoken, $user ) = @_; - - my( $staff, $evt ) = $apputils->checkses($authtoken); - return $evt if $evt; - - $user ||= $staff->id; - - if( $user != $staff->id and $evt = $apputils->check_perms( $staff->id, $staff->home_ou, 'VIEW_PERMISSION') ) { - return $evt; - } - - return $apputils->simple_scalar_request( - "open-ils.storage", - "open-ils.storage.permission.user_perms.atomic", - $user); -} - -__PACKAGE__->register_method( - method => "retrieve_perms", - api_name => "open-ils.actor.permissions.retrieve", - notes => "Returns a list of permissions" -); -sub retrieve_perms { - my( $self, $client ) = @_; - return $apputils->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.permission.perm_list.search.atomic", - { id => { '!=' => undef } } - ); -} - -__PACKAGE__->register_method( - method => "retrieve_groups", - api_name => "open-ils.actor.groups.retrieve", - notes => "Returns a list of user groups" -); -sub retrieve_groups { - my( $self, $client ) = @_; - return new_editor()->retrieve_all_permission_grp_tree(); -} - -__PACKAGE__->register_method( - method => "retrieve_org_address", - api_name => "open-ils.actor.org_unit.address.retrieve", - notes => <<' NOTES'); - Returns an org_unit address by ID - @param An org_address ID - NOTES -sub retrieve_org_address { - my( $self, $client, $id ) = @_; - return $apputils->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.actor.org_address.retrieve", - $id - ); -} - -__PACKAGE__->register_method( - method => "retrieve_groups_tree", - api_name => "open-ils.actor.groups.tree.retrieve", - notes => "Returns a list of user groups" -); - -sub retrieve_groups_tree { - my( $self, $client ) = @_; - return new_editor()->search_permission_grp_tree( - [ - { parent => undef}, - { - flesh => -1, - flesh_fields => { pgt => ["children"] }, - order_by => { pgt => 'name'} - } - ] - )->[0]; -} - - -__PACKAGE__->register_method( - method => "add_user_to_groups", - api_name => "open-ils.actor.user.set_groups", - notes => "Adds a user to one or more permission groups" -); - -sub add_user_to_groups { - my( $self, $client, $authtoken, $userid, $groups ) = @_; - - my( $requestor, $target, $evt ) = $apputils->checkses_requestor( - $authtoken, $userid, 'CREATE_USER_GROUP_LINK' ); - return $evt if $evt; - - ( $requestor, $target, $evt ) = $apputils->checkses_requestor( - $authtoken, $userid, 'REMOVE_USER_GROUP_LINK' ); - return $evt if $evt; - - $apputils->simplereq( - 'open-ils.storage', - 'open-ils.storage.direct.permission.usr_grp_map.mass_delete', { usr => $userid } ); - - for my $group (@$groups) { - my $link = Fieldmapper::permission::usr_grp_map->new; - $link->grp($group); - $link->usr($userid); - - my $id = $apputils->simplereq( - 'open-ils.storage', - 'open-ils.storage.direct.permission.usr_grp_map.create', $link ); - } - - return 1; -} - -__PACKAGE__->register_method( - method => "get_user_perm_groups", - api_name => "open-ils.actor.user.get_groups", - notes => "Retrieve a user's permission groups." -); - - -sub get_user_perm_groups { - my( $self, $client, $authtoken, $userid ) = @_; - - my( $requestor, $target, $evt ) = $apputils->checkses_requestor( - $authtoken, $userid, 'VIEW_PERM_GROUPS' ); - return $evt if $evt; - - return $apputils->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.permission.usr_grp_map.search.atomic', { usr => $userid } ); -} - - -__PACKAGE__->register_method( - method => "get_user_work_ous", - api_name => "open-ils.actor.user.get_work_ous", - notes => "Retrieve a user's work org units." -); - -__PACKAGE__->register_method( - method => "get_user_work_ous", - api_name => "open-ils.actor.user.get_work_ous.ids", - notes => "Retrieve a user's work org units." -); - -sub get_user_work_ous { - my( $self, $client, $auth, $userid ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - $userid ||= $e->requestor->id; - - if($e->requestor->id != $userid) { - my $user = $e->retrieve_actor_user($userid) - or return $e->event; - return $e->event unless $e->allowed('ASSIGN_WORK_ORG_UNIT', $user->home_ou); - } - - return $e->search_permission_usr_work_ou_map({usr => $userid}) - unless $self->api_name =~ /.ids$/; - - # client just wants a list of org IDs - return $U->get_user_work_ou_ids($e, $userid); -} - - - -__PACKAGE__->register_method( - method => 'register_workstation', - api_name => 'open-ils.actor.workstation.register.override', - signature => q/@see open-ils.actor.workstation.register/ -); - -__PACKAGE__->register_method( - method => 'register_workstation', - api_name => 'open-ils.actor.workstation.register', - signature => q/ - Registers a new workstion in the system - @param authtoken The login session key - @param name The name of the workstation id - @param owner The org unit that owns this workstation - @return The workstation id on success, WORKSTATION_NAME_EXISTS - if the name is already in use. - / -); - -sub register_workstation { - my( $self, $conn, $authtoken, $name, $owner ) = @_; - - my $e = new_editor(authtoken=>$authtoken, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('REGISTER_WORKSTATION', $owner); - my $existing = $e->search_actor_workstation({name => $name})->[0]; - - if( $existing ) { - - if( $self->api_name =~ /override/o ) { - # workstation with the given name exists. - - if($owner ne $existing->owning_lib) { - # if necessary, update the owning_lib of the workstation - - $logger->info("changing owning lib of workstation ".$existing->id. - " from ".$existing->owning_lib." to $owner"); - return $e->die_event unless - $e->allowed('UPDATE_WORKSTATION', $existing->owning_lib); - - return $e->die_event unless $e->allowed('UPDATE_WORKSTATION', $owner); - - $existing->owning_lib($owner); - return $e->die_event unless $e->update_actor_workstation($existing); - - $e->commit; - - } else { - $logger->info( - "attempt to register an existing workstation. returning existing ID"); - } - - return $existing->id; - - } else { - return OpenILS::Event->new('WORKSTATION_NAME_EXISTS') - } - } - - my $ws = Fieldmapper::actor::workstation->new; - $ws->owning_lib($owner); - $ws->name($name); - $e->create_actor_workstation($ws) or return $e->die_event; - $e->commit; - return $ws->id; # note: editor sets the id on the new object for us -} - -__PACKAGE__->register_method( - method => 'workstation_list', - api_name => 'open-ils.actor.workstation.list', - signature => q/ - Returns a list of workstations registered at the given location - @param authtoken The login session key - @param ids A list of org_unit.id's for the workstation owners - / -); - -sub workstation_list { - my( $self, $conn, $authtoken, @orgs ) = @_; - - my $e = new_editor(authtoken=>$authtoken); - return $e->event unless $e->checkauth; - my %results; - - for my $o (@orgs) { - return $e->event - unless $e->allowed('REGISTER_WORKSTATION', $o); - $results{$o} = $e->search_actor_workstation({owning_lib=>$o}); - } - return \%results; -} - - -__PACKAGE__->register_method( - method => 'fetch_patron_note', - api_name => 'open-ils.actor.note.retrieve.all', - authoritative => 1, - signature => q/ - Returns a list of notes for a given user - Requestor must have VIEW_USER permission if pub==false and - @param authtoken The login session key - @param args Hash of params including - patronid : the patron's id - pub : true if retrieving only public notes - / -); - -sub fetch_patron_note { - my( $self, $conn, $authtoken, $args ) = @_; - my $patronid = $$args{patronid}; - - my($reqr, $evt) = $U->checkses($authtoken); - return $evt if $evt; - - my $patron; - ($patron, $evt) = $U->fetch_user($patronid); - return $evt if $evt; - - if($$args{pub}) { - if( $patronid ne $reqr->id ) { - $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER'); - return $evt if $evt; - } - return $U->cstorereq( - 'open-ils.cstore.direct.actor.usr_note.search.atomic', - { usr => $patronid, pub => 't' } ); - } - - $evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER'); - return $evt if $evt; - - return $U->cstorereq( - 'open-ils.cstore.direct.actor.usr_note.search.atomic', { usr => $patronid } ); -} - -__PACKAGE__->register_method( - method => 'create_user_note', - api_name => 'open-ils.actor.note.create', - signature => q/ - Creates a new note for the given user - @param authtoken The login session key - @param note The note object - / -); -sub create_user_note { - my( $self, $conn, $authtoken, $note ) = @_; - my $e = new_editor(xact=>1, authtoken=>$authtoken); - return $e->die_event unless $e->checkauth; - - my $user = $e->retrieve_actor_user($note->usr) - or return $e->die_event; - - return $e->die_event unless - $e->allowed('UPDATE_USER',$user->home_ou); - - $note->creator($e->requestor->id); - $e->create_actor_usr_note($note) or return $e->die_event; - $e->commit; - return $note->id; -} - - -__PACKAGE__->register_method( - method => 'delete_user_note', - api_name => 'open-ils.actor.note.delete', - signature => q/ - Deletes a note for the given user - @param authtoken The login session key - @param noteid The note id - / -); -sub delete_user_note { - my( $self, $conn, $authtoken, $noteid ) = @_; - - my $e = new_editor(xact=>1, authtoken=>$authtoken); - return $e->die_event unless $e->checkauth; - my $note = $e->retrieve_actor_usr_note($noteid) - or return $e->die_event; - my $user = $e->retrieve_actor_user($note->usr) - or return $e->die_event; - return $e->die_event unless - $e->allowed('UPDATE_USER', $user->home_ou); - - $e->delete_actor_usr_note($note) or return $e->die_event; - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - method => 'update_user_note', - api_name => 'open-ils.actor.note.update', - signature => q/ - @param authtoken The login session key - @param note The note - / -); - -sub update_user_note { - my( $self, $conn, $auth, $note ) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - my $patron = $e->retrieve_actor_user($note->usr) - or return $e->die_event; - return $e->die_event unless - $e->allowed('UPDATE_USER', $patron->home_ou); - $e->update_actor_user_note($note) - or return $e->die_event; - $e->commit; - return 1; -} - - - -__PACKAGE__->register_method( - method => 'create_closed_date', - api_name => 'open-ils.actor.org_unit.closed_date.create', - signature => q/ - Creates a new closing entry for the given org_unit - @param authtoken The login session key - @param note The closed_date object - / -); -sub create_closed_date { - my( $self, $conn, $authtoken, $cd ) = @_; - - my( $user, $evt ) = $U->checkses($authtoken); - return $evt if $evt; - - $evt = $U->check_perms($user->id, $cd->org_unit, 'CREATE_CLOSEING'); - return $evt if $evt; - - $logger->activity("user ".$user->id." creating library closing for ".$cd->org_unit); - - my $id = $U->storagereq( - 'open-ils.storage.direct.actor.org_unit.closed_date.create', $cd ); - return $U->DB_UPDATE_FAILED($cd) unless $id; - return $id; -} - - -__PACKAGE__->register_method( - method => 'delete_closed_date', - api_name => 'open-ils.actor.org_unit.closed_date.delete', - signature => q/ - Deletes a closing entry for the given org_unit - @param authtoken The login session key - @param noteid The close_date id - / -); -sub delete_closed_date { - my( $self, $conn, $authtoken, $cd ) = @_; - - my( $user, $evt ) = $U->checkses($authtoken); - return $evt if $evt; - - my $cd_obj; - ($cd_obj, $evt) = fetch_closed_date($cd); - return $evt if $evt; - - $evt = $U->check_perms($user->id, $cd->org_unit, 'DELETE_CLOSEING'); - return $evt if $evt; - - $logger->activity("user ".$user->id." deleting library closing for ".$cd->org_unit); - - my $stat = $U->storagereq( - 'open-ils.storage.direct.actor.org_unit.closed_date.delete', $cd ); - return $U->DB_UPDATE_FAILED($cd) unless $stat; - return $stat; -} - - -__PACKAGE__->register_method( - method => 'usrname_exists', - api_name => 'open-ils.actor.username.exists', - signature => { - desc => 'Check if a username is already taken (by an undeleted patron)', - param => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Username', type => 'string'} - ], - return => { - desc => 'id of existing user if username exists, undef otherwise. Event on error' - }, - } -); - -sub usrname_exists { - my( $self, $conn, $auth, $usrname ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - my $a = $e->search_actor_user({usrname => $usrname, deleted=>'f'}, {idlist=>1}); - return $$a[0] if $a and @$a; - return undef; -} - -__PACKAGE__->register_method( - method => 'barcode_exists', - api_name => 'open-ils.actor.barcode.exists', - authoritative => 1, - signature => 'Returns 1 if the requested barcode exists, returns 0 otherwise' -); - -sub barcode_exists { - my( $self, $conn, $auth, $barcode ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - my $card = $e->search_actor_card({barcode => $barcode}); - if (@$card) { - return 1; - } else { - return 0; - } - #return undef unless @$card; - #return $card->[0]->usr; -} - - -__PACKAGE__->register_method( - method => 'retrieve_net_levels', - api_name => 'open-ils.actor.net_access_level.retrieve.all', -); - -sub retrieve_net_levels { - my( $self, $conn, $auth ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->retrieve_all_config_net_access_level(); -} - -# Retain the old typo API name just in case -__PACKAGE__->register_method( - method => 'fetch_org_by_shortname', - api_name => 'open-ils.actor.org_unit.retrieve_by_shorname', -); -__PACKAGE__->register_method( - method => 'fetch_org_by_shortname', - api_name => 'open-ils.actor.org_unit.retrieve_by_shortname', -); -sub fetch_org_by_shortname { - my( $self, $conn, $sname ) = @_; - my $e = new_editor(); - my $org = $e->search_actor_org_unit({ shortname => uc($sname)})->[0]; - return $e->event unless $org; - return $org; -} - - -__PACKAGE__->register_method( - method => 'session_home_lib', - api_name => 'open-ils.actor.session.home_lib', -); - -sub session_home_lib { - my( $self, $conn, $auth ) = @_; - my $e = new_editor(authtoken=>$auth); - return undef unless $e->checkauth; - my $org = $e->retrieve_actor_org_unit($e->requestor->home_ou); - return $org->shortname; -} - -__PACKAGE__->register_method( - method => 'session_safe_token', - api_name => 'open-ils.actor.session.safe_token', - signature => q/ - Returns a hashed session ID that is safe for export to the world. - This safe token will expire after 1 hour of non-use. - @param auth Active authentication token - / -); - -sub session_safe_token { - my( $self, $conn, $auth ) = @_; - my $e = new_editor(authtoken=>$auth); - return undef unless $e->checkauth; - - my $safe_token = md5_hex($auth); - - $cache ||= OpenSRF::Utils::Cache->new("global", 0); - - # Add more like the following if needed... - $cache->put_cache( - "safe-token-home_lib-shortname-$safe_token", - $e->retrieve_actor_org_unit( - $e->requestor->home_ou - )->shortname, - 60 * 60 - ); - - return $safe_token; -} - - -__PACKAGE__->register_method( - method => 'safe_token_home_lib', - api_name => 'open-ils.actor.safe_token.home_lib.shortname', - signature => q/ - Returns the home library shortname from the session - asscociated with a safe token from generated by - open-ils.actor.session.safe_token. - @param safe_token Active safe token - / -); - -sub safe_token_home_lib { - my( $self, $conn, $safe_token ) = @_; - - $cache ||= OpenSRF::Utils::Cache->new("global", 0); - return $cache->get_cache( 'safe-token-home_lib-shortname-'. $safe_token ); -} - - - -__PACKAGE__->register_method( - method => 'slim_tree', - api_name => "open-ils.actor.org_tree.slim_hash.retrieve", -); -sub slim_tree { - my $tree = new_editor()->search_actor_org_unit( - [ - {"parent_ou" => undef }, - { - flesh => -1, - flesh_fields => { aou => ['children'] }, - order_by => { aou => 'name'}, - select => { aou => ["id","shortname", "name"]}, - } - ] - )->[0]; - - return trim_tree($tree); -} - - -sub trim_tree { - my $tree = shift; - return undef unless $tree; - my $htree = { - code => $tree->shortname, - name => $tree->name, - }; - if( $tree->children and @{$tree->children} ) { - $htree->{children} = []; - for my $c (@{$tree->children}) { - push( @{$htree->{children}}, trim_tree($c) ); - } - } - - return $htree; -} - - -__PACKAGE__->register_method( - method => "update_penalties", - api_name => "open-ils.actor.user.penalties.update" -); - -sub update_penalties { - my($self, $conn, $auth, $user_id) = @_; - my $e = new_editor(authtoken=>$auth, xact => 1); - return $e->die_event unless $e->checkauth; - my $user = $e->retrieve_actor_user($user_id) or return $e->die_event; - return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou); - my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $e->requestor->ws_ou); - return $evt if $evt; - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - method => "apply_penalty", - api_name => "open-ils.actor.user.penalty.apply" -); - -sub apply_penalty { - my($self, $conn, $auth, $penalty) = @_; - - my $e = new_editor(authtoken=>$auth, xact => 1); - return $e->die_event unless $e->checkauth; - - my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event; - return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou); - - my $ptype = $e->retrieve_config_standing_penalty($penalty->standing_penalty) or return $e->die_event; - - my $ctx_org = - (defined $ptype->org_depth) ? - $U->org_unit_ancestor_at_depth($penalty->org_unit, $ptype->org_depth) : - $penalty->org_unit; - - $penalty->org_unit($ctx_org); - $penalty->staff($e->requestor->id); - $e->create_actor_user_standing_penalty($penalty) or return $e->die_event; - - $e->commit; - return $penalty->id; -} - -__PACKAGE__->register_method( - method => "remove_penalty", - api_name => "open-ils.actor.user.penalty.remove" -); - -sub remove_penalty { - my($self, $conn, $auth, $penalty) = @_; - my $e = new_editor(authtoken=>$auth, xact => 1); - return $e->die_event unless $e->checkauth; - my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event; - return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou); - - $e->delete_actor_user_standing_penalty($penalty) or return $e->die_event; - $e->commit; - return 1; -} - -__PACKAGE__->register_method( - method => "update_penalty_note", - api_name => "open-ils.actor.user.penalty.note.update" -); - -sub update_penalty_note { - my($self, $conn, $auth, $penalty_ids, $note) = @_; - my $e = new_editor(authtoken=>$auth, xact => 1); - return $e->die_event unless $e->checkauth; - for my $penalty_id (@$penalty_ids) { - my $penalty = $e->search_actor_user_standing_penalty( { id => $penalty_id } )->[0]; - if (! $penalty ) { return $e->die_event; } - my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event; - return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou); - - $penalty->note( $note ); $penalty->ischanged( 1 ); - - $e->update_actor_user_standing_penalty($penalty) or return $e->die_event; - } - $e->commit; - return 1; -} - -__PACKAGE__->register_method( - method => "ranged_penalty_thresholds", - api_name => "open-ils.actor.grp_penalty_threshold.ranged.retrieve", - stream => 1 -); - -sub ranged_penalty_thresholds { - my($self, $conn, $auth, $context_org) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_GROUP_PENALTY_THRESHOLD', $context_org); - my $list = $e->search_permission_grp_penalty_threshold([ - {org_unit => $U->get_org_ancestors($context_org)}, - {order_by => {pgpt => 'id'}} - ]); - $conn->respond($_) for @$list; - return undef; -} - - - -__PACKAGE__->register_method( - method => "user_retrieve_fleshed_by_id", - authoritative => 1, - api_name => "open-ils.actor.user.fleshed.retrieve", -); - -sub user_retrieve_fleshed_by_id { - my( $self, $client, $auth, $user_id, $fields ) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - if( $e->requestor->id != $user_id ) { - return $e->event unless $e->allowed('VIEW_USER'); - } - - $fields ||= [ - "cards", - "card", - "standing_penalties", - "addresses", - "billing_address", - "mailing_address", - "stat_cat_entries" ]; - return new_flesh_user($user_id, $fields, $e); -} - - -sub new_flesh_user { - - my $id = shift; - my $fields = shift || []; - my $e = shift; - - my $fetch_penalties = 0; - if(grep {$_ eq 'standing_penalties'} @$fields) { - $fields = [grep {$_ ne 'standing_penalties'} @$fields]; - $fetch_penalties = 1; - } - - my $user = $e->retrieve_actor_user( - [ - $id, - { - "flesh" => 1, - "flesh_fields" => { "au" => $fields } - } - ] - ) or return $e->die_event; - - - if( grep { $_ eq 'addresses' } @$fields ) { - - $user->addresses([]) unless @{$user->addresses}; - # don't expose "replaced" addresses by default - $user->addresses([grep {$_->id >= 0} @{$user->addresses}]); - - if( ref $user->billing_address ) { - unless( grep { $user->billing_address->id == $_->id } @{$user->addresses} ) { - push( @{$user->addresses}, $user->billing_address ); - } - } - - if( ref $user->mailing_address ) { - unless( grep { $user->mailing_address->id == $_->id } @{$user->addresses} ) { - push( @{$user->addresses}, $user->mailing_address ); - } - } - } - - if($fetch_penalties) { - # grab the user penalties ranged for this location - $user->standing_penalties( - $e->search_actor_user_standing_penalty([ - { usr => $id, - '-or' => [ - {stop_date => undef}, - {stop_date => {'>' => 'now'}} - ], - org_unit => $U->get_org_ancestors($e->requestor->ws_ou) - }, - { flesh => 1, - flesh_fields => {ausp => ['standing_penalty']} - } - ]) - ); - } - - $e->rollback; - $user->clear_passwd(); - return $user; -} - - - - -__PACKAGE__->register_method( - method => "user_retrieve_parts", - api_name => "open-ils.actor.user.retrieve.parts", -); - -sub user_retrieve_parts { - my( $self, $client, $auth, $user_id, $fields ) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - $user_id ||= $e->requestor->id; - if( $e->requestor->id != $user_id ) { - return $e->event unless $e->allowed('VIEW_USER'); - } - my @resp; - my $user = $e->retrieve_actor_user($user_id) or return $e->event; - push(@resp, $user->$_()) for(@$fields); - return \@resp; -} - - - -__PACKAGE__->register_method( - method => 'user_opt_in_enabled', - api_name => 'open-ils.actor.user.org_unit_opt_in.enabled', - signature => '@return 1 if user opt-in is globally enabled, 0 otherwise.' -); - -sub user_opt_in_enabled { - my($self, $conn) = @_; - my $sc = OpenSRF::Utils::SettingsClient->new; - return 1 if lc($sc->config_value(share => user => 'opt_in')) eq 'true'; - return 0; -} - - -__PACKAGE__->register_method( - method => 'user_opt_in_at_org', - api_name => 'open-ils.actor.user.org_unit_opt_in.check', - signature => q/ - @param $auth The auth token - @param user_id The ID of the user to test - @return 1 if the user has opted in at the specified org, - event on error, and 0 otherwise. / -); -sub user_opt_in_at_org { - my($self, $conn, $auth, $user_id) = @_; - - # see if we even need to enforce the opt-in value - return 1 unless user_opt_in_enabled($self); - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - my $org_id = $e->requestor->ws_ou; - - my $user = $e->retrieve_actor_user($user_id) or return $e->event; - return $e->event unless $e->allowed('VIEW_USER', $user->home_ou); - - # user is automatically opted-in at the home org - return 1 if $user->home_ou eq $org_id; - - my $vals = $e->search_actor_usr_org_unit_opt_in( - {org_unit=>$org_id, usr=>$user_id},{idlist=>1}); - - return 1 if @$vals; - return 0; -} - -__PACKAGE__->register_method( - method => 'create_user_opt_in_at_org', - api_name => 'open-ils.actor.user.org_unit_opt_in.create', - signature => q/ - @param $auth The auth token - @param user_id The ID of the user to test - @return The ID of the newly created object, event on error./ -); - -sub create_user_opt_in_at_org { - my($self, $conn, $auth, $user_id) = @_; - - my $e = new_editor(authtoken => $auth, xact=>1); - return $e->die_event unless $e->checkauth; - my $org_id = $e->requestor->ws_ou; - - my $user = $e->retrieve_actor_user($user_id) or return $e->die_event; - return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou); - - my $opt_in = Fieldmapper::actor::usr_org_unit_opt_in->new; - - $opt_in->org_unit($org_id); - $opt_in->usr($user_id); - $opt_in->staff($e->requestor->id); - $opt_in->opt_in_ts('now'); - $opt_in->opt_in_ws($e->requestor->wsid); - - $opt_in = $e->create_actor_usr_org_unit_opt_in($opt_in) - or return $e->die_event; - - $e->commit; - - return $opt_in->id; -} - - -__PACKAGE__->register_method ( - method => 'retrieve_org_hours', - api_name => 'open-ils.actor.org_unit.hours_of_operation.retrieve', - signature => q/ - Returns the hours of operation for a specified org unit - @param authtoken The login session key - @param org_id The org_unit ID - / -); - -sub retrieve_org_hours { - my($self, $conn, $auth, $org_id) = @_; - my $e = new_editor(authtoken => $auth); - return $e->die_event unless $e->checkauth; - $org_id ||= $e->requestor->ws_ou; - return $e->retrieve_actor_org_unit_hours_of_operation($org_id); -} - - -__PACKAGE__->register_method ( - method => 'verify_user_password', - api_name => 'open-ils.actor.verify_user_password', - signature => q/ - Given a barcode or username and the MD5 encoded password, - returns 1 if the password is correct. Returns 0 otherwise. - / -); - -sub verify_user_password { - my($self, $conn, $auth, $barcode, $username, $password) = @_; - my $e = new_editor(authtoken => $auth); - return $e->die_event unless $e->checkauth; - my $user; - my $user_by_barcode; - my $user_by_username; - if($barcode) { - my $card = $e->search_actor_card([ - {barcode => $barcode}, - {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0] or return 0; - $user_by_barcode = $card->usr; - $user = $user_by_barcode; - } - if ($username) { - $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return 0; - $user = $user_by_username; - } - return 0 if (!$user); - return 0 if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id); - return $e->event unless $e->allowed('VIEW_USER', $user->home_ou); - return 1 if $user->passwd eq $password; - return 0; -} - -__PACKAGE__->register_method ( - method => 'retrieve_usr_id_via_barcode_or_usrname', - api_name => "open-ils.actor.user.retrieve_id_by_barcode_or_username", - signature => q/ - Given a barcode or username returns the id for the user or - a failure event. - / -); - -sub retrieve_usr_id_via_barcode_or_usrname { - my($self, $conn, $auth, $barcode, $username) = @_; - my $e = new_editor(authtoken => $auth); - return $e->die_event unless $e->checkauth; - my $id_as_barcode= OpenSRF::Utils::SettingsClient->new->config_value(apps => 'open-ils.actor' => app_settings => 'id_as_barcode'); - my $user; - my $user_by_barcode; - my $user_by_username; - $logger->info("$id_as_barcode is the ID as BARCODE"); - if($barcode) { - my $card = $e->search_actor_card([ - {barcode => $barcode}, - {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0]; - if ($id_as_barcode =~ /^t/i) { - if (!$card) { - $user = $e->retrieve_actor_user($barcode); - return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$user); - }else { - $user_by_barcode = $card->usr; - $user = $user_by_barcode; - } - }else { - return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$card); - $user_by_barcode = $card->usr; - $user = $user_by_barcode; - } - } - - if ($username) { - $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return OpenILS::Event->new( 'ACTOR_USR_NOT_FOUND' ); - - $user = $user_by_username; - } - return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if (!$user); - return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id); - return $e->event unless $e->allowed('VIEW_USER', $user->home_ou); - return $user->id; -} - - -__PACKAGE__->register_method ( - method => 'merge_users', - api_name => 'open-ils.actor.user.merge', - signature => { - desc => q/ - Given a list of source users and destination user, transfer all data from the source - to the dest user and delete the source user. All user related data is - transferred, including circulations, holds, bookbags, etc. - / - } -); - -sub merge_users { - my($self, $conn, $auth, $master_id, $user_ids, $options) = @_; - my $e = new_editor(xact => 1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - - # disallow the merge if any subordinate accounts are in collections - my $colls = $e->search_money_collections_tracker({usr => $user_ids}, {idlist => 1}); - return OpenILS::Event->new('MERGED_USER_IN_COLLECTIONS', payload => $user_ids) if @$colls; - - my $master_user = $e->retrieve_actor_user($master_id) or return $e->die_event; - my $del_addrs = ($U->ou_ancestor_setting_value( - $master_user->home_ou, 'circ.user_merge.delete_addresses', $e)) ? 't' : 'f'; - my $del_cards = ($U->ou_ancestor_setting_value( - $master_user->home_ou, 'circ.user_merge.delete_cards', $e)) ? 't' : 'f'; - my $deactivate_cards = ($U->ou_ancestor_setting_value( - $master_user->home_ou, 'circ.user_merge.deactivate_cards', $e)) ? 't' : 'f'; - - for my $src_id (@$user_ids) { - my $src_user = $e->retrieve_actor_user($src_id) or return $e->die_event; - - return $e->die_event unless $e->allowed('MERGE_USERS', $src_user->home_ou); - if($src_user->home_ou ne $master_user->home_ou) { - return $e->die_event unless $e->allowed('MERGE_USERS', $master_user->home_ou); - } - - return $e->die_event unless - $e->json_query({from => [ - 'actor.usr_merge', - $src_id, - $master_id, - $del_addrs, - $del_cards, - $deactivate_cards - ]}); - } - - $e->commit; - return 1; -} - - -__PACKAGE__->register_method ( - method => 'approve_user_address', - api_name => 'open-ils.actor.user.pending_address.approve', - signature => { - desc => q/ - / - } -); - -sub approve_user_address { - my($self, $conn, $auth, $addr) = @_; - my $e = new_editor(xact => 1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - if(ref $addr) { - # if the caller passes an address object, assume they want to - # update it first before approving it - $e->update_actor_user_address($addr) or return $e->die_event; - } else { - $addr = $e->retrieve_actor_user_address($addr) or return $e->die_event; - } - my $user = $e->retrieve_actor_user($addr->usr); - return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou); - my $result = $e->json_query({from => ['actor.approve_pending_address', $addr->id]})->[0] - or return $e->die_event; - $e->commit; - return [values %$result]->[0]; -} - - -__PACKAGE__->register_method ( - method => 'retrieve_friends', - api_name => 'open-ils.actor.friends.retrieve', - signature => { - desc => q/ - returns { confirmed: [], pending_out: [], pending_in: []} - pending_out are users I'm requesting friendship with - pending_in are users requesting friendship with me - / - } -); - -sub retrieve_friends { - my($self, $conn, $auth, $user_id, $options) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - $user_id ||= $e->requestor->id; - - if($user_id != $e->requestor->id) { - my $user = $e->retrieve_actor_user($user_id) or return $e->event; - return $e->event unless $e->allowed('VIEW_USER', $user->home_ou); - } - - return OpenILS::Application::Actor::Friends->retrieve_friends( - $e, $user_id, $options); -} - - - -__PACKAGE__->register_method ( - method => 'apply_friend_perms', - api_name => 'open-ils.actor.friends.perms.apply', - signature => { - desc => q/ - / - } -); -sub apply_friend_perms { - my($self, $conn, $auth, $user_id, $delegate_id, @perms) = @_; - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - - if($user_id != $e->requestor->id) { - my $user = $e->retrieve_actor_user($user_id) or return $e->die_event; - return $e->die_event unless $e->allowed('VIEW_USER', $user->home_ou); - } - - for my $perm (@perms) { - my $evt = - OpenILS::Application::Actor::Friends->apply_friend_perm( - $e, $user_id, $delegate_id, $perm); - return $evt if $evt; - } - - $e->commit; - return 1; -} - - -__PACKAGE__->register_method ( - method => 'update_user_pending_address', - api_name => 'open-ils.actor.user.address.pending.cud' -); - -sub update_user_pending_address { - my($self, $conn, $auth, $addr) = @_; - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - - if($addr->usr != $e->requestor->id) { - my $user = $e->retrieve_actor_user($addr->usr) or return $e->die_event; - return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou); - } - - if($addr->isnew) { - $e->create_actor_user_address($addr) or return $e->die_event; - } elsif($addr->isdeleted) { - $e->delete_actor_user_address($addr) or return $e->die_event; - } else { - $e->update_actor_user_address($addr) or return $e->die_event; - } - - $e->commit; - return $addr->id; -} - - -__PACKAGE__->register_method ( - method => 'user_events', - api_name => 'open-ils.actor.user.events.circ', - stream => 1, -); -__PACKAGE__->register_method ( - method => 'user_events', - api_name => 'open-ils.actor.user.events.ahr', - stream => 1, -); - -sub user_events { - my($self, $conn, $auth, $user_id, $filters) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/; - my $user_field = 'usr'; - - $filters ||= {}; - $filters->{target} = { - select => { $obj_type => ['id'] }, - from => $obj_type, - where => {usr => $user_id} - }; - - my $user = $e->retrieve_actor_user($user_id) or return $e->event; - if($e->requestor->id != $user_id) { - return $e->event unless $e->allowed('VIEW_USER', $user->home_ou); - } - - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - my $req = $ses->request('open-ils.trigger.events_by_target', - $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2); - - while(my $resp = $req->recv) { - my $val = $resp->content; - my $tgt = $val->target; - - if($obj_type eq 'circ') { - $tgt->target_copy($e->retrieve_asset_copy($tgt->target_copy)); - - } elsif($obj_type eq 'ahr') { - $tgt->current_copy($e->retrieve_asset_copy($tgt->current_copy)) - if $tgt->current_copy; - } - - $conn->respond($val) if $val; - } - - return undef; -} - -__PACKAGE__->register_method ( - method => 'copy_events', - api_name => 'open-ils.actor.copy.events.circ', - stream => 1, -); -__PACKAGE__->register_method ( - method => 'copy_events', - api_name => 'open-ils.actor.copy.events.ahr', - stream => 1, -); - -sub copy_events { - my($self, $conn, $auth, $copy_id, $filters) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/; - - my $copy = $e->retrieve_asset_copy($copy_id) or return $e->event; - - my $copy_field = 'target_copy'; - $copy_field = 'current_copy' if $obj_type eq 'ahr'; - - $filters ||= {}; - $filters->{target} = { - select => { $obj_type => ['id'] }, - from => $obj_type, - where => {$copy_field => $copy_id} - }; - - - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - my $req = $ses->request('open-ils.trigger.events_by_target', - $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2); - - while(my $resp = $req->recv) { - my $val = $resp->content; - my $tgt = $val->target; - - my $user = $e->retrieve_actor_user($tgt->usr); - if($e->requestor->id != $user->id) { - return $e->event unless $e->allowed('VIEW_USER', $user->home_ou); - } - - $tgt->$copy_field($copy); - - $tgt->usr($user); - $conn->respond($val) if $val; - } - - return undef; -} - - - - -__PACKAGE__->register_method ( - method => 'update_events', - api_name => 'open-ils.actor.user.event.cancel.batch', - stream => 1, -); -__PACKAGE__->register_method ( - method => 'update_events', - api_name => 'open-ils.actor.user.event.reset.batch', - stream => 1, -); - -sub update_events { - my($self, $conn, $auth, $event_ids) = @_; - my $e = new_editor(xact => 1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - - my $x = 1; - for my $id (@$event_ids) { - - # do a little dance to determine what user we are ultimately affecting - my $event = $e->retrieve_action_trigger_event([ - $id, - { flesh => 2, - flesh_fields => {atev => ['event_def'], atevdef => ['hook']} - } - ]) or return $e->die_event; - - my $user_id; - if($event->event_def->hook->core_type eq 'circ') { - $user_id = $e->retrieve_action_circulation($event->target)->usr; - } elsif($event->event_def->hook->core_type eq 'ahr') { - $user_id = $e->retrieve_action_hold_request($event->target)->usr; - } else { - return 0; - } - - my $user = $e->retrieve_actor_user($user_id); - return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou); - - if($self->api_name =~ /cancel/) { - $event->state('invalid'); - } elsif($self->api_name =~ /reset/) { - $event->clear_start_time; - $event->clear_update_time; - $event->state('pending'); - } - - $e->update_action_trigger_event($event) or return $e->die_event; - $conn->respond({maximum => scalar(@$event_ids), progress => $x++}); - } - - $e->commit; - return {complete => 1}; -} - - -__PACKAGE__->register_method ( - method => 'really_delete_user', - api_name => 'open-ils.actor.user.delete', - signature => q/ - It anonymizes all personally identifiable information in actor.usr. By calling actor.usr_purge_data() - it also purges related data from other tables, sometimes by transferring it to a designated destination user. - The usrname field (along with first_given_name and family_name) is updated to id '-PURGED-' now(). - dest_usr_id is only required when deleting a user that performs staff functions. - / -); - -sub really_delete_user { - my($self, $conn, $auth, $user_id, $dest_user_id) = @_; - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - my $user = $e->retrieve_actor_user($user_id) or return $e->die_event; - return $e->die_event unless $e->allowed('DELETE_USER', $user->home_ou); - my $stat = $e->json_query( - {from => ['actor.usr_delete', $user_id, $dest_user_id]})->[0] - or return $e->die_event; - $e->commit; - return 1; -} - - - -__PACKAGE__->register_method ( - method => 'user_payments', - api_name => 'open-ils.actor.user.payments.retrieve', - stream => 1, - signature => q/ - Returns all payments for a given user. Default order is newest payments first. - @param auth Authentication token - @param user_id The user ID - @param filters An optional hash of filters, including limit, offset, and order_by definitions - / -); - -sub user_payments { - my($self, $conn, $auth, $user_id, $filters) = @_; - $filters ||= {}; - - my $e = new_editor(authtoken => $auth); - return $e->die_event unless $e->checkauth; - - my $user = $e->retrieve_actor_user($user_id) or return $e->event; - return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou); - - # Find all payments for all transactions for user $user_id - my $query = { - select => {mp => ['id']}, - from => 'mp', - where => { - xact => { - in => { - select => {mbt => ['id']}, - from => 'mbt', - where => {usr => $user_id} - } - } - }, - order_by => [{ # by default, order newest payments first - class => 'mp', - field => 'payment_ts', - direction => 'desc' - }] - }; - - for (qw/order_by limit offset/) { - $query->{$_} = $filters->{$_} if defined $filters->{$_}; - } - - if(defined $filters->{where}) { - foreach (keys %{$filters->{where}}) { - # don't allow the caller to expand the result set to other users - $query->{where}->{$_} = $filters->{where}->{$_} unless $_ eq 'xact'; - } - } - - my $payment_ids = $e->json_query($query); - for my $pid (@$payment_ids) { - my $pay = $e->retrieve_money_payment([ - $pid->{id}, - { flesh => 6, - flesh_fields => { - mp => ['xact'], - mbt => ['summary', 'circulation', 'grocery'], - circ => ['target_copy'], - acp => ['call_number'], - acn => ['record'] - } - } - ]); - - my $resp = { - mp => $pay, - xact_type => $pay->xact->summary->xact_type, - last_billing_type => $pay->xact->summary->last_billing_type, - }; - - if($pay->xact->summary->xact_type eq 'circulation') { - $resp->{barcode} = $pay->xact->circulation->target_copy->barcode; - $resp->{title} = $U->record_to_mvr($pay->xact->circulation->target_copy->call_number->record)->title; - } - - $pay->xact($pay->xact->id); # de-flesh - $conn->respond($resp); - } - - return undef; -} - - - -__PACKAGE__->register_method ( - method => 'negative_balance_users', - api_name => 'open-ils.actor.users.negative_balance', - stream => 1, - signature => q/ - Returns all users that have an overall negative balance - @param auth Authentication token - @param org_id The context org unit as an ID or list of IDs. This will be the home - library of the user. If no org_unit is specified, no org unit filter is applied - / -); - -sub negative_balance_users { - my($self, $conn, $auth, $org_id) = @_; - - my $e = new_editor(authtoken => $auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('VIEW_USER', $org_id); - - my $query = { - select => { - mous => ['usr', 'balance_owed'], - au => ['home_ou'], - mbts => [ - {column => 'last_billing_ts', transform => 'max', aggregate => 1}, - {column => 'last_payment_ts', transform => 'max', aggregate => 1}, - ] - }, - from => { - mous => { - au => { - fkey => 'usr', - field => 'id', - join => { - mbts => { - key => 'id', - field => 'usr' - } - } - } - } - }, - where => {'+mous' => {balance_owed => {'<' => 0}}} - }; - - $query->{from}->{mous}->{au}->{filter}->{home_ou} = $org_id if $org_id; - - my $list = $e->json_query($query, {timeout => 600}); - - for my $data (@$list) { - $conn->respond({ - usr => $e->retrieve_actor_user([$data->{usr}, {flesh => 1, flesh_fields => {au => ['card']}}]), - balance_owed => $data->{balance_owed}, - last_billing_activity => max($data->{last_billing_ts}, $data->{last_payment_ts}) - }); - } - - return undef; -} - -__PACKAGE__->register_method( - method => "request_password_reset", - api_name => "open-ils.actor.patron.password_reset.request", - signature => { - desc => "Generates a UUID token usable with the open-ils.actor.patron.password_reset.commit " . - "method for changing a user's password. The UUID token is distributed via A/T " . - "templates (i.e. email to the user).", - params => [ - { desc => 'user_id_type', type => 'string' }, - { desc => 'user_id', type => 'string' }, - { desc => 'optional (based on library setting) matching email address for authorizing request', type => 'string' }, - ], - return => {desc => '1 on success, Event on error'} - } -); -sub request_password_reset { - my($self, $conn, $user_id_type, $user_id, $email) = @_; - - # Check to see if password reset requests are already being throttled: - # 0. Check cache to see if we're in throttle mode (avoid hitting database) - - my $e = new_editor(xact => 1); - my $user; - - # Get the user, if any, depending on the input value - if ($user_id_type eq 'username') { - $user = $e->search_actor_user({usrname => $user_id})->[0]; - if (!$user) { - $e->die_event; - return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ); - } - } elsif ($user_id_type eq 'barcode') { - my $card = $e->search_actor_card([ - {barcode => $user_id}, - {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0]; - if (!$card) { - $e->die_event; - return OpenILS::Event->new('ACTOR_USER_NOT_FOUND'); - } - $user = $card->usr; - } - - # If the user doesn't have an email address, we can't help them - if (!$user->email) { - $e->die_event; - return OpenILS::Event->new('PATRON_NO_EMAIL_ADDRESS'); - } - - my $email_must_match = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_requires_matching_email'); - if ($email_must_match) { - if ($user->email ne $email) { - return OpenILS::Event->new('EMAIL_VERIFICATION_FAILED'); - } - } - - _reset_password_request($conn, $e, $user); -} - -# Once we have the user, we can issue the password reset request -# XXX Add a wrapper method that accepts barcode + email input -sub _reset_password_request { - my ($conn, $e, $user) = @_; - - # 1. Get throttle threshold and time-to-live from OU_settings - my $aupr_throttle = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_throttle') || 1000; - my $aupr_ttl = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_time_to_live') || 24*60*60; - - my $threshold_time = DateTime->now(time_zone => 'local')->subtract(seconds => $aupr_ttl)->iso8601(); - - # 2. Get time of last request and number of active requests (num_active) - my $active_requests = $e->json_query({ - from => 'aupr', - select => { - aupr => [ - { - column => 'uuid', - transform => 'COUNT' - }, - { - column => 'request_time', - transform => 'MAX' - } - ] - }, - where => { - has_been_reset => { '=' => 'f' }, - request_time => { '>' => $threshold_time } - } - }); - - # Guard against no active requests - if ($active_requests->[0]->{'request_time'}) { - my $last_request = DateTime::Format::ISO8601->parse_datetime(clense_ISO8601($active_requests->[0]->{'request_time'})); - my $now = DateTime::Format::ISO8601->new(); - - # 3. if (num_active > throttle_threshold) and (now - last_request < 1 minute) - if (($active_requests->[0]->{'usr'} > $aupr_throttle) && - ($last_request->add_duration('1 minute') > $now)) { - $cache->put_cache('open-ils.actor.password.throttle', DateTime::Format::ISO8601->new(), 60); - $e->die_event; - return OpenILS::Event->new('PATRON_TOO_MANY_ACTIVE_PASSWORD_RESET_REQUESTS'); - } - } - - # TODO Check to see if the user is in a password-reset-restricted group - - # Otherwise, go ahead and try to get the user. - - # Check the number of active requests for this user - $active_requests = $e->json_query({ - from => 'aupr', - select => { - aupr => [ - { - column => 'usr', - transform => 'COUNT' - } - ] - }, - where => { - usr => { '=' => $user->id }, - has_been_reset => { '=' => 'f' }, - request_time => { '>' => $threshold_time } - } - }); - - $logger->info("User " . $user->id . " has " . $active_requests->[0]->{'usr'} . " active password reset requests."); - - # if less than or equal to per-user threshold, proceed; otherwise, return event - my $aupr_per_user_limit = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_per_user_limit') || 3; - if ($active_requests->[0]->{'usr'} > $aupr_per_user_limit) { - $e->die_event; - return OpenILS::Event->new('PATRON_TOO_MANY_ACTIVE_PASSWORD_RESET_REQUESTS'); - } - - # Create the aupr object and insert into the database - my $reset_request = Fieldmapper::actor::usr_password_reset->new; - my $uuid = create_uuid_as_string(UUID_V4); - $reset_request->uuid($uuid); - $reset_request->usr($user->id); - - my $aupr = $e->create_actor_usr_password_reset($reset_request) or return $e->die_event; - $e->commit; - - # Create an event to notify user of the URL to reset their password - - # Can we stuff this in the user_data param for trigger autocreate? - my $hostname = $U->ou_ancestor_setting_value($user->home_ou, 'lib.hostname') || 'localhost'; - - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - $ses->request('open-ils.trigger.event.autocreate', 'password.reset_request', $aupr, $user->home_ou); - - # Trunk only - # $U->create_trigger_event('password.reset_request', $aupr, $user->home_ou); - - return 1; -} - -__PACKAGE__->register_method( - method => "commit_password_reset", - api_name => "open-ils.actor.patron.password_reset.commit", - signature => { - desc => "Checks a UUID token generated by the open-ils.actor.patron.password_reset.request method for " . - "validity, and if valid, uses it as authorization for changing the associated user's password " . - "with the supplied password.", - params => [ - { desc => 'uuid', type => 'string' }, - { desc => 'password', type => 'string' }, - ], - return => {desc => '1 on success, Event on error'} - } -); -sub commit_password_reset { - my($self, $conn, $uuid, $password) = @_; - - # Check to see if password reset requests are already being throttled: - # 0. Check cache to see if we're in throttle mode (avoid hitting database) - $cache ||= OpenSRF::Utils::Cache->new("global", 0); - my $throttle = $cache->get_cache('open-ils.actor.password.throttle') || undef; - if ($throttle) { - return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST'); - } - - my $e = new_editor(xact => 1); - - my $aupr = $e->search_actor_usr_password_reset({ - uuid => $uuid, - has_been_reset => 0 - }); - - if (!$aupr->[0]) { - $e->die_event; - return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST'); - } - my $user_id = $aupr->[0]->usr; - my $user = $e->retrieve_actor_user($user_id); - - # Ensure we're still within the TTL for the request - my $aupr_ttl = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_time_to_live') || 24*60*60; - my $threshold = DateTime::Format::ISO8601->parse_datetime(clense_ISO8601($aupr->[0]->request_time))->add(seconds => $aupr_ttl); - if ($threshold < DateTime->now(time_zone => 'local')) { - $e->die_event; - $logger->info("Password reset request needed to be submitted before $threshold"); - return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST'); - } - - # Check complexity of password against OU-defined regex - my $pw_regex = $U->ou_ancestor_setting_value($user->home_ou, 'global.password_regex'); - - my $is_strong = 0; - if ($pw_regex) { - # Calling JSON2perl on the $pw_regex causes failure, even before the fancy Unicode regex - # ($pw_regex = OpenSRF::Utils::JSON->JSON2perl($pw_regex)) =~ s/\\u([0-9a-fA-F]{4})/\\x{$1}/gs; - $is_strong = check_password_strength_custom($password, $pw_regex); - } else { - $is_strong = check_password_strength_default($password); - } - - if (!$is_strong) { - $e->die_event; - return OpenILS::Event->new('PATRON_PASSWORD_WAS_NOT_STRONG'); - } - - # All is well; update the password - $user->passwd($password); - $e->update_actor_user($user); - - # And flag that this password reset request has been honoured - $aupr->[0]->has_been_reset('t'); - $e->update_actor_usr_password_reset($aupr->[0]); - $e->commit; - - return 1; -} - -sub check_password_strength_default { - my $password = shift; - # Use the default set of checks - if ( (length($password) < 7) or - ($password !~ m/.*\d+.*/) or - ($password !~ m/.*[A-Za-z]+.*/) - ) { - return 0; - } - return 1; -} - -sub check_password_strength_custom { - my ($password, $pw_regex) = @_; - - $pw_regex = qr/$pw_regex/; - if ($password !~ /$pw_regex/) { - return 0; - } - return 1; -} - - - -__PACKAGE__->register_method( - method => "event_def_opt_in_settings", - api_name => "open-ils.actor.event_def.opt_in.settings", - stream => 1, - signature => { - desc => 'Streams the set of "cust" objects that are used as opt-in settings for event definitions', - params => [ - { desc => 'Authentication token', type => 'string'}, - { - desc => 'Org Unit ID. (optional). If no org ID is present, the home_ou of the requesting user is used', - type => 'number' - }, - ], - return => { - desc => q/set of "cust" objects that are used as opt-in settings for event definitions at the specified org unit/, - type => 'object', - class => 'cust' - } - } -); - -sub event_def_opt_in_settings { - my($self, $conn, $auth, $org_id) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - if(defined $org_id and $org_id != $e->requestor->home_ou) { - return $e->event unless - $e->allowed(['VIEW_USER_SETTING_TYPE', 'ADMIN_USER_SETTING_TYPE'], $org_id); - } else { - $org_id = $e->requestor->home_ou; - } - - # find all config.user_setting_type's related to event_defs for the requested org unit - my $types = $e->json_query({ - select => {cust => ['name']}, - from => {atevdef => 'cust'}, - where => { - '+atevdef' => { - owner => $U->get_org_ancestors($org_id), # context org plus parents - active => 't' - } - } - }); - - if(@$types) { - $conn->respond($_) for - @{$e->search_config_usr_setting_type({name => [map {$_->{name}} @$types]})}; - } - - return undef; -} - - -__PACKAGE__->register_method( - method => "user_visible_circs", - api_name => "open-ils.actor.history.circ.visible", - stream => 1, - signature => { - desc => 'Returns the set of opt-in visible circulations accompanied by circulation chain summaries', - params => [ - { desc => 'Authentication token', type => 'string'}, - { desc => 'User ID. If no user id is present, the authenticated user is assumed', type => 'number' }, - { desc => 'Options hash. Supported fields are "limit" and "offset"', type => 'object' }, - ], - return => { - desc => q/An object with 2 fields: circulation and summary. - circulation is the "circ" object. summary is the related "accs" object/, - type => 'object', - } - } -); - -__PACKAGE__->register_method( - method => "user_visible_circs", - api_name => "open-ils.actor.history.circ.visible.print", - stream => 1, - signature => { - desc => 'Returns printable output for the set of opt-in visible circulations', - params => [ - { desc => 'Authentication token', type => 'string'}, - { desc => 'User ID. If no user id is present, the authenticated user is assumed', type => 'number' }, - { desc => 'Options hash. Supported fields are "limit" and "offset"', type => 'object' }, - ], - return => { - desc => q/An action_trigger.event object or error event./, - type => 'object', - } - } -); - -__PACKAGE__->register_method( - method => "user_visible_circs", - api_name => "open-ils.actor.history.circ.visible.email", - stream => 1, - signature => { - desc => 'Emails the set of opt-in visible circulations to the requestor', - params => [ - { desc => 'Authentication token', type => 'string'}, - { desc => 'User ID. If no user id is present, the authenticated user is assumed', type => 'number' }, - { desc => 'Options hash. Supported fields are "limit" and "offset"', type => 'object' }, - ], - return => { - desc => q/undef, or event on error/ - } - } -); - -__PACKAGE__->register_method( - method => "user_visible_circs", - api_name => "open-ils.actor.history.hold.visible", - stream => 1, - signature => { - desc => 'Returns the set of opt-in visible holds', - params => [ - { desc => 'Authentication token', type => 'string'}, - { desc => 'User ID. If no user id is present, the authenticated user is assumed', type => 'number' }, - { desc => 'Options hash. Supported fields are "limit" and "offset"', type => 'object' }, - ], - return => { - desc => q/An object with 1 field: "hold"/, - type => 'object', - } - } -); - -__PACKAGE__->register_method( - method => "user_visible_circs", - api_name => "open-ils.actor.history.hold.visible.print", - stream => 1, - signature => { - desc => 'Returns printable output for the set of opt-in visible holds', - params => [ - { desc => 'Authentication token', type => 'string'}, - { desc => 'User ID. If no user id is present, the authenticated user is assumed', type => 'number' }, - { desc => 'Options hash. Supported fields are "limit" and "offset"', type => 'object' }, - ], - return => { - desc => q/An action_trigger.event object or error event./, - type => 'object', - } - } -); - -__PACKAGE__->register_method( - method => "user_visible_circs", - api_name => "open-ils.actor.history.hold.visible.email", - stream => 1, - signature => { - desc => 'Emails the set of opt-in visible holds to the requestor', - params => [ - { desc => 'Authentication token', type => 'string'}, - { desc => 'User ID. If no user id is present, the authenticated user is assumed', type => 'number' }, - { desc => 'Options hash. Supported fields are "limit" and "offset"', type => 'object' }, - ], - return => { - desc => q/undef, or event on error/ - } - } -); - -sub user_visible_circs { - my($self, $conn, $auth, $user_id, $options) = @_; - - my $is_hold = ($self->api_name =~ /hold/); - my $for_print = ($self->api_name =~ /print/); - my $for_email = ($self->api_name =~ /email/); - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - $user_id ||= $e->requestor->id; - $options ||= {}; - $options->{limit} ||= 50; - $options->{offset} ||= 0; - - if($user_id != $e->requestor->id) { - my $perm = ($is_hold) ? 'VIEW_HOLD' : 'VIEW_CIRCULATIONS'; - my $user = $e->retrieve_actor_user($user_id) or return $e->event; - return $e->event unless $e->allowed($perm, $user->home_ou); - } - - my $db_func = ($is_hold) ? 'action.usr_visible_holds' : 'action.usr_visible_circs'; - - my $data = $e->json_query({ - from => [$db_func, $user_id], - limit => $$options{limit}, - offset => $$options{offset} - - # TODO: I only want IDs. code below didn't get me there - # {"select":{"au":[{"column":"id", "result_field":"id", - # "transform":"action.usr_visible_circs"}]}, "where":{"id":10}, "from":"au"} - },{ - substream => 1 - }); - - return undef unless @$data; - - if ($for_print) { - - # collect the batch of objects - - if($is_hold) { - - my $hold_list = $e->search_action_hold_request({id => [map { $_->{id} } @$data]}); - return $U->fire_object_event(undef, 'ahr.format.history.print', $hold_list, $$hold_list[0]->request_lib); - - } else { - - my $circ_list = $e->search_action_circulation({id => [map { $_->{id} } @$data]}); - return $U->fire_object_event(undef, 'circ.format.history.print', $circ_list, $$circ_list[0]->circ_lib); - } - - } elsif ($for_email) { - - $conn->respond_complete(1) if $for_email; # no sense in waiting - - foreach (@$data) { - - my $id = $_->{id}; - - if($is_hold) { - - my $hold = $e->retrieve_action_hold_request($id); - $U->create_events_for_hook('ahr.format.history.email', $hold, $hold->request_lib, undef, undef, 1); - # events will be fired from action_trigger_runner - - } else { - - my $circ = $e->retrieve_action_circulation($id); - $U->create_events_for_hook('circ.format.history.email', $circ, $circ->circ_lib, undef, undef, 1); - # events will be fired from action_trigger_runner - } - } - - } else { # just give me the data please - - foreach (@$data) { - - my $id = $_->{id}; - - if($is_hold) { - - my $hold = $e->retrieve_action_hold_request($id); - $conn->respond({hold => $hold}); - - } else { - - my $circ = $e->retrieve_action_circulation($id); - $conn->respond({ - circ => $circ, - summary => $U->create_circ_chain_summary($e, $id) - }); - } - } - } - - return undef; -} - -__PACKAGE__->register_method( - method => "user_saved_search_cud", - api_name => "open-ils.actor.user.saved_search.cud", - stream => 1, - signature => { - desc => 'Create/Update/Delete Access to user saved searches', - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'Saved Search Object', type => 'object', class => 'auss' } - ], - return => { - desc => q/The retrieved or updated saved search object, or id of a deleted object; Event on error/, - class => 'auss' - } - } -); - -__PACKAGE__->register_method( - method => "user_saved_search_cud", - api_name => "open-ils.actor.user.saved_search.retrieve", - stream => 1, - signature => { - desc => 'Retrieve a saved search object', - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'Saved Search ID', type => 'number' } - ], - return => { - desc => q/The saved search object, Event on error/, - class => 'auss' - } - } -); - -sub user_saved_search_cud { - my( $self, $client, $auth, $search ) = @_; - my $e = new_editor( authtoken=>$auth ); - return $e->die_event unless $e->checkauth; - - my $o_search; # prior version of the object, if any - my $res; # to be returned - - # branch on the operation type - - if( $self->api_name =~ /retrieve/ ) { # Retrieve - - # Get the old version, to check ownership - $o_search = $e->retrieve_actor_usr_saved_search( $search ) - or return $e->die_event; - - # You can't read somebody else's search - return OpenILS::Event->new('BAD_PARAMS') - unless $o_search->owner == $e->requestor->id; - - $res = $o_search; - - } else { - - $e->xact_begin; # start an editor transaction - - if( $search->isnew ) { # Create - - # You can't create a search for somebody else - return OpenILS::Event->new('BAD_PARAMS') - unless $search->owner == $e->requestor->id; - - $e->create_actor_usr_saved_search( $search ) - or return $e->die_event; - - $res = $search->id; - - } elsif( $search->ischanged ) { # Update - - # You can't change ownership of a search - return OpenILS::Event->new('BAD_PARAMS') - unless $search->owner == $e->requestor->id; - - # Get the old version, to check ownership - $o_search = $e->retrieve_actor_usr_saved_search( $search->id ) - or return $e->die_event; - - # You can't update somebody else's search - return OpenILS::Event->new('BAD_PARAMS') - unless $o_search->owner == $e->requestor->id; - - # Do the update - $e->update_actor_usr_saved_search( $search ) - or return $e->die_event; - - $res = $search; - - } elsif( $search->isdeleted ) { # Delete - - # Get the old version, to check ownership - $o_search = $e->retrieve_actor_usr_saved_search( $search->id ) - or return $e->die_event; - - # You can't delete somebody else's search - return OpenILS::Event->new('BAD_PARAMS') - unless $o_search->owner == $e->requestor->id; - - # Do the delete - $e->delete_actor_usr_saved_search( $o_search ) - or return $e->die_event; - - $res = $search->id; - } - - $e->commit; - } - - return $res; -} - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Actor/ClosedDates.pm b/Open-ILS/src/perlmods/OpenILS/Application/Actor/ClosedDates.pm deleted file mode 100644 index e7601dfc5b..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Actor/ClosedDates.pm +++ /dev/null @@ -1,158 +0,0 @@ -package OpenILS::Application::Actor::ClosedDates; -use base 'OpenILS::Application'; -use strict; use warnings; -use OpenSRF::EX qw(:try); -use OpenILS::Utils::Editor q/:funcs/; - -sub initialize { return 1; } - -__PACKAGE__->register_method( - method => 'fetch_dates', - api_name => 'open-ils.actor.org_unit.closed.retrieve.all', - signature => q/ - Retrieves a list of closed date object IDs - / -); - -sub fetch_dates { - my( $self, $conn, $auth, $args ) = @_; - - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - my $org = $$args{orgid} || $e->requestor->ws_ou; - my @date = localtime; - my $start = $$args{start_date} || #default to today - ($date[5] + 1900) .'-'. ($date[4] + 1) .'-'. $date[3]; - my $end = $$args{end_date} || '3000-01-01'; # Y3K, here I come.. - - my $dates = $e->search_actor_org_unit_closed_date( - { - close_start => { ">=" => $start }, - close_end => { "<=" => $end }, - org_unit => $org, - }, { idlist => $$args{idlist} } ) or return $e->event; - - if(!$$args{idlist} and @$dates) { - $dates = [ sort { $a->close_start cmp $b->close_start } @$dates ]; - } - - return $dates; -} - -__PACKAGE__->register_method( - method => 'fetch_date', - api_name => 'open-ils.actor.org_unit.closed.retrieve', - signature => q/ - Retrieves a single date object - / -); - -sub fetch_date { - my( $self, $conn, $auth, $id ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - my $date = $e->retrieve_actor_org_unit_closed_date($id) or return $e->event; - return $date; -} - - -__PACKAGE__->register_method( - method => 'delete_date', - api_name => 'open-ils.actor.org_unit.closed.delete', - signature => q/ - Removes a single date object - / -); - -sub delete_date { - my( $self, $conn, $auth, $id ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - my $date = $e->retrieve_actor_org_unit_closed_date($id) or return $e->event; - return $e->event unless $e->allowed( # rely on the editor perm eventually - 'actor.org_unit.closed_date.delete', $date->org_unit); - $e->delete_actor_org_unit_closed_date($date) or return $e->event; - return 1; -} - - - - -__PACKAGE__->register_method( - method => 'create_date', - api_name => 'open-ils.actor.org_unit.closed.create', - signature => q/ - Creates a new org closed data - / -); - -sub create_date { - my( $self, $conn, $auth, $date ) = @_; - - my $e = new_editor(authtoken=>$auth, xact =>1); - return $e->event unless $e->checkauth; - - return $e->event unless $e->allowed( # rely on the editor perm eventually - 'actor.org_unit.closed_date.create', $date->org_unit); - - $e->create_actor_org_unit_closed_date($date) or return $e->event; - - my $newobj = $e->retrieve_actor_org_unit_closed_date($date->id) - or return $e->event; - - $e->commit; - return $newobj; -} - - -__PACKAGE__->register_method( - method => 'edit_date', - api_name => 'open-ils.actor.org_unit.closed.update', - signature => q/ - Updates a closed date object - / -); - -sub edit_date { - my( $self, $conn, $auth, $date ) = @_; - my $e = new_editor(authtoken=>$auth, xact =>1); - return $e->event unless $e->checkauth; - - # First make sure they have the right to update the selected date object - my $odate = $e->retrieve_actor_org_unit_closed_date($date->id) - or return $e->event; - - return $e->event unless $e->allowed( # rely on the editor perm eventually - 'actor.org_unit.closed_date.update', $odate->org_unit); - - $e->update_actor_org_unit_closed_date($date) or return $e->event; - - return 1; -} - - -__PACKAGE__->register_method( - method => 'closed_dates_overlap', - api_name => 'open-ils.actor.org_unit.closed_date.overlap', - signature => q/ - Returns an object with 'start' and 'end' fields - start is the first day the org is open going backwards from - 'date'. end is the next day the org is open going - forward from 'date'. - @param orgid The org unit in question - @param date The date to search - / -); -sub closed_dates_overlap { - my( $self, $conn, $auth, $orgid, $date ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->request( - 'open-ils.storage.actor.org_unit.closed_date.overlap', $orgid, $date ); -} - - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Actor/Container.pm b/Open-ILS/src/perlmods/OpenILS/Application/Actor/Container.pm deleted file mode 100644 index 9126ad824f..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Actor/Container.pm +++ /dev/null @@ -1,630 +0,0 @@ -package OpenILS::Application::Actor::Container; -use base 'OpenILS::Application'; -use strict; use warnings; -use OpenILS::Application::AppUtils; -use OpenILS::Perm; -use Data::Dumper; -use OpenSRF::EX qw(:try); -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::CStoreEditor qw/:funcs/; -use OpenSRF::Utils::SettingsClient; -use OpenSRF::Utils::Cache; -use Digest::MD5 qw(md5_hex); -use OpenSRF::Utils::JSON; - -my $apputils = "OpenILS::Application::AppUtils"; -my $U = $apputils; -my $logger = "OpenSRF::Utils::Logger"; - -sub initialize { return 1; } - -my $svc = 'open-ils.cstore'; -my $meth = 'open-ils.cstore.direct.container'; -my %types; -my %ctypes; -$types{'biblio'} = "$meth.biblio_record_entry_bucket"; -$types{'callnumber'} = "$meth.call_number_bucket"; -$types{'copy'} = "$meth.copy_bucket"; -$types{'user'} = "$meth.user_bucket"; -$ctypes{'biblio'} = "container_biblio_record_entry_bucket"; -$ctypes{'callnumber'} = "container_call_number_bucket"; -$ctypes{'copy'} = "container_copy_bucket"; -$ctypes{'user'} = "container_user_bucket"; -my $event; - -sub _sort_buckets { - my $buckets = shift; - return $buckets unless ($buckets && $buckets->[0]); - return [ sort { $a->name cmp $b->name } @$buckets ]; -} - -__PACKAGE__->register_method( - method => "bucket_retrieve_all", - api_name => "open-ils.actor.container.all.retrieve_by_user", - authoritative => 1, - notes => <<" NOTES"); - Retrieves all un-fleshed buckets assigned to given user - PARAMS(authtoken, bucketOwnerId) - If requestor ID is different than bucketOwnerId, requestor must have - VIEW_CONTAINER permissions. - NOTES - -sub bucket_retrieve_all { - my($self, $client, $auth, $user_id) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - if($e->requestor->id ne $user_id) { - return $e->event unless $e->allowed('VIEW_CONTAINER'); - } - - my %buckets; - for my $type (keys %ctypes) { - my $meth = "search_" . $ctypes{$type}; - $buckets{$type} = $e->$meth({owner => $user_id}); - } - - return \%buckets; -} - -__PACKAGE__->register_method( - method => "bucket_flesh", - api_name => "open-ils.actor.container.flesh", - authoritative => 1, - argc => 3, -); - -__PACKAGE__->register_method( - method => "bucket_flesh_pub", - api_name => "open-ils.actor.container.public.flesh", - argc => 3, -); - -sub bucket_flesh { - my($self, $conn, $auth, $class, $bucket_id) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - return _bucket_flesh($self, $conn, $e, $class, $bucket_id); -} - -sub bucket_flesh_pub { - my($self, $conn, $class, $bucket_id) = @_; - my $e = new_editor(); - return _bucket_flesh($self, $conn, $e, $class, $bucket_id); -} - -sub _bucket_flesh { - my($self, $conn, $e, $class, $bucket_id) = @_; - my $meth = 'retrieve_' . $ctypes{$class}; - my $bkt = $e->$meth($bucket_id) or return $e->event; - - unless($U->is_true($bkt->pub)) { - return undef if $self->api_name =~ /public/; - unless($bkt->owner eq $e->requestor->id) { - my $owner = $e->retrieve_actor_user($bkt->owner) - or return $e->die_event; - return $e->event unless $e->allowed('VIEW_CONTAINER', $owner->home_ou); - } - } - - my $fmclass = $bkt->class_name . "i"; - $meth = 'search_' . $ctypes{$class} . '_item'; - $bkt->items( - $e->$meth( - {bucket => $bucket_id}, - { order_by => {$fmclass => "pos"}, - flesh => 1, - flesh_fields => {$fmclass => ['notes']} - } - ) - ); - - return $bkt; -} - - -__PACKAGE__->register_method( - method => "item_note_cud", - api_name => "open-ils.actor.container.item_note.cud", -); - - -sub item_note_cud { - my($self, $conn, $auth, $class, $note) = @_; - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - - my $meth = 'retrieve_' . $ctypes{$class}; - my $nclass = $note->class_name; - (my $iclass = $nclass) =~ s/n$//og; - - my $db_note = $e->$meth($note->id, { - flesh => 2, - flesh_fields => { - $nclass => ['item'], - $iclass => ['bucket'] - } - }); - - if($db_note->item->bucket->owner ne $e->requestor->id) { - return $e->die_event unless - $e->allowed('UPDATE_CONTAINER', $db_note->item->bucket); - } - - $meth = 'create_' . $ctypes{$class} if $note->isnew; - $meth = 'update_' . $ctypes{$class} if $note->ischanged; - $meth = 'delete_' . $ctypes{$class} if $note->isdeleted; - return $e->die_event unless $e->$meth($note); - $e->commit; -} - - -__PACKAGE__->register_method( - method => "bucket_retrieve_class", - api_name => "open-ils.actor.container.retrieve_by_class", - argc => 3, - notes => <<" NOTES"); - Retrieves all un-fleshed buckets by class assigned to given user - PARAMS(authtoken, bucketOwnerId, class [, type]) - class can be one of "biblio", "callnumber", "copy", "user" - The optional "type" parameter allows you to limit the search by - bucket type. - If bucketOwnerId is not defined, the authtoken is used as the - bucket owner. - If requestor ID is different than bucketOwnerId, requestor must have - VIEW_CONTAINER permissions. - NOTES - -sub bucket_retrieve_class { - my( $self, $client, $authtoken, $userid, $class, $type ) = @_; - - my( $staff, $user, $evt ) = - $apputils->checkses_requestor( $authtoken, $userid, 'VIEW_CONTAINER' ); - return $evt if $evt; - - $logger->debug("User " . $staff->id . - " retrieving buckets for user $userid [class=$class, type=$type]"); - - my $meth = $types{$class} . ".search.atomic"; - my $buckets; - - if( $type ) { - $buckets = $apputils->simplereq( $svc, - $meth, { owner => $userid, btype => $type } ); - } else { - $logger->debug("Grabbing buckets by class $class: $svc : $meth : {owner => $userid}"); - $buckets = $apputils->simplereq( $svc, $meth, { owner => $userid } ); - } - - return _sort_buckets($buckets); -} - -__PACKAGE__->register_method( - method => "bucket_create", - api_name => "open-ils.actor.container.create", - notes => <<" NOTES"); - Creates a new bucket object. If requestor is different from - bucketOwner, requestor needs CREATE_CONTAINER permissions - PARAMS(authtoken, bucketObject); - Returns the new bucket object - NOTES - -sub bucket_create { - my( $self, $client, $authtoken, $class, $bucket ) = @_; - - my $e = new_editor(xact=>1, authtoken=>$authtoken); - return $e->event unless $e->checkauth; - - if( $bucket->owner ne $e->requestor->id ) { - return $e->event unless - $e->allowed('CREATE_CONTAINER'); - - } else { - return $e->event unless - $e->allowed('CREATE_MY_CONTAINER'); - } - - $bucket->clear_id; - - my $evt = OpenILS::Event->new('CONTAINER_EXISTS', - payload => [$class, $bucket->owner, $bucket->btype, $bucket->name]); - my $search = {name => $bucket->name, owner => $bucket->owner, btype => $bucket->btype}; - - my $obj; - if( $class eq 'copy' ) { - return $evt if $e->search_container_copy_bucket($search)->[0]; - return $e->event unless - $obj = $e->create_container_copy_bucket($bucket); - } - - if( $class eq 'callnumber' ) { - return $evt if $e->search_container_call_number_bucket($search)->[0]; - return $e->event unless - $obj = $e->create_container_call_number_bucket($bucket); - } - - if( $class eq 'biblio' ) { - return $evt if $e->search_container_biblio_record_entry_bucket($search)->[0]; - return $e->event unless - $obj = $e->create_container_biblio_record_entry_bucket($bucket); - } - - if( $class eq 'user') { - return $evt if $e->search_container_user_bucket($search)->[0]; - return $e->event unless - $obj = $e->create_container_user_bucket($bucket); - } - - $e->commit; - return $obj->id; -} - - -__PACKAGE__->register_method( - method => "item_create", - api_name => "open-ils.actor.container.item.create", - signature => { - desc => q/ - Adds one or more items to an existing container - /, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Container class. Can be "copy", "callnumber", "biblio", or "user"', type => 'string'}, - {desc => 'Item or items. Can either be a single container item object, or an array of them', type => 'object'}, - ], - return => { - desc => 'The ID of the newly created item(s). In batch context, an array of IDs is returned' - } - } -); - - -sub item_create { - my( $self, $client, $authtoken, $class, $item ) = @_; - - my $e = new_editor(xact=>1, authtoken=>$authtoken); - return $e->die_event unless $e->checkauth; - my $items = (ref $item eq 'ARRAY') ? $item : [$item]; - - my ( $bucket, $evt ) = $apputils->fetch_container_e($e, $item->bucket, $class); - return $evt if $evt; - - if( $bucket->owner ne $e->requestor->id ) { - return $e->die_event unless - $e->allowed('CREATE_CONTAINER_ITEM'); - - } else { -# return $e->event unless -# $e->allowed('CREATE_CONTAINER_ITEM'); # new perm here? - } - - for my $one_item (@$items) { - - $one_item->clear_id; - - my $stat; - if( $class eq 'copy' ) { - return $e->die_event unless - $stat = $e->create_container_copy_bucket_item($one_item); - } - - if( $class eq 'callnumber' ) { - return $e->die_event unless - $stat = $e->create_container_call_number_bucket_item($one_item); - } - - if( $class eq 'biblio' ) { - return $e->die_event unless - $stat = $e->create_container_biblio_record_entry_bucket_item($one_item); - } - - if( $class eq 'user') { - return $e->die_event unless - $stat = $e->create_container_user_bucket_item($one_item); - } - } - - $e->commit; - - # CStoreEeditor inserts the id (pkey) on newly created objects - return [ map { $_->id } @$items ] if ref $item eq 'ARRAY'; - return $item->id; -} - - - -__PACKAGE__->register_method( - method => "item_delete", - api_name => "open-ils.actor.container.item.delete", - notes => <<" NOTES"); - PARAMS(authtoken, class, itemId) - NOTES - -sub item_delete { - my( $self, $client, $authtoken, $class, $itemid ) = @_; - - my $e = new_editor(xact=>1, authtoken=>$authtoken); - return $e->event unless $e->checkauth; - - my $ret = __item_delete($e, $class, $itemid); - $e->commit unless $U->event_code($ret); - return $ret; -} - -sub __item_delete { - my( $e, $class, $itemid ) = @_; - my( $bucket, $item, $evt); - - ( $item, $evt ) = $U->fetch_container_item_e( $e, $itemid, $class ); - return $evt if $evt; - - ( $bucket, $evt ) = $U->fetch_container_e($e, $item->bucket, $class); - return $evt if $evt; - - if( $bucket->owner ne $e->requestor->id ) { - my $owner = $e->retrieve_actor_user($bucket->owner) - or return $e->die_event; - return $e->event unless $e->allowed('DELETE_CONTAINER_ITEM', $owner->home_ou); - } - - my $stat; - if( $class eq 'copy' ) { - for my $note (@{$e->search_container_copy_bucket_item_note({item => $item->id})}) { - return $e->event unless - $e->delete_container_copy_bucket_item_note($note); - } - return $e->event unless - $stat = $e->delete_container_copy_bucket_item($item); - } - - if( $class eq 'callnumber' ) { - for my $note (@{$e->search_container_call_number_bucket_item_note({item => $item->id})}) { - return $e->event unless - $e->delete_container_call_number_bucket_item_note($note); - } - return $e->event unless - $stat = $e->delete_container_call_number_bucket_item($item); - } - - if( $class eq 'biblio' ) { - for my $note (@{$e->search_container_biblio_record_entry_bucket_item_note({item => $item->id})}) { - return $e->event unless - $e->delete_container_biblio_record_entry_bucket_item_note($note); - } - return $e->event unless - $stat = $e->delete_container_biblio_record_entry_bucket_item($item); - } - - if( $class eq 'user') { - for my $note (@{$e->search_container_user_bucket_item_note({item => $item->id})}) { - return $e->event unless - $e->delete_container_user_bucket_item_note($note); - } - return $e->event unless - $stat = $e->delete_container_user_bucket_item($item); - } - - return $stat; -} - - -__PACKAGE__->register_method( - method => 'full_delete', - api_name => 'open-ils.actor.container.full_delete', - notes => "Complety removes a container including all attached items", -); - -sub full_delete { - my( $self, $client, $authtoken, $class, $containerId ) = @_; - my( $container, $evt); - - my $e = new_editor(xact=>1, authtoken=>$authtoken); - return $e->event unless $e->checkauth; - - ( $container, $evt ) = $apputils->fetch_container_e($e, $containerId, $class); - return $evt if $evt; - - if( $container->owner ne $e->requestor->id ) { - my $owner = $e->retrieve_actor_user($container->owner) - or return $e->die_event; - return $e->event unless $e->allowed('DELETE_CONTAINER', $owner->home_ou); - } - - my $items; - - my @s = ({bucket => $containerId}, {idlist=>1}); - - if( $class eq 'copy' ) { - $items = $e->search_container_copy_bucket_item(@s); - } - - if( $class eq 'callnumber' ) { - $items = $e->search_container_call_number_bucket_item(@s); - } - - if( $class eq 'biblio' ) { - $items = $e->search_container_biblio_record_entry_bucket_item(@s); - } - - if( $class eq 'user') { - $items = $e->search_container_user_bucket_item(@s); - } - - __item_delete($e, $class, $_) for @$items; - - my $stat; - if( $class eq 'copy' ) { - return $e->event unless - $stat = $e->delete_container_copy_bucket($container); - } - - if( $class eq 'callnumber' ) { - return $e->event unless - $stat = $e->delete_container_call_number_bucket($container); - } - - if( $class eq 'biblio' ) { - return $e->event unless - $stat = $e->delete_container_biblio_record_entry_bucket($container); - } - - if( $class eq 'user') { - return $e->event unless - $stat = $e->delete_container_user_bucket($container); - } - - $e->commit; - return $stat; -} - -__PACKAGE__->register_method( - method => 'container_update', - api_name => 'open-ils.actor.container.update', - signature => q/ - Updates the given container item. - @param authtoken The login session key - @param class The container class - @param container The container item - @return true on success, 0 on no update, Event on error - / -); - -sub container_update { - my( $self, $conn, $authtoken, $class, $container ) = @_; - - my $e = new_editor(xact=>1, authtoken=>$authtoken); - return $e->event unless $e->checkauth; - - my ( $dbcontainer, $evt ) = $U->fetch_container_e($e, $container->id, $class); - return $evt if $evt; - - if( $e->requestor->id ne $container->owner ) { - return $e->event unless $e->allowed('UPDATE_CONTAINER'); - } - - my $stat; - if( $class eq 'copy' ) { - return $e->event unless - $stat = $e->update_container_copy_bucket($container); - } - - if( $class eq 'callnumber' ) { - return $e->event unless - $stat = $e->update_container_call_number_bucket($container); - } - - if( $class eq 'biblio' ) { - return $e->event unless - $stat = $e->update_container_biblio_record_entry_bucket($container); - } - - if( $class eq 'user') { - return $e->event unless - $stat = $e->update_container_user_bucket($container); - } - - $e->commit; - return $stat; -} - - - -__PACKAGE__->register_method( - method => "anon_cache", - api_name => "open-ils.actor.anon_cache.set_value", - signature => { - desc => q/ - Sets a value in the anon web cache. If the session key is - undefined, one will be automatically generated. - /, - params => [ - {desc => 'Session key', type => 'string'}, - { - desc => q/Field name. The name of the field in this cache session whose value to set/, - type => 'string' - }, - { - desc => q/The cached value. This can be any type of object (hash, array, string, etc.)/, - type => 'any' - }, - ], - return => { - desc => 'session key on success, undef on error', - type => 'string' - } - } -); - -__PACKAGE__->register_method( - method => "anon_cache", - api_name => "open-ils.actor.anon_cache.get_value", - signature => { - desc => q/ - Returns the cached data at the specified field within the specified cache session. - /, - params => [ - {desc => 'Session key', type => 'string'}, - { - desc => q/Field name. The name of the field in this cache session whose value to set/, - type => 'string' - }, - ], - return => { - desc => 'cached value on success, undef on error', - type => 'any' - } - } -); - -__PACKAGE__->register_method( - method => "anon_cache", - api_name => "open-ils.actor.anon_cache.delete_session", - signature => { - desc => q/ - Deletes a cache session. - /, - params => [ - {desc => 'Session key', type => 'string'}, - ], - return => { - desc => 'Session key', - type => 'string' - } - } -); - -sub anon_cache { - my($self, $conn, $ses_key, $field_key, $value) = @_; - - my $sc = OpenSRF::Utils::SettingsClient->new; - my $cache = OpenSRF::Utils::Cache->new('anon'); - my $cache_timeout = $sc->config_value(cache => anon => 'max_cache_time') || 1800; # 30 minutes - my $cache_size = $sc->config_value(cache => anon => 'max_cache_size') || 102400; # 100k - - if($self->api_name =~ /delete_session/) { - - return $cache->delete_cache($ses_key); - - } elsif( $self->api_name =~ /set_value/ ) { - - $ses_key = md5_hex(time . rand($$)) unless $ses_key; - my $blob = $cache->get_cache($ses_key) || {}; - $blob->{$field_key} = $value; - return undef if - length(OpenSRF::Utils::JSON->perl2JSON($blob)) > $cache_size; # bytes, characters, whatever ;) - $cache->put_cache($ses_key, $blob, $cache_timeout); - return $ses_key; - - } else { - - my $blob = $cache->get_cache($ses_key) or return undef; - return $blob if (!defined($field_key)); - return $blob->{$field_key}; - } -} - - - -1; - - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Actor/Friends.pm b/Open-ILS/src/perlmods/OpenILS/Application/Actor/Friends.pm deleted file mode 100644 index 629c3cd682..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Actor/Friends.pm +++ /dev/null @@ -1,209 +0,0 @@ -package OpenILS::Application::Actor::Friends; -use strict; use warnings; -use OpenILS::Application::AppUtils; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenSRF::Utils::Logger q/$logger/; -use OpenILS::Utils::Fieldmapper; -my $U = "OpenILS::Application::AppUtils"; - -# ---------------------------------------------------------------- -# Shared Friend utilities. Thar be no methods published here... -# ---------------------------------------------------------------- - -# export these fields for friend display -my @expose_user_fields = qw/id usrname first_given_name second_given_name family_name alias/; - -my $out_links_query = { - select => {cubi => ['target_user']}, - from => { - cub => { - cubi => {field => 'bucket', fkey => 'id'} - } - }, - where => { - '+cub' => {btype => 'folks', owner => undef} - } -}; - -my $in_links_query = { - select => {cub => ['owner'] }, - from => { - cub => { - cubi => {field => 'bucket', fkey => 'id'} - } - }, - where => { - '+cubi' => {target_user => undef}, - '+cub' => {btype => 'folks'} - } -}; - -my $perm_check_query = { - select => {cub => ['btype'] }, - from => { - cub => { - cubi => {field => 'bucket', fkey => 'id'} - } - }, -}; - -sub retrieve_friends { - my($self, $e, $user_id, $options) = @_; - $options ||= {}; - - # users I have links to - $out_links_query->{where}->{'+cub'}->{owner} = $user_id; - my @out_linked = map {$_->{target_user}} @{$e->json_query($out_links_query)}; - - # users who link to me - $in_links_query->{where}->{'+cubi'}->{target_user} = $user_id; - my @in_linked = map {$_->{owner}} @{$e->json_query($in_links_query)}; - - # determine which users are confirmed, pending outbound - # requests, and pending inbound requests - my @confirmed; - my @pending_out; - my @pending_in; - - for my $out_link (@out_linked) { - if(grep {$_ == $out_link} @in_linked) { - push(@confirmed, $out_link); - } else { - push(@pending_out, $out_link); - } - } - - for my $in_link (@in_linked) { - push(@pending_in, $in_link) - unless grep {$_ == $in_link} @confirmed; - } - - if($$options{confirmed_only}) { - return { - confirmed => $self->load_linked_user_perms($e, $user_id, @confirmed), - }; - } else { - return { - confirmed => $self->load_linked_user_perms($e, $user_id, @confirmed), - pending_out => $self->load_linked_user_perms($e, $user_id, @pending_out), - pending_in => $self->load_linked_user_perms($e, $user_id, @pending_in) - }; - } -} - -# given a base user and set of linked users, returns the trimmed linked user -# records, plus the perms (by name) each user has been granted -sub load_linked_user_perms { - my($self, $e, $user_id, @users) = @_; - my $items = []; - - # use this query to retrieve trimmed linked user objects - my $user_select = - {select => {au => \@expose_user_fields}, from => 'au', where => undef}; - - for my $d_user (@users) { - - # fetch all of the bucket items linked from base user to - # delegate user with the folks: prefix on the bucket type - $perm_check_query->{where} = { - '+cubi' => {target_user => $d_user}, - '+cub' => {btype => {like => 'folks:%'}, owner => $user_id} - }; - - my $perms_granted = [ - map {substr($_->{btype}, 6)} @{$e->json_query($perm_check_query)}]; - - # fetch all of the bucket items linked from the delegate user - # to the base user with the folks: prefix on the bucket type - $perm_check_query->{where} = { - '+cubi' => {target_user => $user_id}, - '+cub' => {btype => {like => 'folks:%'}, owner => $d_user} - }; - - my $perms_received = [ - map {substr($_->{btype}, 6)} @{$e->json_query($perm_check_query)}]; - - $user_select->{where} = {id => $d_user}; - push(@$items, { - user => $e->json_query($user_select)->[0], - perms_granted => $perms_granted, - perms_received => $perms_received - } - ); - } - return $items; -} - - -my $direct_links_query = { - select => {cub => ['id'] }, - from => { - cub => { - cubi => {field => 'bucket', fkey => 'id'} - } - }, - where => { - '+cubi' => {target_user => undef}, - '+cub' => {btype => 'folks', owner => undef} - }, - limit => 1 -}; - -sub confirmed_friends { - my($self, $e, $user1_id, $user2_id) = @_; - - $direct_links_query->{where}->{'+cub'}->{owner} = $user1_id; - $direct_links_query->{where}->{'+cubi'}->{target_user} = $user2_id; - - if($e->json_query($direct_links_query)->[0]) { - - $direct_links_query->{where}->{'+cub'}->{owner} = $user2_id; - $direct_links_query->{where}->{'+cubi'}->{target_user} = $user1_id; - return 1 if $e->json_query($direct_links_query)->[0]; - } - - return 0; -} - - - -# returns 1 if delegate_user is allowed to perform 'perm' for base_user -sub friend_perm_allowed { - my($self, $e, $base_user_id, $delegate_user_id, $perm) = @_; - return 0 unless $self->confirmed_friends($e, $base_user_id, $delegate_user_id); - $perm_check_query->{where} = { - '+cubi' => {target_user => $delegate_user_id}, - '+cub' => {btype => "folks:$perm", owner => $base_user_id} - }; - return 1 if $e->json_query($perm_check_query)->[0]; - return 0; -} - -sub apply_friend_perm { - my($self, $e, $base_user_id, $delegate_user_id, $perm) = @_; - - my $bucket = $e->search_container_user_bucket( - {owner => $base_user_id, btype => "folks:$perm"})->[0]; - - if($bucket) { - # is the permission already set? - return undef if $e->search_container_user_bucket_item( - {bucket => $bucket->id, target_user => $delegate_user_id})->[0]; - - } else { - # make sure the perm-specific bucket exists for this user - $bucket = Fieldmapper::container::user_bucket->new; - $bucket->owner($base_user_id); - $bucket->btype("folks:$perm"); - $bucket->name("folks:$perm"); - $e->create_container_user_bucket($bucket) or return $e->die_event; - } - - my $item = Fieldmapper::container::user_bucket_item->new; - $item->bucket($bucket->id); - $item->target_user($delegate_user_id); - $e->create_container_user_bucket_item($item) or return $e->die_event; - return undef; -} - -23; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Actor/Stage.pm b/Open-ILS/src/perlmods/OpenILS/Application/Actor/Stage.pm deleted file mode 100644 index 0e65c12c25..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Actor/Stage.pm +++ /dev/null @@ -1,176 +0,0 @@ -package OpenILS::Application::Actor::Stage; -use strict; use warnings; -use base 'OpenILS::Application'; -use OpenILS::Application::AppUtils; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenSRF::Utils::Logger q/$logger/; -use OpenILS::Utils::Fieldmapper; -my $U = "OpenILS::Application::AppUtils"; - - -__PACKAGE__->register_method ( - method => 'create_user_stage', - api_name => 'open-ils.actor.user.stage.create', - signature => { - desc => q/ - Creates a new pending user account including addresses and statcats. - Users are added to staging tables pending staff review. - /, - params => [ - {desc => 'user', type => 'object', class => 'stgu'}, - {desc => 'Mailing address. Optional', type => 'object', class => 'stgma'}, - {desc => 'Billing address. Optional', type => 'object', class => 'stgba'}, - {desc => 'Statcats. Optional. This is an array of "stgsc" objects', type => 'array'}, - ], - return => { - desc => 'username on success, Event on error', - type => '' - } - - } -); - -sub create_user_stage { - my($self, $conn, $user, $mail_addr, $bill_addr, $statcats) = @_; # more? - - return 0 unless $U->ou_ancestor_setting_value('opac.allow_pending_user'); - return OpenILS::Event->new('BAD_PARAMS') unless $user; - - my $e = new_editor(xact => 1); - - my $uname = $U->create_uuid_string; - $user->usrname($uname); - - $e->create_staging_user_stage($user) or return $e->die_event; - - if($mail_addr) { - $mail_addr->usrname($uname); - $e->create_staging_mailing_address_stage($mail_addr) or return $e->die_event; - } - - if($bill_addr) { - $bill_addr->usrname($uname); - $e->create_staging_billing_address_stage($bill_addr) or return $e->die_event; - } - - if($statcats) { - foreach (@$statcats) { - $_->usrname($uname); - $e->create_staging_statcat_stage($_) or return $e->die_event; - } - } - - $e->commit; - $conn->respond_complete($uname); - - $U->create_events_for_hook('stgu.create', $user, $user->home_ou); - return undef; -} - -__PACKAGE__->register_method ( - method => 'user_stage_by_org', - api_name => 'open-ils.actor.user.stage.retrieve.by_org', - stream => 1 -); - -sub user_stage_by_org { - my($self, $conn, $auth, $org_id, $limit, $offset) = @_; - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - $org_id ||= $e->requestor->ws_ou; - return $e->event unless $e->allowed('VIEW_USER', $org_id); - - $limit ||= 100; - $offset ||= 0; - - my $stage_ids = $e->search_staging_user_stage( - [ - { home_ou => $org_id, complete => 'f'}, - { limit => $limit, - offset => $offset, - order_by => {stgu => 'row_id'} - } - ], - {idlist => 1} - ); - - $conn->respond(flesh_user_stage($e, $_)) for @$stage_ids; - return undef; -} - -sub flesh_user_stage { - my($e, $row_id) = @_; - my $user = $e->retrieve_staging_user_stage($row_id) or return undef; - return { - user => $user, - billing_addresses => $e->search_staging_billing_address_stage({usrname => $user->usrname}), - mailing_addresses => $e->search_staging_mailing_address_stage({usrname => $user->usrname}), - cards => $e->search_staging_card_stage({usrname => $user->usrname}), - statcats => $e->search_staging_statcat_stage({usrname => $user->usrname}) - }; -} - - -__PACKAGE__->register_method ( - method => 'user_stage_by_uname', - api_name => 'open-ils.actor.user.stage.retrieve.by_username', -); - -sub user_stage_by_uname { - my($self, $conn, $auth, $username) = @_; - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - my $user = $e->search_staging_user_stage({ - usrname => $username, - complete => 'f' - })->[0] or return $e->event; - - return $e->event unless $e->allowed('VIEW_USER', $user->home_ou); - return flesh_user_stage($e, $user->row_id); -} - - - - -__PACKAGE__->register_method ( - method => 'delete_user_stage', - api_name => 'open-ils.actor.user.stage.delete', -); - -sub delete_user_stage { - my($self, $conn, $auth, $row_id) = @_; - - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - my $data = flesh_user_stage($e, $row_id) or return $e->die_event; - - return $e->die_event unless $e->allowed('UPDATE_USER', $data->{user}->home_ou); - - $e->delete_staging_user_stage($data->{user}) or return $e->die_event; - - for my $addr (@{$data->{mailing_addresses}}) { - $e->delete_staging_mailing_address_stage($addr) or return $e->die_event; - } - - for my $addr (@{$data->{billing_addresses}}) { - $e->delete_staging_billing_address_stage($addr) or return $e->die_event; - } - - for my $card (@{$data->{cards}}) { - $e->delete_staging_card_stage($card) or return $e->die_event; - } - - for my $statcat (@{$data->{statcats}}) { - $e->delete_staging_statcat_stage($statcat) or return $e->die_event; - } - - $e->commit; - return 1; -} - - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Actor/UserGroups.pm b/Open-ILS/src/perlmods/OpenILS/Application/Actor/UserGroups.pm deleted file mode 100644 index 7691fe5c94..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Actor/UserGroups.pm +++ /dev/null @@ -1,152 +0,0 @@ -package OpenILS::Application::Actor::UserGroups; -use base 'OpenILS::Application'; -use strict; use warnings; -use OpenILS::Application::AppUtils; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenSRF::Utils::Logger q/$logger/; -use OpenSRF::EX qw(:try); -my $U = "OpenILS::Application::AppUtils"; - -sub initialize { return 1; } - - - -__PACKAGE__->register_method( - method => 'group_money_summary', - api_name => 'open-ils.actor.usergroup.members.balance_owed', - authoritative => 1, - signature => q/ - / -); - -sub group_money_summary { - my($self, $conn, $auth, $group_id) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_USER'); - - my $users = $e->search_actor_user({usrgroup => $group_id}, {idlist => 1}); - my @mous; - - for my $uid ( @$users ) { - push @mous, @{$e->json_query( - { - select => {mous => ['usr', 'balance_owed']}, - from => 'mous', - where => { usr => $uid } - } - )}; - } - - return \@mous; -} - - -__PACKAGE__->register_method( - method => 'get_users_from_usergroup', - api_name => 'open-ils.actor.usergroup.members.retrieve', - authoritative => 1, - signature => q/ - Returns a list of ids for users that are in the given usergroup - / -); - -sub get_users_from_usergroup { - my( $self, $conn, $auth, $usergroup ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_USER'); # XXX reley on editor perm - return $e->search_actor_user({usrgroup => $usergroup}, {idlist => 1}); -} - - - -__PACKAGE__->register_method( - method => 'get_leaders_from_usergroup', - api_name => 'open-ils.actor.usergroup.leaders.retrieve', - signature => q/ - Returns a list of ids for users that are leaders of the given usergroup - / -); - -sub get_leaders_from_usergroup { - my( $self, $conn, $auth, $usergroup ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_USER'); # XXX reley on editor perm - my $users = $e->search_actor_user({usrgroup => $usergroup}) - or return $e->event; - - my @res; - for my $u (@$users) { - push( @res, $u->id ) if $u->master_account; - } - - return \@res; -} - - - -__PACKAGE__->register_method( - method => 'get_address_members', - api_name => 'open-ils.actor.address.members', - signature => q/ - Returns a list of ids for users that link to the given address - @param auth - @param addrid The address id - / -); - -sub get_address_members { - my( $self, $conn, $auth, $addrid ) = @_; - - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_USER'); # XXX reley on editor perm - - my $ad = $e->retrieve_actor_user_address($addrid) or return $e->event; - my $ma = $e->search_actor_user({mailing_address => $addrid}, {idlist => 1}); - my $ba = $e->search_actor_user({billing_address => $addrid}, {idlist => 1}); - - my @list = (@$ma, @$ba, $ad->usr); - my %dedup = map { $_ => 1 } @list; - return [ keys %dedup ]; -} - - - -__PACKAGE__->register_method( - method => 'reset_group', - api_name => 'open-ils.actor.usergroup.new', - signature => q/ - Gives the requested user a new empty usergroup. - @param auth The auth token - @param userid The id of the user who needs the new usergroup - @param leader If true, this user will be marked as the group leader - / -); - -sub reset_group { - my( $self, $conn, $auth, $userid, $leader ) = @_; - - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('UPDATE_USER'); # XXX reley on editor perm - - my $user = $e->retrieve_actor_user($userid) or return $e->die_event; - - # ask for a new group id - my $groupid = $U->storagereq('open-ils.storage.actor.user.group_id.new'); - - $user->usrgroup($groupid); - $user->master_account('t') if $leader; - - $e->update_actor_user($user) or return $e->die_event; - $e->commit; - return $groupid; -} - - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/AppUtils.pm b/Open-ILS/src/perlmods/OpenILS/Application/AppUtils.pm deleted file mode 100644 index ec5c56fd93..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/AppUtils.pm +++ /dev/null @@ -1,1801 +0,0 @@ -package OpenILS::Application::AppUtils; -# vim:noet:ts=4 -use strict; use warnings; -use OpenILS::Application; -use base qw/OpenILS::Application/; -use OpenSRF::Utils::Cache; -use OpenSRF::Utils::Logger qw/$logger/; -use OpenILS::Utils::ModsParser; -use OpenSRF::EX qw(:try); -use OpenILS::Event; -use Data::Dumper; -use OpenILS::Utils::CStoreEditor; -use OpenILS::Const qw/:const/; -use Unicode::Normalize; -use OpenSRF::Utils::SettingsClient; -use UUID::Tiny; -use Encode; - -# --------------------------------------------------------------------------- -# Pile of utilty methods used accross applications. -# --------------------------------------------------------------------------- -my $cache_client = "OpenSRF::Utils::Cache"; - - -# --------------------------------------------------------------------------- -# on sucess, returns the created session, on failure throws ERROR exception -# --------------------------------------------------------------------------- -sub start_db_session { - - my $self = shift; - my $session = OpenSRF::AppSession->connect( "open-ils.storage" ); - my $trans_req = $session->request( "open-ils.storage.transaction.begin" ); - - my $trans_resp = $trans_req->recv(); - if(ref($trans_resp) and UNIVERSAL::isa($trans_resp,"Error")) { throw $trans_resp; } - if( ! $trans_resp->content() ) { - throw OpenSRF::ERROR - ("Unable to Begin Transaction with database" ); - } - $trans_req->finish(); - - $logger->debug("Setting global storage session to ". - "session: " . $session->session_id . " : " . $session->app ); - - return $session; -} - -my $PERM_QUERY = { - select => { - au => [ { - transform => 'permission.usr_has_perm', - alias => 'has_perm', - column => 'id', - params => [] - } ] - }, - from => 'au', - where => {}, -}; - - -# returns undef if user has all of the perms provided -# returns the first failed perm on failure -sub check_user_perms { - my($self, $user_id, $org_id, @perm_types ) = @_; - $logger->debug("Checking perms with user : $user_id , org: $org_id, @perm_types"); - - for my $type (@perm_types) { - $PERM_QUERY->{select}->{au}->[0]->{params} = [$type, $org_id]; - $PERM_QUERY->{where}->{id} = $user_id; - return $type unless $self->is_true(OpenILS::Utils::CStoreEditor->new->json_query($PERM_QUERY)->[0]->{has_perm}); - } - return undef; -} - -# checks the list of user perms. The first one that fails returns a new -sub check_perms { - my( $self, $user_id, $org_id, @perm_types ) = @_; - my $t = $self->check_user_perms( $user_id, $org_id, @perm_types ); - return OpenILS::Event->new('PERM_FAILURE', ilsperm => $t, ilspermloc => $org_id ) if $t; - return undef; -} - - - -# --------------------------------------------------------------------------- -# commits and destroys the session -# --------------------------------------------------------------------------- -sub commit_db_session { - my( $self, $session ) = @_; - - my $req = $session->request( "open-ils.storage.transaction.commit" ); - my $resp = $req->recv(); - - if(!$resp) { - throw OpenSRF::EX::ERROR ("Unable to commit db session"); - } - - if(UNIVERSAL::isa($resp,"Error")) { - throw $resp ($resp->stringify); - } - - if(!$resp->content) { - throw OpenSRF::EX::ERROR ("Unable to commit db session"); - } - - $session->finish(); - $session->disconnect(); - $session->kill_me(); -} - -sub rollback_db_session { - my( $self, $session ) = @_; - - my $req = $session->request("open-ils.storage.transaction.rollback"); - my $resp = $req->recv(); - if(UNIVERSAL::isa($resp,"Error")) { throw $resp; } - - $session->finish(); - $session->disconnect(); - $session->kill_me(); -} - - -# returns undef it the event is not an ILS event -# returns the event code otherwise -sub event_code { - my( $self, $evt ) = @_; - return $evt->{ilsevent} if( ref($evt) eq 'HASH' and defined($evt->{ilsevent})) ; - return undef; -} - -# --------------------------------------------------------------------------- -# Checks to see if a user is logged in. Returns the user record on success, -# throws an exception on error. -# --------------------------------------------------------------------------- -sub check_user_session { - my( $self, $user_session ) = @_; - - my $content = $self->simplereq( - 'open-ils.auth', - 'open-ils.auth.session.retrieve', $user_session); - - return undef if (!$content) or $self->event_code($content); - return $content; -} - -# generic simple request returning a scalar value -sub simplereq { - my($self, $service, $method, @params) = @_; - return $self->simple_scalar_request($service, $method, @params); -} - - -sub simple_scalar_request { - my($self, $service, $method, @params) = @_; - - my $session = OpenSRF::AppSession->create( $service ); - - my $request = $session->request( $method, @params ); - - my $val; - my $err; - try { - - $val = $request->gather(1); - - } catch Error with { - $err = shift; - }; - - if( $err ) { - warn "received error : service=$service : method=$method : params=".Dumper(\@params) . "\n $err"; - throw $err ("Call to $service for method $method \n failed with exception: $err : " ); - } - - return $val; -} - - - - - -my $tree = undef; -my $orglist = undef; -my $org_typelist = undef; -my $org_typelist_hash = {}; - -sub __get_org_tree { - - # can we throw this version away?? - - my $self = shift; - if($tree) { return $tree; } - - # see if it's in the cache - $tree = $cache_client->new()->get_cache('_orgtree'); - if($tree) { return $tree; } - - if(!$orglist) { - warn "Retrieving Org Tree\n"; - $orglist = $self->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.actor.org_unit.search.atomic", - { id => { '!=' => undef } } - ); - } - - if( ! $org_typelist ) { - warn "Retrieving org types\n"; - $org_typelist = $self->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.actor.org_unit_type.search.atomic", - { id => { '!=' => undef } } - ); - $self->build_org_type($org_typelist); - } - - $tree = $self->build_org_tree($orglist,1); - $cache_client->new()->put_cache('_orgtree', $tree); - return $tree; - -} - -my $slimtree = undef; -sub get_slim_org_tree { - - my $self = shift; - if($slimtree) { return $slimtree; } - - # see if it's in the cache - $slimtree = $cache_client->new()->get_cache('slimorgtree'); - if($slimtree) { return $slimtree; } - - if(!$orglist) { - warn "Retrieving Org Tree\n"; - $orglist = $self->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.actor.org_unit.search.atomic", - { id => { '!=' => undef } } - ); - } - - $slimtree = $self->build_org_tree($orglist); - $cache_client->new->put_cache('slimorgtree', $slimtree); - return $slimtree; - -} - - -sub build_org_type { - my($self, $org_typelist) = @_; - for my $type (@$org_typelist) { - $org_typelist_hash->{$type->id()} = $type; - } -} - - - -sub build_org_tree { - - my( $self, $orglist, $add_types ) = @_; - - return $orglist unless ref $orglist; - return $$orglist[0] if @$orglist == 1; - - my @list = sort { - $a->ou_type <=> $b->ou_type || - $a->name cmp $b->name } @$orglist; - - for my $org (@list) { - - next unless ($org); - - if(!ref($org->ou_type()) and $add_types) { - $org->ou_type( $org_typelist_hash->{$org->ou_type()}); - } - - next if (!defined($org->parent_ou) || $org->parent_ou eq ""); - - my ($parent) = grep { $_->id == $org->parent_ou } @list; - next unless $parent; - $parent->children([]) unless defined($parent->children); - push( @{$parent->children}, $org ); - } - - return $list[0]; -} - -sub fetch_closed_date { - my( $self, $cd ) = @_; - my $evt; - - $logger->debug("Fetching closed_date $cd from cstore"); - - my $cd_obj = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.actor.org_unit.closed_date.retrieve', $cd ); - - if(!$cd_obj) { - $logger->info("closed_date $cd not found in the db"); - $evt = OpenILS::Event->new('ACTOR_USER_NOT_FOUND'); - } - - return ($cd_obj, $evt); -} - -sub fetch_user { - my( $self, $userid ) = @_; - my( $user, $evt ); - - $logger->debug("Fetching user $userid from cstore"); - - $user = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.actor.user.retrieve', $userid ); - - if(!$user) { - $logger->info("User $userid not found in the db"); - $evt = OpenILS::Event->new('ACTOR_USER_NOT_FOUND'); - } - - return ($user, $evt); -} - -sub checkses { - my( $self, $session ) = @_; - my $user = $self->check_user_session($session) or - return (undef, OpenILS::Event->new('NO_SESSION')); - return ($user); -} - - -# verifiese the session and checks the permissions agains the -# session user and the user's home_ou as the org id -sub checksesperm { - my( $self, $session, @perms ) = @_; - my $user; my $evt; my $e; - $logger->debug("Checking user session $session and perms @perms"); - ($user, $evt) = $self->checkses($session); - return (undef, $evt) if $evt; - $evt = $self->check_perms($user->id, $user->home_ou, @perms); - return ($user, $evt); -} - - -sub checkrequestor { - my( $self, $staffobj, $userid, @perms ) = @_; - my $user; my $evt; - $userid = $staffobj->id unless defined $userid; - - $logger->debug("checkrequestor(): requestor => " . $staffobj->id . ", target => $userid"); - - if( $userid ne $staffobj->id ) { - ($user, $evt) = $self->fetch_user($userid); - return (undef, $evt) if $evt; - $evt = $self->check_perms( $staffobj->id, $user->home_ou, @perms ); - - } else { - $user = $staffobj; - } - - return ($user, $evt); -} - -sub checkses_requestor { - my( $self, $authtoken, $targetid, @perms ) = @_; - my( $requestor, $target, $evt ); - - ($requestor, $evt) = $self->checkses($authtoken); - return (undef, undef, $evt) if $evt; - - ($target, $evt) = $self->checkrequestor( $requestor, $targetid, @perms ); - return( $requestor, $target, $evt); -} - -sub fetch_copy { - my( $self, $copyid ) = @_; - my( $copy, $evt ); - - $logger->debug("Fetching copy $copyid from cstore"); - - $copy = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.asset.copy.retrieve', $copyid ); - - if(!$copy) { $evt = OpenILS::Event->new('ASSET_COPY_NOT_FOUND'); } - - return( $copy, $evt ); -} - - -# retrieves a circ object by id -sub fetch_circulation { - my( $self, $circid ) = @_; - my $circ; my $evt; - - $logger->debug("Fetching circ $circid from cstore"); - - $circ = $self->simplereq( - 'open-ils.cstore', - "open-ils.cstore.direct.action.circulation.retrieve", $circid ); - - if(!$circ) { - $evt = OpenILS::Event->new('ACTION_CIRCULATION_NOT_FOUND', circid => $circid ); - } - - return ( $circ, $evt ); -} - -sub fetch_record_by_copy { - my( $self, $copyid ) = @_; - my( $record, $evt ); - - $logger->debug("Fetching record by copy $copyid from cstore"); - - $record = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.asset.copy.retrieve', $copyid, - { flesh => 3, - flesh_fields => { bre => [ 'fixed_fields' ], - acn => [ 'record' ], - acp => [ 'call_number' ], - } - } - ); - - if(!$record) { - $evt = OpenILS::Event->new('BIBLIO_RECORD_ENTRY_NOT_FOUND'); - } else { - $record = $record->call_number->record; - } - - return ($record, $evt); -} - -# turns a record object into an mvr (mods) object -sub record_to_mvr { - my( $self, $record ) = @_; - return undef unless $record and $record->marc; - my $u = OpenILS::Utils::ModsParser->new(); - $u->start_mods_batch( $record->marc ); - my $mods = $u->finish_mods_batch(); - $mods->doc_id($record->id); - $mods->tcn($record->tcn_value); - return $mods; -} - -sub fetch_hold { - my( $self, $holdid ) = @_; - my( $hold, $evt ); - - $logger->debug("Fetching hold $holdid from cstore"); - - $hold = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.action.hold_request.retrieve', $holdid); - - $evt = OpenILS::Event->new('ACTION_HOLD_REQUEST_NOT_FOUND', holdid => $holdid) unless $hold; - - return ($hold, $evt); -} - - -sub fetch_hold_transit_by_hold { - my( $self, $holdid ) = @_; - my( $transit, $evt ); - - $logger->debug("Fetching transit by hold $holdid from cstore"); - - $transit = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.action.hold_transit_copy.search', { hold => $holdid } ); - - $evt = OpenILS::Event->new('ACTION_HOLD_TRANSIT_COPY_NOT_FOUND', holdid => $holdid) unless $transit; - - return ($transit, $evt ); -} - -# fetches the captured, but not fulfilled hold attached to a given copy -sub fetch_open_hold_by_copy { - my( $self, $copyid ) = @_; - $logger->debug("Searching for active hold for copy $copyid"); - my( $hold, $evt ); - - $hold = $self->cstorereq( - 'open-ils.cstore.direct.action.hold_request.search', - { - current_copy => $copyid , - capture_time => { "!=" => undef }, - fulfillment_time => undef, - cancel_time => undef, - } ); - - $evt = OpenILS::Event->new('ACTION_HOLD_REQUEST_NOT_FOUND', copyid => $copyid) unless $hold; - return ($hold, $evt); -} - -sub fetch_hold_transit { - my( $self, $transid ) = @_; - my( $htransit, $evt ); - $logger->debug("Fetching hold transit with hold id $transid"); - $htransit = $self->cstorereq( - 'open-ils.cstore.direct.action.hold_transit_copy.retrieve', $transid ); - $evt = OpenILS::Event->new('ACTION_HOLD_TRANSIT_COPY_NOT_FOUND', id => $transid) unless $htransit; - return ($htransit, $evt); -} - -sub fetch_copy_by_barcode { - my( $self, $barcode ) = @_; - my( $copy, $evt ); - - $logger->debug("Fetching copy by barcode $barcode from cstore"); - - $copy = $self->simplereq( 'open-ils.cstore', - 'open-ils.cstore.direct.asset.copy.search', { barcode => $barcode, deleted => 'f'} ); - #'open-ils.storage.direct.asset.copy.search.barcode', $barcode ); - - $evt = OpenILS::Event->new('ASSET_COPY_NOT_FOUND', barcode => $barcode) unless $copy; - - return ($copy, $evt); -} - -sub fetch_open_billable_transaction { - my( $self, $transid ) = @_; - my( $transaction, $evt ); - - $logger->debug("Fetching open billable transaction $transid from cstore"); - - $transaction = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.money.open_billable_transaction_summary.retrieve', $transid); - - $evt = OpenILS::Event->new( - 'MONEY_OPEN_BILLABLE_TRANSACTION_SUMMARY_NOT_FOUND', transid => $transid ) unless $transaction; - - return ($transaction, $evt); -} - - - -my %buckets; -$buckets{'biblio'} = 'biblio_record_entry_bucket'; -$buckets{'callnumber'} = 'call_number_bucket'; -$buckets{'copy'} = 'copy_bucket'; -$buckets{'user'} = 'user_bucket'; - -sub fetch_container { - my( $self, $id, $type ) = @_; - my( $bucket, $evt ); - - $logger->debug("Fetching container $id with type $type"); - - my $e = 'CONTAINER_CALL_NUMBER_BUCKET_NOT_FOUND'; - $e = 'CONTAINER_BIBLIO_RECORD_ENTRY_BUCKET_NOT_FOUND' if $type eq 'biblio'; - $e = 'CONTAINER_USER_BUCKET_NOT_FOUND' if $type eq 'user'; - $e = 'CONTAINER_COPY_BUCKET_NOT_FOUND' if $type eq 'copy'; - - my $meth = $buckets{$type}; - $bucket = $self->simplereq( - 'open-ils.cstore', - "open-ils.cstore.direct.container.$meth.retrieve", $id ); - - $evt = OpenILS::Event->new( - $e, container => $id, container_type => $type ) unless $bucket; - - return ($bucket, $evt); -} - - -sub fetch_container_e { - my( $self, $editor, $id, $type ) = @_; - - my( $bucket, $evt ); - $bucket = $editor->retrieve_container_copy_bucket($id) if $type eq 'copy'; - $bucket = $editor->retrieve_container_call_number_bucket($id) if $type eq 'callnumber'; - $bucket = $editor->retrieve_container_biblio_record_entry_bucket($id) if $type eq 'biblio'; - $bucket = $editor->retrieve_container_user_bucket($id) if $type eq 'user'; - - $evt = $editor->event unless $bucket; - return ($bucket, $evt); -} - -sub fetch_container_item_e { - my( $self, $editor, $id, $type ) = @_; - - my( $bucket, $evt ); - $bucket = $editor->retrieve_container_copy_bucket_item($id) if $type eq 'copy'; - $bucket = $editor->retrieve_container_call_number_bucket_item($id) if $type eq 'callnumber'; - $bucket = $editor->retrieve_container_biblio_record_entry_bucket_item($id) if $type eq 'biblio'; - $bucket = $editor->retrieve_container_user_bucket_item($id) if $type eq 'user'; - - $evt = $editor->event unless $bucket; - return ($bucket, $evt); -} - - - - - -sub fetch_container_item { - my( $self, $id, $type ) = @_; - my( $bucket, $evt ); - - $logger->debug("Fetching container item $id with type $type"); - - my $meth = $buckets{$type} . "_item"; - - $bucket = $self->simplereq( - 'open-ils.cstore', - "open-ils.cstore.direct.container.$meth.retrieve", $id ); - - - my $e = 'CONTAINER_CALL_NUMBER_BUCKET_ITEM_NOT_FOUND'; - $e = 'CONTAINER_BIBLIO_RECORD_ENTRY_BUCKET_ITEM_NOT_FOUND' if $type eq 'biblio'; - $e = 'CONTAINER_USER_BUCKET_ITEM_NOT_FOUND' if $type eq 'user'; - $e = 'CONTAINER_COPY_BUCKET_ITEM_NOT_FOUND' if $type eq 'copy'; - - $evt = OpenILS::Event->new( - $e, itemid => $id, container_type => $type ) unless $bucket; - - return ($bucket, $evt); -} - - -sub fetch_patron_standings { - my $self = shift; - $logger->debug("Fetching patron standings"); - return $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.config.standing.search.atomic', { id => { '!=' => undef } }); -} - - -sub fetch_permission_group_tree { - my $self = shift; - $logger->debug("Fetching patron profiles"); - return $self->simplereq( - 'open-ils.actor', - 'open-ils.actor.groups.tree.retrieve' ); -} - -sub fetch_permission_group_descendants { - my( $self, $profile ) = @_; - my $group_tree = $self->fetch_permission_group_tree(); - my $start_here; - my @groups; - - # FIXME: okay, so it's not an org tree, but it is compatible - $self->walk_org_tree($group_tree, sub { - my $g = shift; - if ($g->id == $profile) { - $start_here = $g; - } - }); - - $self->walk_org_tree($start_here, sub { - my $g = shift; - push(@groups,$g->id); - }); - - return \@groups; -} - -sub fetch_patron_circ_summary { - my( $self, $userid ) = @_; - $logger->debug("Fetching patron summary for $userid"); - my $summary = $self->simplereq( - 'open-ils.storage', - "open-ils.storage.action.circulation.patron_summary", $userid ); - - if( $summary ) { - $summary->[0] ||= 0; - $summary->[1] ||= 0.0; - return $summary; - } - return undef; -} - - -sub fetch_copy_statuses { - my( $self ) = @_; - $logger->debug("Fetching copy statuses"); - return $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.config.copy_status.search.atomic', { id => { '!=' => undef } }); -} - -sub fetch_copy_location { - my( $self, $id ) = @_; - my $evt; - my $cl = $self->cstorereq( - 'open-ils.cstore.direct.asset.copy_location.retrieve', $id ); - $evt = OpenILS::Event->new('ASSET_COPY_LOCATION_NOT_FOUND') unless $cl; - return ($cl, $evt); -} - -sub fetch_copy_locations { - my $self = shift; - return $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.asset.copy_location.search.atomic', { id => { '!=' => undef } }); -} - -sub fetch_copy_location_by_name { - my( $self, $name, $org ) = @_; - my $evt; - my $cl = $self->cstorereq( - 'open-ils.cstore.direct.asset.copy_location.search', - { name => $name, owning_lib => $org } ); - $evt = OpenILS::Event->new('ASSET_COPY_LOCATION_NOT_FOUND') unless $cl; - return ($cl, $evt); -} - -sub fetch_callnumber { - my( $self, $id ) = @_; - my $evt = undef; - - my $e = OpenILS::Event->new( 'ASSET_CALL_NUMBER_NOT_FOUND', id => $id ); - return( undef, $e ) unless $id; - - $logger->debug("Fetching callnumber $id"); - - my $cn = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.asset.call_number.retrieve', $id ); - $evt = $e unless $cn; - - return ( $cn, $evt ); -} - -my %ORG_CACHE; # - these rarely change, so cache them.. -sub fetch_org_unit { - my( $self, $id ) = @_; - return undef unless $id; - return $id if( ref($id) eq 'Fieldmapper::actor::org_unit' ); - return $ORG_CACHE{$id} if $ORG_CACHE{$id}; - $logger->debug("Fetching org unit $id"); - my $evt = undef; - - my $org = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.actor.org_unit.retrieve', $id ); - $evt = OpenILS::Event->new( 'ACTOR_ORG_UNIT_NOT_FOUND', id => $id ) unless $org; - $ORG_CACHE{$id} = $org; - - return ($org, $evt); -} - -sub fetch_stat_cat { - my( $self, $type, $id ) = @_; - my( $cat, $evt ); - $logger->debug("Fetching $type stat cat: $id"); - $cat = $self->simplereq( - 'open-ils.cstore', - "open-ils.cstore.direct.$type.stat_cat.retrieve", $id ); - - my $e = 'ASSET_STAT_CAT_NOT_FOUND'; - $e = 'ACTOR_STAT_CAT_NOT_FOUND' if $type eq 'actor'; - - $evt = OpenILS::Event->new( $e, id => $id ) unless $cat; - return ( $cat, $evt ); -} - -sub fetch_stat_cat_entry { - my( $self, $type, $id ) = @_; - my( $entry, $evt ); - $logger->debug("Fetching $type stat cat entry: $id"); - $entry = $self->simplereq( - 'open-ils.cstore', - "open-ils.cstore.direct.$type.stat_cat_entry.retrieve", $id ); - - my $e = 'ASSET_STAT_CAT_ENTRY_NOT_FOUND'; - $e = 'ACTOR_STAT_CAT_ENTRY_NOT_FOUND' if $type eq 'actor'; - - $evt = OpenILS::Event->new( $e, id => $id ) unless $entry; - return ( $entry, $evt ); -} - - -sub find_org { - my( $self, $org_tree, $orgid ) = @_; - return undef unless $org_tree and defined $orgid; - return $org_tree if ( $org_tree->id eq $orgid ); - return undef unless ref($org_tree->children); - for my $c (@{$org_tree->children}) { - my $o = $self->find_org($c, $orgid); - return $o if $o; - } - return undef; -} - -sub fetch_non_cat_type_by_name_and_org { - my( $self, $name, $orgId ) = @_; - $logger->debug("Fetching non cat type $name at org $orgId"); - my $types = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.config.non_cataloged_type.search.atomic', - { name => $name, owning_lib => $orgId } ); - return ($types->[0], undef) if($types and @$types); - return (undef, OpenILS::Event->new('CONFIG_NON_CATALOGED_TYPE_NOT_FOUND') ); -} - -sub fetch_non_cat_type { - my( $self, $id ) = @_; - $logger->debug("Fetching non cat type $id"); - my( $type, $evt ); - $type = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.config.non_cataloged_type.retrieve', $id ); - $evt = OpenILS::Event->new('CONFIG_NON_CATALOGED_TYPE_NOT_FOUND') unless $type; - return ($type, $evt); -} - -sub DB_UPDATE_FAILED { - my( $self, $payload ) = @_; - return OpenILS::Event->new('DATABASE_UPDATE_FAILED', - payload => ($payload) ? $payload : undef ); -} - -sub fetch_booking_reservation { - my( $self, $id ) = @_; - my( $res, $evt ); - - $res = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.booking.reservation.retrieve', $id - ); - - # simplereq doesn't know how to flesh so ... - if ($res) { - $res->usr( - $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.actor.user.retrieve', $res->usr - ) - ); - - $res->target_resource_type( - $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.booking.resource_type.retrieve', $res->target_resource_type - ) - ); - - if ($res->current_resource) { - $res->current_resource( - $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.booking.resource.retrieve', $res->current_resource - ) - ); - - if ($self->is_true( $res->target_resource_type->catalog_item )) { - $res->current_resource->catalog_item( $self->fetch_copy_by_barcode( $res->current_resource->barcode ) ); - } - } - - if ($res->target_resource) { - $res->target_resource( - $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.booking.resource.retrieve', $res->target_resource - ) - ); - - if ($self->is_true( $res->target_resource_type->catalog_item )) { - $res->target_resource->catalog_item( $self->fetch_copy_by_barcode( $res->target_resource->barcode ) ); - } - } - - } else { - $evt = OpenILS::Event->new('RESERVATION_NOT_FOUND'); - } - - return ($res, $evt); -} - -sub fetch_circ_duration_by_name { - my( $self, $name ) = @_; - my( $dur, $evt ); - $dur = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.config.rules.circ_duration.search.atomic', { name => $name } ); - $dur = $dur->[0]; - $evt = OpenILS::Event->new('CONFIG_RULES_CIRC_DURATION_NOT_FOUND') unless $dur; - return ($dur, $evt); -} - -sub fetch_recurring_fine_by_name { - my( $self, $name ) = @_; - my( $obj, $evt ); - $obj = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.config.rules.recurring_fine.search.atomic', { name => $name } ); - $obj = $obj->[0]; - $evt = OpenILS::Event->new('CONFIG_RULES_RECURRING_FINE_NOT_FOUND') unless $obj; - return ($obj, $evt); -} - -sub fetch_max_fine_by_name { - my( $self, $name ) = @_; - my( $obj, $evt ); - $obj = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.config.rules.max_fine.search.atomic', { name => $name } ); - $obj = $obj->[0]; - $evt = OpenILS::Event->new('CONFIG_RULES_MAX_FINE_NOT_FOUND') unless $obj; - return ($obj, $evt); -} - -sub fetch_hard_due_date_by_name { - my( $self, $name ) = @_; - my( $obj, $evt ); - $obj = $self->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.config.hard_due_date.search.atomic', { name => $name } ); - $obj = $obj->[0]; - $evt = OpenILS::Event->new('CONFIG_RULES_HARD_DUE_DATE_NOT_FOUND') unless $obj; - return ($obj, $evt); -} - -sub storagereq { - my( $self, $method, @params ) = @_; - return $self->simplereq( - 'open-ils.storage', $method, @params ); -} - -sub storagereq_xact { - my($self, $method, @params) = @_; - my $ses = $self->start_db_session(); - my $val = $ses->request($method, @params)->gather(1); - $self->rollback_db_session($ses); - return $val; -} - -sub cstorereq { - my( $self, $method, @params ) = @_; - return $self->simplereq( - 'open-ils.cstore', $method, @params ); -} - -sub event_equals { - my( $self, $e, $name ) = @_; - if( $e and ref($e) eq 'HASH' and - defined($e->{textcode}) and $e->{textcode} eq $name ) { - return 1 ; - } - return 0; -} - -sub logmark { - my( undef, $f, $l ) = caller(0); - my( undef, undef, undef, $s ) = caller(1); - $s =~ s/.*:://g; - $f =~ s/.*\///g; - $logger->debug("LOGMARK: $f:$l:$s"); -} - -# takes a copy id -sub fetch_open_circulation { - my( $self, $cid ) = @_; - $self->logmark; - - my $e = OpenILS::Utils::CStoreEditor->new; - my $circ = $e->search_action_circulation({ - target_copy => $cid, - stop_fines_time => undef, - checkin_time => undef - })->[0]; - - return ($circ, $e->event); -} - -my $copy_statuses; -sub copy_status_from_name { - my( $self, $name ) = @_; - $copy_statuses = $self->fetch_copy_statuses unless $copy_statuses; - for my $status (@$copy_statuses) { - return $status if( $status->name =~ /$name/i ); - } - return undef; -} - -sub copy_status_to_name { - my( $self, $sid ) = @_; - $copy_statuses = $self->fetch_copy_statuses unless $copy_statuses; - for my $status (@$copy_statuses) { - return $status->name if( $status->id == $sid ); - } - return undef; -} - - -sub copy_status { - my( $self, $arg ) = @_; - return $arg if ref $arg; - $copy_statuses = $self->fetch_copy_statuses unless $copy_statuses; - my ($stat) = grep { $_->id == $arg } @$copy_statuses; - return $stat; -} - -sub fetch_open_transit_by_copy { - my( $self, $copyid ) = @_; - my($transit, $evt); - $transit = $self->cstorereq( - 'open-ils.cstore.direct.action.transit_copy.search', - { target_copy => $copyid, dest_recv_time => undef }); - $evt = OpenILS::Event->new('ACTION_TRANSIT_COPY_NOT_FOUND') unless $transit; - return ($transit, $evt); -} - -sub unflesh_copy { - my( $self, $copy ) = @_; - return undef unless $copy; - $copy->status( $copy->status->id ) if ref($copy->status); - $copy->location( $copy->location->id ) if ref($copy->location); - $copy->circ_lib( $copy->circ_lib->id ) if ref($copy->circ_lib); - return $copy; -} - -sub unflesh_reservation { - my( $self, $reservation ) = @_; - return undef unless $reservation; - $reservation->usr( $reservation->usr->id ) if ref($reservation->usr); - $reservation->target_resource_type( $reservation->target_resource_type->id ) if ref($reservation->target_resource_type); - $reservation->target_resource( $reservation->target_resource->id ) if ref($reservation->target_resource); - $reservation->current_resource( $reservation->current_resource->id ) if ref($reservation->current_resource); - return $reservation; -} - -# un-fleshes a copy and updates it in the DB -# returns a DB_UPDATE_FAILED event on error -# returns undef on success -sub update_copy { - my( $self, %params ) = @_; - - my $copy = $params{copy} || die "update_copy(): copy required"; - my $editor = $params{editor} || die "update_copy(): copy editor required"; - my $session = $params{session}; - - $logger->debug("Updating copy in the database: " . $copy->id); - - $self->unflesh_copy($copy); - $copy->editor( $editor ); - $copy->edit_date( 'now' ); - - my $s; - my $meth = 'open-ils.storage.direct.asset.copy.update'; - - $s = $session->request( $meth, $copy )->gather(1) if $session; - $s = $self->storagereq( $meth, $copy ) unless $session; - - $logger->debug("Update of copy ".$copy->id." returned: $s"); - - return $self->DB_UPDATE_FAILED($copy) unless $s; - return undef; -} - -sub update_reservation { - my( $self, %params ) = @_; - - my $reservation = $params{reservation} || die "update_reservation(): reservation required"; - my $editor = $params{editor} || die "update_reservation(): copy editor required"; - my $session = $params{session}; - - $logger->debug("Updating copy in the database: " . $reservation->id); - - $self->unflesh_reservation($reservation); - - my $s; - my $meth = 'open-ils.cstore.direct.booking.reservation.update'; - - $s = $session->request( $meth, $reservation )->gather(1) if $session; - $s = $self->cstorereq( $meth, $reservation ) unless $session; - - $logger->debug("Update of copy ".$reservation->id." returned: $s"); - - return $self->DB_UPDATE_FAILED($reservation) unless $s; - return undef; -} - -sub fetch_billable_xact { - my( $self, $id ) = @_; - my($xact, $evt); - $logger->debug("Fetching billable transaction %id"); - $xact = $self->cstorereq( - 'open-ils.cstore.direct.money.billable_transaction.retrieve', $id ); - $evt = OpenILS::Event->new('MONEY_BILLABLE_TRANSACTION_NOT_FOUND') unless $xact; - return ($xact, $evt); -} - -sub fetch_billable_xact_summary { - my( $self, $id ) = @_; - my($xact, $evt); - $logger->debug("Fetching billable transaction summary %id"); - $xact = $self->cstorereq( - 'open-ils.cstore.direct.money.billable_transaction_summary.retrieve', $id ); - $evt = OpenILS::Event->new('MONEY_BILLABLE_TRANSACTION_NOT_FOUND') unless $xact; - return ($xact, $evt); -} - -sub fetch_fleshed_copy { - my( $self, $id ) = @_; - my( $copy, $evt ); - $logger->info("Fetching fleshed copy $id"); - $copy = $self->cstorereq( - "open-ils.cstore.direct.asset.copy.retrieve", $id, - { flesh => 1, - flesh_fields => { acp => [ qw/ circ_lib location status stat_cat_entries / ] } - } - ); - $evt = OpenILS::Event->new('ASSET_COPY_NOT_FOUND', id => $id) unless $copy; - return ($copy, $evt); -} - - -# returns the org that owns the callnumber that the copy -# is attached to -sub fetch_copy_owner { - my( $self, $copyid ) = @_; - my( $copy, $cn, $evt ); - $logger->debug("Fetching copy owner $copyid"); - ($copy, $evt) = $self->fetch_copy($copyid); - return (undef,$evt) if $evt; - ($cn, $evt) = $self->fetch_callnumber($copy->call_number); - return (undef,$evt) if $evt; - return ($cn->owning_lib); -} - -sub fetch_copy_note { - my( $self, $id ) = @_; - my( $note, $evt ); - $logger->debug("Fetching copy note $id"); - $note = $self->cstorereq( - 'open-ils.cstore.direct.asset.copy_note.retrieve', $id ); - $evt = OpenILS::Event->new('ASSET_COPY_NOTE_NOT_FOUND', id => $id ) unless $note; - return ($note, $evt); -} - -sub fetch_call_numbers_by_title { - my( $self, $titleid ) = @_; - $logger->info("Fetching call numbers by title $titleid"); - return $self->cstorereq( - 'open-ils.cstore.direct.asset.call_number.search.atomic', - { record => $titleid, deleted => 'f' }); - #'open-ils.storage.direct.asset.call_number.search.record.atomic', $titleid); -} - -sub fetch_copies_by_call_number { - my( $self, $cnid ) = @_; - $logger->info("Fetching copies by call number $cnid"); - return $self->cstorereq( - 'open-ils.cstore.direct.asset.copy.search.atomic', { call_number => $cnid, deleted => 'f' } ); - #'open-ils.storage.direct.asset.copy.search.call_number.atomic', $cnid ); -} - -sub fetch_user_by_barcode { - my( $self, $bc ) = @_; - my $cardid = $self->cstorereq( - 'open-ils.cstore.direct.actor.card.id_list', { barcode => $bc } ); - return (undef, OpenILS::Event->new('ACTOR_CARD_NOT_FOUND', barcode => $bc)) unless $cardid; - my $user = $self->cstorereq( - 'open-ils.cstore.direct.actor.user.search', { card => $cardid } ); - return (undef, OpenILS::Event->new('ACTOR_USER_NOT_FOUND', card => $cardid)) unless $user; - return ($user); - -} - -sub fetch_bill { - my( $self, $billid ) = @_; - $logger->debug("Fetching billing $billid"); - my $bill = $self->cstorereq( - 'open-ils.cstore.direct.money.billing.retrieve', $billid ); - my $evt = OpenILS::Event->new('MONEY_BILLING_NOT_FOUND') unless $bill; - return($bill, $evt); -} - -my $ORG_TREE; -sub fetch_org_tree { - my $self = shift; - return $ORG_TREE if $ORG_TREE; - return $ORG_TREE = OpenILS::Utils::CStoreEditor->new->search_actor_org_unit( - [ - {"parent_ou" => undef }, - { - flesh => -1, - flesh_fields => { aou => ['children'] }, - order_by => { aou => 'name'} - } - ] - )->[0]; -} - -sub walk_org_tree { - my( $self, $node, $callback ) = @_; - return unless $node; - $callback->($node); - if( $node->children ) { - $self->walk_org_tree($_, $callback) for @{$node->children}; - } -} - -sub is_true { - my( $self, $item ) = @_; - return 1 if $item and $item !~ /^f$/i; - return 0; -} - - -sub patientreq { - my ($self, $client, $service, $method, @params) = @_; - my ($response, $err); - - my $session = create OpenSRF::AppSession($service); - my $request = $session->request($method, @params); - - my $spurt = 10; - my $give_up = time + 1000; - - try { - while (time < $give_up) { - $response = $request->recv("timeout" => $spurt); - last if $request->complete; - - $client->status(new OpenSRF::DomainObject::oilsContinueStatus); - } - } catch Error with { - $err = shift; - }; - - if ($err) { - warn "received error : service=$service : method=$method : params=".Dumper(\@params) . "\n $err"; - throw $err ("Call to $service for method $method \n failed with exception: $err : " ); - } - - return $response->content; -} - -# This logic now lives in storage -sub __patron_money_owed { - my( $self, $patronid ) = @_; - my $ses = OpenSRF::AppSession->create('open-ils.storage'); - my $req = $ses->request( - 'open-ils.storage.money.billable_transaction.summary.search', - { usr => $patronid, xact_finish => undef } ); - - my $total = 0; - my $data; - while( $data = $req->recv ) { - $data = $data->content; - $total += $data->balance_owed; - } - return $total; -} - -sub patron_money_owed { - my( $self, $userid ) = @_; - my $ses = $self->start_db_session(); - my $val = $ses->request( - 'open-ils.storage.actor.user.total_owed', $userid)->gather(1); - $self->rollback_db_session($ses); - return $val; -} - -sub patron_total_items_out { - my( $self, $userid ) = @_; - my $ses = $self->start_db_session(); - my $val = $ses->request( - 'open-ils.storage.actor.user.total_out', $userid)->gather(1); - $self->rollback_db_session($ses); - return $val; -} - - - - -#--------------------------------------------------------------------- -# Returns ($summary, $event) -#--------------------------------------------------------------------- -sub fetch_mbts { - my $self = shift; - my $id = shift; - my $e = shift || OpenILS::Utils::CStoreEditor->new; - $id = $id->id if ref($id); - - my $xact = $e->retrieve_money_billable_transaction_summary($id) - or return (undef, $e->event); - - return ($xact); -} - - -#--------------------------------------------------------------------- -# Given a list of money.billable_transaction objects, this creates -# transaction summary objects for each -#-------------------------------------------------------------------- -sub make_mbts { - my $self = shift; - my $e = shift; - my @xacts = @_; - return () if (!@xacts); - return @{$e->search_money_billable_transaction_summary({id => [ map { $_->id } @xacts ]})}; -} - - -sub ou_ancestor_setting_value { - my($self, $org_id, $name, $e) = @_; - $e = $e || OpenILS::Utils::CStoreEditor->new; - my $set = $self->ou_ancestor_setting($org_id, $name, $e); - return $set->{value} if $set; - return undef; -} - - -# If an authentication token is provided AND this org unit setting has a -# view_perm, then make sure the user referenced by the auth token has -# that permission. This means that if you call this method without an -# authtoken param, you can get whatever org unit setting values you want. -# API users beware. -# -# NOTE: If you supply an editor ($e) arg AND an auth token arg, the editor's -# authtoken is checked, but the $auth arg is NOT checked. To say that another -# way, be sure NOT to pass an editor argument if you want your token checked. -# Otherwise the auth arg is just a flag saying "check the editor". - -sub ou_ancestor_setting { - my( $self, $orgid, $name, $e, $auth ) = @_; - $e = $e || OpenILS::Utils::CStoreEditor->new( - (defined $auth) ? (authtoken => $auth) : () - ); - my $coust = $e->retrieve_config_org_unit_setting_type([ - $name, {flesh => 1, flesh_fields => {coust => ['view_perm']}} - ]); - - if ($auth && $coust && $coust->view_perm) { - # And you can't have permission if you don't have a valid session. - return undef if not $e->checkauth; - # And now that we know you MIGHT have permission, we check it. - return undef if not $e->allowed($coust->view_perm->code, $orgid); - } - - my $query = {from => ['actor.org_unit_ancestor_setting', $name, $orgid]}; - my $setting = $e->json_query($query)->[0]; - return undef unless $setting; - return {org => $setting->{org_unit}, value => OpenSRF::Utils::JSON->JSON2perl($setting->{value})}; -} - - -# returns the ISO8601 string representation of the requested epoch in GMT -sub epoch2ISO8601 { - my( $self, $epoch ) = @_; - my ($sec,$min,$hour,$mday,$mon,$year) = gmtime($epoch); - $year += 1900; $mon += 1; - my $date = sprintf( - '%s-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d-00', - $year, $mon, $mday, $hour, $min, $sec); - return $date; -} - -sub find_highest_perm_org { - my ( $self, $perm, $userid, $start_org, $org_tree ) = @_; - my $org = $self->find_org($org_tree, $start_org ); - - my $lastid = -1; - while( $org ) { - last if ($self->check_perms( $userid, $org->id, $perm )); # perm failed - $lastid = $org->id; - $org = $self->find_org( $org_tree, $org->parent_ou() ); - } - - return $lastid; -} - - -# returns the org_unit ID's -sub user_has_work_perm_at { - my($self, $e, $perm, $options, $user_id) = @_; - $options ||= {}; - $user_id = (defined $user_id) ? $user_id : $e->requestor->id; - - my $func = 'permission.usr_has_perm_at'; - $func = $func.'_all' if $$options{descendants}; - - my $orgs = $e->json_query({from => [$func, $user_id, $perm]}); - $orgs = [map { $_->{ (keys %$_)[0] } } @$orgs]; - - return $orgs unless $$options{objects}; - - return $e->search_actor_org_unit({id => $orgs}); -} - -sub get_user_work_ou_ids { - my($self, $e, $userid) = @_; - my $work_orgs = $e->json_query({ - select => {puwoum => ['work_ou']}, - from => 'puwoum', - where => {usr => $e->requestor->id}}); - - return [] unless @$work_orgs; - my @work_orgs; - push(@work_orgs, $_->{work_ou}) for @$work_orgs; - - return \@work_orgs; -} - - -my $org_types; -sub get_org_types { - my($self, $client) = @_; - return $org_types if $org_types; - return $org_types = OpenILS::Utils::CStoreEditor->new->retrieve_all_actor_org_unit_type(); -} - -sub get_org_tree { - my $self = shift; - my $locale = shift || ''; - my $cache = OpenSRF::Utils::Cache->new("global", 0); - my $tree = $cache->get_cache("orgtree.$locale"); - return $tree if $tree; - - my $ses = OpenILS::Utils::CStoreEditor->new; - $ses->session->session_locale($locale); - $tree = $ses->search_actor_org_unit( - [ - {"parent_ou" => undef }, - { - flesh => -1, - flesh_fields => { aou => ['children'] }, - order_by => { aou => 'name'} - } - ] - )->[0]; - - $cache->put_cache("orgtree.$locale", $tree); - return $tree; -} - -sub get_org_descendants { - my($self, $org_id, $depth) = @_; - - my $select = { - transform => 'actor.org_unit_descendants', - column => 'id', - result_field => 'id', - }; - $select->{params} = [$depth] if defined $depth; - - my $org_list = OpenILS::Utils::CStoreEditor->new->json_query({ - select => {aou => [$select]}, - from => 'aou', - where => {id => $org_id} - }); - my @orgs; - push(@orgs, $_->{id}) for @$org_list; - return \@orgs; -} - -sub get_org_ancestors { - my($self, $org_id) = @_; - - my $org_list = OpenILS::Utils::CStoreEditor->new->json_query({ - select => { - aou => [{ - transform => 'actor.org_unit_ancestors', - column => 'id', - result_field => 'id', - params => [] - }], - }, - from => 'aou', - where => {id => $org_id} - }); - - my @orgs; - push(@orgs, $_->{id}) for @$org_list; - return \@orgs; -} - -sub get_org_full_path { - my($self, $org_id, $depth) = @_; - - my $query = { - select => { - aou => [{ - transform => 'actor.org_unit_full_path', - column => 'id', - result_field => 'id', - }], - }, - from => 'aou', - where => {id => $org_id} - }; - - $query->{select}->{aou}->[0]->{params} = [$depth] if defined $depth; - my $org_list = OpenILS::Utils::CStoreEditor->new->json_query($query); - return [ map {$_->{id}} @$org_list ]; -} - -# returns the ID of the org unit ancestor at the specified depth -sub org_unit_ancestor_at_depth { - my($class, $org_id, $depth) = @_; - my $resp = OpenILS::Utils::CStoreEditor->new->json_query( - {from => ['actor.org_unit_ancestor_at_depth', $org_id, $depth]})->[0]; - return ($resp) ? $resp->{id} : undef; -} - -# returns the user's configured locale as a string. Defaults to en-US if none is configured. -sub get_user_locale { - my($self, $user_id, $e) = @_; - $e ||= OpenILS::Utils::CStoreEditor->new; - - # first, see if the user has an explicit locale set - my $setting = $e->search_actor_user_setting( - {usr => $user_id, name => 'global.locale'})->[0]; - return OpenSRF::Utils::JSON->JSON2perl($setting->value) if $setting; - - my $user = $e->retrieve_actor_user($user_id) or return $e->event; - return $self->get_org_locale($user->home_ou, $e); -} - -# returns org locale setting -sub get_org_locale { - my($self, $org_id, $e) = @_; - $e ||= OpenILS::Utils::CStoreEditor->new; - - my $locale; - if(defined $org_id) { - $locale = $self->ou_ancestor_setting_value($org_id, 'global.default_locale', $e); - return $locale if $locale; - } - - # system-wide default - my $sclient = OpenSRF::Utils::SettingsClient->new; - $locale = $sclient->config_value('default_locale'); - return $locale if $locale; - - # if nothing else, fallback to locale=cowboy - return 'en-US'; -} - - -# xml-escape non-ascii characters -sub entityize { - my($self, $string, $form) = @_; - $form ||= ""; - - # If we're going to convert non-ASCII characters to XML entities, - # we had better be dealing with a UTF8 string to begin with - $string = decode_utf8($string); - - if ($form eq 'D') { - $string = NFD($string); - } else { - $string = NFC($string); - } - - # Convert raw ampersands to entities - $string =~ s/&(?!\S+;)/&/gso; - - # Convert Unicode characters to entities - $string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe; - - return $string; -} - -# x0000-x0008 isn't legal in XML documents -# XXX Perhaps this should just go into our standard entityize method -sub strip_ctrl_chars { - my ($self, $string) = @_; - - $string =~ s/([\x{0000}-\x{0008}])//sgoe; - return $string; -} - -sub get_copy_price { - my($self, $e, $copy, $volume) = @_; - - $copy->price(0) if $copy->price and $copy->price < 0; - - return $copy->price if $copy->price and $copy->price > 0; - - - my $owner; - if(ref $volume) { - if($volume->id == OILS_PRECAT_CALL_NUMBER) { - $owner = $copy->circ_lib; - } else { - $owner = $volume->owning_lib; - } - } else { - if($copy->call_number == OILS_PRECAT_CALL_NUMBER) { - $owner = $copy->circ_lib; - } else { - $owner = $e->retrieve_asset_call_number($copy->call_number)->owning_lib; - } - } - - my $default_price = $self->ou_ancestor_setting_value( - $owner, OILS_SETTING_DEF_ITEM_PRICE, $e) || 0; - - return $default_price unless defined $copy->price; - - # price is 0. Use the default? - my $charge_on_0 = $self->ou_ancestor_setting_value( - $owner, OILS_SETTING_CHARGE_LOST_ON_ZERO, $e) || 0; - - return $default_price if $charge_on_0; - return 0; -} - -# given a transaction ID, this returns the context org_unit for the transaction -sub xact_org { - my($self, $xact_id, $e) = @_; - $e ||= OpenILS::Utils::CStoreEditor->new; - - my $loc = $e->json_query({ - "select" => {circ => ["circ_lib"]}, - from => "circ", - "where" => {id => $xact_id}, - }); - - return $loc->[0]->{circ_lib} if @$loc; - - $loc = $e->json_query({ - "select" => {bresv => ["request_lib"]}, - from => "bresv", - "where" => {id => $xact_id}, - }); - - return $loc->[0]->{request_lib} if @$loc; - - $loc = $e->json_query({ - "select" => {mg => ["billing_location"]}, - from => "mg", - "where" => {id => $xact_id}, - }); - - return $loc->[0]->{billing_location}; -} - - -sub find_event_def_by_hook { - my($self, $hook, $context_org, $e) = @_; - - $e ||= OpenILS::Utils::CStoreEditor->new; - - my $orgs = $self->get_org_ancestors($context_org); - - # search from the context org up - for my $org_id (reverse @$orgs) { - - my $def = $e->search_action_trigger_event_definition( - {hook => $hook, owner => $org_id})->[0]; - - return $def if $def; - } - - return undef; -} - - - -# If an event_def ID is not provided, use the hook and context org to find the -# most appropriate event. create the event, fire it, then return the resulting -# event with fleshed template_output and error_output -sub fire_object_event { - my($self, $event_def, $hook, $object, $context_org, $granularity, $user_data, $client) = @_; - - my $e = OpenILS::Utils::CStoreEditor->new; - my $def; - - my $auto_method = "open-ils.trigger.event.autocreate.by_definition"; - - if($event_def) { - $def = $e->retrieve_action_trigger_event_definition($event_def) - or return $e->event; - - $auto_method .= '.include_inactive'; - - } else { - - # find the most appropriate event def depending on context org - $def = $self->find_event_def_by_hook($hook, $context_org, $e) - or return $e->event; - } - - my $final_resp; - - if($def->group_field) { - # we have a list of objects - $object = [$object] unless ref $object eq 'ARRAY'; - - my @event_ids; - $user_data ||= []; - for my $i (0..$#$object) { - my $obj = $$object[$i]; - my $udata = $$user_data[$i]; - my $event_id = $self->simplereq( - 'open-ils.trigger', $auto_method, $def->id, $obj, $context_org, $udata); - push(@event_ids, $event_id); - } - - $logger->info("EVENTS = " . OpenSRF::Utils::JSON->perl2JSON(\@event_ids)); - - my $resp; - if (not defined $client) { - $resp = $self->simplereq( - 'open-ils.trigger', - 'open-ils.trigger.event_group.fire', - \@event_ids); - } else { - $resp = $self->patientreq( - $client, - "open-ils.trigger", "open-ils.trigger.event_group.fire", - \@event_ids - ); - } - - if($resp and $resp->{events} and @{$resp->{events}}) { - - $e->xact_begin; - $final_resp = $e->retrieve_action_trigger_event([ - $resp->{events}->[0]->id, - {flesh => 1, flesh_fields => {atev => ['template_output', 'error_output']}} - ]); - $e->rollback; - } - - } else { - - $object = $$object[0] if ref $object eq 'ARRAY'; - - my $event_id; - my $resp; - - if (not defined $client) { - $event_id = $self->simplereq( - 'open-ils.trigger', - $auto_method, $def->id, $object, $context_org, $user_data - ); - - $resp = $self->simplereq( - 'open-ils.trigger', - 'open-ils.trigger.event.fire', - $event_id - ); - } else { - $event_id = $self->patientreq( - $client, - 'open-ils.trigger', - $auto_method, $def->id, $object, $context_org, $user_data - ); - - $resp = $self->patientreq( - $client, - 'open-ils.trigger', - 'open-ils.trigger.event.fire', - $event_id - ); - } - - if($resp and $resp->{event}) { - $e->xact_begin; - $final_resp = $e->retrieve_action_trigger_event([ - $resp->{event}->id, - {flesh => 1, flesh_fields => {atev => ['template_output', 'error_output']}} - ]); - $e->rollback; - } - } - - return $final_resp; -} - - -sub create_events_for_hook { - my($self, $hook, $obj, $org_id, $granularity, $user_data, $wait) = @_; - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - my $req = $ses->request('open-ils.trigger.event.autocreate', - $hook, $obj, $org_id, $granularity, $user_data); - return undef unless $wait; - my $resp = $req->recv; - return $resp->content if $resp; -} - -sub create_uuid_string { - return create_UUID_as_string(); -} - -sub create_circ_chain_summary { - my($class, $e, $circ_id) = @_; - my $sum = $e->json_query({from => ['action.summarize_circ_chain', $circ_id]})->[0]; - return undef unless $sum; - my $obj = Fieldmapper::action::circ_chain_summary->new; - $obj->$_($sum->{$_}) for keys %$sum; - return $obj; -} - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Booking.pm b/Open-ILS/src/perlmods/OpenILS/Application/Booking.pm deleted file mode 100644 index 5e75fa840d..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Booking.pm +++ /dev/null @@ -1,1328 +0,0 @@ -package OpenILS::Application::Booking; - -use strict; -use warnings; - -use POSIX qw/strftime/; -use OpenILS::Application; -use base qw/OpenILS::Application/; - -use OpenSRF::Utils qw/:datetime/; -use OpenILS::Utils::CStoreEditor qw/:funcs/; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Application::AppUtils; -my $U = "OpenILS::Application::AppUtils"; - -use OpenSRF::Utils::Logger qw/$logger/; - -sub prepare_new_brt { - my ($record_id, $owning_lib, $mvr) = @_; - - my $brt = new Fieldmapper::booking::resource_type; - $brt->isnew(1); - $brt->name($mvr->title); - $brt->record($record_id); - $brt->catalog_item('t'); - $brt->transferable('t'); - $brt->owner($owning_lib); - - return $brt; -} - -sub get_existing_brt { - my ($e, $record_id, $owning_lib, $mvr) = @_; - my $results = $e->search_booking_resource_type( - {name => $mvr->title, owner => $owning_lib, record => $record_id} - ); - - return $results->[0] if scalar(@$results) > 0; - return undef; -} - -sub get_mvr { - return $U->simplereq( - 'open-ils.search', - 'open-ils.search.biblio.record.mods_slim.retrieve.authoritative', - shift # record id - ); -} - -sub get_unique_owning_libs { - my %hash = (); - $hash{$_->call_number->owning_lib} = 1 foreach (@_); # @_ are copies - return keys %hash; -} - -sub fetch_copies_by_ids { - my ($e, $copy_ids) = @_; - my $results = $e->search_asset_copy([ - {id => $copy_ids}, - {flesh => 1, flesh_fields => {acp => ['call_number']}} - ]); - return $results if ref($results) eq 'ARRAY'; - return []; -} - -sub get_single_record_id { - my $record_id = undef; - foreach (@_) { # @_ are copies - return undef if - (defined $record_id && $record_id != $_->call_number->record); - $record_id = $_->call_number->record; - } - return $record_id; -} - -# This function generates the correct json_query clause for determining -# whether two given ranges overlap. Each range is composed of a start -# and an end point. All four points should be the same type (could be int, -# date, time, timestamp, or perhaps other types). -# -# The first range (or the first two points) should be specified as -# literal values. The second range (or the last two points) should be -# specified as the names of columns, the values of which in a given row -# will constitute the second range in the comparison. -# -# ALSO: PostgreSQL includes an OVERLAPS operator which provides the same -# functionality in a much more concise way, but json_query does not (yet). -sub json_query_ranges_overlap { - +{ '-or' => [ - { '-and' => [{$_[2] => {'>=', $_[0]}}, {$_[2] => {'<', $_[1]}}]}, - { '-and' => [{$_[3] => {'>', $_[0]}}, {$_[3] => {'<', $_[1]}}]}, - { '-and' => { $_[3] => {'>', $_[0]}, $_[2] => {'<=', $_[0]}}}, - { '-and' => { $_[3] => {'>', $_[1]}, $_[2] => {'<', $_[1]}}}, - ]}; -} - -sub create_brt_and_brsrc { - my ($self, $conn, $authtoken, $copy_ids) = @_; - my (@created_brt, @created_brsrc); - my %brt_table = (); - - my $e = new_editor(xact => 1, authtoken => $authtoken); - return $e->die_event unless $e->checkauth; - - my @copies = @{fetch_copies_by_ids($e, $copy_ids)}; - my $record_id = get_single_record_id(@copies) or return $e->die_event; - my $mvr = get_mvr($record_id) or return $e->die_event; - - foreach (get_unique_owning_libs(@copies)) { - $brt_table{$_} = get_existing_brt($e, $record_id, $_, $mvr) || - prepare_new_brt($record_id, $_, $mvr); - } - - while (my ($owning_lib, $brt) = each %brt_table) { - my $pre_existing = 1; - if ($brt->isnew) { - if ($e->allowed('ADMIN_BOOKING_RESOURCE_TYPE', $owning_lib)) { - $pre_existing = 0; - return $e->die_event unless ( - # v-- Important: assignment modifies original hash - $brt = $e->create_booking_resource_type($brt) - ); - } - } - push @created_brt, [$brt->id, $brt->record, $pre_existing]; - } - - foreach (@copies) { - if ($e->allowed( - 'ADMIN_BOOKING_RESOURCE', $_->call_number->owning_lib - )) { - # This block needs to disregard any cstore failures and just - # return what results it can. - my $brsrc = new Fieldmapper::booking::resource; - $brsrc->isnew(1); - $brsrc->type($brt_table{$_->call_number->owning_lib}->id); - $brsrc->owner($_->call_number->owning_lib); - $brsrc->barcode($_->barcode); - - $e->set_savepoint("alpha"); - my $pre_existing = 0; - my $usable_result = undef; - if (!($usable_result = $e->create_booking_resource($brsrc))) { - $e->rollback_savepoint("alpha"); - if (($usable_result = $e->search_booking_resource( - +{ map { ($_, $brsrc->$_()) } qw/type owner barcode/ } - ))) { - $usable_result = $usable_result->[0]; - $pre_existing = 1; - } else { - # So we failed to create a booking resource for this copy. - # For now, let's just keep going. If the calling app wants - # to consider this an error, it can notice the absence - # of a booking resource for the copy in the returned - # results. - $logger->warn( - "Couldn't create or find brsrc for acp #" . $_->id - ); - } - } else { - $e->release_savepoint("alpha"); - } - - if ($usable_result) { - push @created_brsrc, - [$usable_result->id, $_->id, $pre_existing]; - } - } - } - - $e->commit and - return {brt => \@created_brt, brsrc => \@created_brsrc} or - return $e->die_event; -} -__PACKAGE__->register_method( - method => "create_brt_and_brsrc", - api_name => "open-ils.booking.resources.create_from_copies", - signature => { - params => [ - {type => 'string', desc => 'Authentication token'}, - {type => 'array', desc => 'Copy IDs'}, - ], - return => { desc => "A two-element hash. The 'brt' element " . - "is a list of created booking resource types described by " . - "3-tuples (id, copy id, was pre-existing). The 'brsrc' " . - "element is a similar list of created booking resources " . - "described by (id, record id, was pre-existing) 3-tuples."} - } -); - - -sub create_bresv { - my ($self, $client, $authtoken, - $target_user_barcode, $datetime_range, $pickup_lib, - $brt, $brsrc_list, $attr_values) = @_; - - $brsrc_list = [ undef ] if not defined $brsrc_list; - return undef if scalar(@$brsrc_list) < 1; # Empty list not ok. - - my $e = new_editor(xact => 1, authtoken => $authtoken); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed("ADMIN_BOOKING_RESERVATION"); - - my $usr = $U->fetch_user_by_barcode($target_user_barcode); - return $usr if ref($usr) eq 'HASH' and exists($usr->{"ilsevent"}); - - my $results = []; - foreach my $brsrc (@$brsrc_list) { - my $bresv = new Fieldmapper::booking::reservation; - $bresv->usr($usr->id); - $bresv->request_lib($e->requestor->ws_ou); - $bresv->pickup_lib($pickup_lib); - $bresv->start_time($datetime_range->[0]); - $bresv->end_time($datetime_range->[1]); - - # A little sanity checking: don't agree to put a reservation on a - # brsrc and a brt when they don't match. In fact, bomb out of - # this transaction entirely. - if ($brsrc) { - my $brsrc_itself = $e->retrieve_booking_resource([ - $brsrc, { - "flesh" => 1, - "flesh_fields" => {"brsrc" => ["type"]} - } - ]); - - if (not $brsrc_itself) { - my $ev = new OpenILS::Event( - "RESERVATION_BAD_PARAMS", - desc => "brsrc $brsrc doesn't exist" - ); - $e->disconnect; - return $ev; - } - elsif ($brsrc_itself->type->id != $brt) { - my $ev = new OpenILS::Event( - "RESERVATION_BAD_PARAMS", - desc => "brsrc $brsrc doesn't match given brt $brt" - ); - $e->disconnect; - return $ev; - } - - # Also bail if the user is trying to create a reservation at - # a pickup lib to which our resource won't go. - if ( - $brsrc_itself->owner != $pickup_lib and - not $brsrc_itself->type->transferable - ) { - my $ev = new OpenILS::Event( - "RESERVATION_BAD_PARAMS", - desc => "brsrc $brsrc doesn't belong to $pickup_lib and " . - "is not transferable" - ); - $e->disconnect; - return $ev; - } - } - $bresv->target_resource($brsrc); # undef is ok here - $bresv->target_resource_type($brt); - - ($bresv = $e->create_booking_reservation($bresv)) or - return $e->die_event; - - # We could/should do some sanity checking on this too: namely, on - # whether the attribute values given actually apply to the relevant - # brt. Not seeing any grievous side effects of not checking, though. - my @bravm = (); - foreach my $value (@$attr_values) { - my $bravm = new Fieldmapper::booking::reservation_attr_value_map; - $bravm->reservation($bresv->id); - $bravm->attr_value($value); - $bravm = $e->create_booking_reservation_attr_value_map($bravm) or - return $e->die_event; - push @bravm, $bravm; - } - push @$results, { - "bresv" => $bresv->id, - "bravm" => \@bravm, - }; - } - - $e->commit or return $e->die_event; - - # Targeting must be tacked on _after_ committing the transaction where the - # reservations are actually created. - foreach (@$results) { - $_->{"targeting"} = $U->storagereq( - "open-ils.storage.booking.reservation.resource_targeter", - $_->{"bresv"} - )->[0]; - } - return $results; -} -__PACKAGE__->register_method( - method => "create_bresv", - api_name => "open-ils.booking.reservations.create", - signature => { - params => [ - {type => 'string', desc => 'Authentication token'}, - {type => 'string', desc => 'Barcode of user for whom to reserve'}, - {type => 'array', desc => 'Two elements: start and end timestamp'}, - {type => 'int', desc => 'Desired reservation pickup lib'}, - {type => 'int', desc => 'Booking resource type'}, - {type => 'list', desc => 'Booking resource (undef ok; empty not ok)'}, - {type => 'array', desc => 'Attribute values selected'}, - ], - return => { desc => "A hash containing the new bresv and a list " . - "of new bravm"} - } -); - - -sub resource_list_by_attrs { - my $self = shift; - my $client = shift; - my $auth = shift; # Keep as argument, though not used just now. - my $filters = shift; - - return undef unless ($filters->{type} || $filters->{attribute_values}); - - my $query = { - "select" => {brsrc => [qw/id owner/], brt => ["elbow_room"]}, - "from" => {brsrc => {"brt" => {}}}, - "where" => {}, - "distinct" => 1 - }; - - $query->{where} = {"-and" => []}; - if ($filters->{type}) { - push @{$query->{where}->{"-and"}}, {"type" => $filters->{type}}; - } - - if ($filters->{pickup_lib}) { - push @{$query->{where}->{"-and"}}, - {"-or" => [ - {"owner" => $filters->{pickup_lib}}, - {"+brt" => {"transferable" => "t"}} - ]}; - } - - if ($filters->{attribute_values}) { - - $query->{from}->{brsrc}->{bram} = { field => 'resource' }; - - $filters->{attribute_values} = [$filters->{attribute_values}] - if (!ref($filters->{attribute_values})); - - $query->{having}->{'+bram'}->{value}->{'@>'} = { - transform => 'array_accum', - value => '$_' . $$ . '${' . - join(',', @{$filters->{attribute_values}}) . - '}$_' . $$ . '$' - }; - } - - if ($filters->{available}) { - # If only one timestamp has been provided, make it into a range. - if (!ref($filters->{available})) { - $filters->{available} = [($filters->{available}) x 2]; - } - - push @{$query->{where}->{"-and"}}, { - "-or" => [ - {"overbook" => "t"}, - {"-not-exists" => { - "select" => {"bresv" => ["id"]}, - "from" => "bresv", - "where" => {"-and" => [ - json_query_ranges_overlap( - $filters->{available}->[0], - $filters->{available}->[1], - "start_time", - "end_time" - ), - {"cancel_time" => undef}, - {"return_time" => undef}, - {"current_resource" => {"=" => {"+brsrc" => "id"}}} - ]}, - }} - ] - }; - } - if ($filters->{booked}) { - # If only one timestamp has been provided, make it into a range. - if (!ref($filters->{booked})) { - $filters->{booked} = [($filters->{booked}) x 2]; - } - - push @{$query->{where}->{"-and"}}, { - "-exists" => { - "select" => {"bresv" => ["id"]}, - "from" => "bresv", - "where" => {"-and" => [ - json_query_ranges_overlap( - $filters->{booked}->[0], - $filters->{booked}->[1], - "start_time", - "end_time" - ), - {"cancel_time" => undef}, - {"current_resource" => { "=" => {"+brsrc" => "id"}}} - ]}, - } - }; - # I think that the "booked" case could be done with a JOIN instead of - # an EXISTS, but I'm leaving it this way for symmetry with the - # "available" case for now. The available case cannot be done with a - # join. - } - - my $cstore = OpenSRF::AppSession->connect('open-ils.cstore'); - my $rows = $cstore->request( - "open-ils.cstore.json_query.atomic", $query - )->gather(1); - $cstore->disconnect; - - return [] if not @$rows; - - if ($filters->{"pickup_lib"} && $filters->{"available"}) { - my @new_rows = (); - my $general_elbow_room = $U->ou_ancestor_setting_value( - $filters->{"pickup_lib"}, - "circ.booking_reservation.default_elbow_room" - ) || '0 seconds'; - my $would_start = $filters->{"available"}->[0]; - my $dt_parser = new DateTime::Format::ISO8601; - - $logger->info( - "general_elbow_room: '$general_elbow_room', " . - "would_start: '$would_start'" - ); - - # Here, elbow_room will double as required transit time padding. - foreach (@$rows) { - my $elbow_room = $_->{"elbow_room"} || $general_elbow_room; - if ($_->{"owner"} != $filters->{"pickup_lib"}) { - (my $ws = $would_start) =~ s/ /T/; - push @new_rows, $_ if DateTime->compare( - $dt_parser->parse_datetime($ws), - DateTime->now( - "time_zone" => DateTime::TimeZone->new( - "name" => "local" - ) - )->add(seconds => interval_to_seconds($elbow_room)) - ) >= 0; - } else { - push @new_rows, $_; - } - } - return [map { $_->{id} } @new_rows]; - } else { - return [map { $_->{id} } @$rows]; - } -} -__PACKAGE__->register_method( - method => "resource_list_by_attrs", - api_name => "open-ils.booking.resources.filtered_id_list", - argc => 2, - signature=> { - params => [ - {type => 'string', desc => 'Authentication token (unused for now,' . - ' but at least pass undef here)'}, - {type => 'object', desc => 'Filter object: see notes for details'}, - ], - return => { desc => "An array of brsrc ids matching the requested filters." }, - }, - notes => <<'NOTES' - -The filter object parameter can contain the following keys: - * type => The id of a booking resource type (brt) - * attribute_values => The ids of booking resource type attribute values that the resource must have assigned to it (brav) - * available => Either: - A timestamp during which the resources are not reserved. If the resource is overbookable, this is ignored. - A range of two timestamps which do not overlap any reservations for the resources. If the resource is overbookable, this is ignored. - * booked => Either: - A timestamp during which the resources are reserved. - A range of two timestamps which overlap a reservation of the resources. - -Note that at least one of 'type' or 'attribute_values' is required. - -NOTES -); - - -sub reservation_list_by_filters { - my $self = shift; - my $client = shift; - my $auth = shift; - my $filters = shift; - my $whole_obj = shift; - - return undef unless ($filters->{user} || $filters->{user_barcode} || $filters->{resource} || $filters->{type} || $filters->{attribute_values}); - - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_TRANSACTION'); - - my $query = { - 'select' => { bresv => [ 'id', 'start_time' ] }, - 'from' => { bresv => {} }, - 'where' => {}, - 'order_by' => [{ class => bresv => field => start_time => direction => 'asc' }], - 'distinct' => 1 - }; - - if ($filters->{fields}) { - $query->{where} = $filters->{fields}; - } - - - if ($filters->{user}) { - $query->{where}->{usr} = $filters->{user}; - } - elsif ($filters->{user_barcode}) { # just one of user and user_barcode - my $usr = $U->fetch_user_by_barcode($filters->{user_barcode}); - return $usr if ref($usr) eq 'HASH' and exists($usr->{"ilsevent"}); - $query->{where}->{usr} = $usr->id; - } - - - if ($filters->{type}) { - $query->{where}->{target_resource_type} = $filters->{type}; - } - - $query->{where}->{"-and"} = []; - if ($filters->{resource}) { -# $query->{where}->{target_resource} = $filters->{resource}; - push @{$query->{where}->{"-and"}}, { - "-or" => { - "target_resource" => $filters->{resource}, - "current_resource" => $filters->{resource} - } - }; - } - - if ($filters->{attribute_values}) { - - $query->{from}->{bresv}->{bravm} = { field => 'reservation' }; - - $filters->{attribute_values} = [$filters->{attribute_values}] - if (!ref($filters->{attribute_values})); - - $query->{having}->{'+bravm'}->{attr_value}->{'@>'} = { - transform => 'array_accum', - value => '$_' . $$ . '${' . - join(',', @{$filters->{attribute_values}}) . - '}$_' . $$ . '$' - }; - } - - if ($filters->{search_start} || $filters->{search_end}) { - my $or = {}; - - $or->{start_time} = - {'between' => [ $filters->{search_start}, $filters->{search_end}]} - if $filters->{search_start}; - - $or->{end_time} = - {'between' =>[$filters->{search_start}, $filters->{search_end}]} - if $filters->{search_end}; - - push @{$query->{where}->{"-and"}}, {"-or" => $or}; - } - - if (not scalar @{$query->{"where"}->{"-and"}}) { - delete $query->{"where"}->{"-and"}; - } - - my $cstore = OpenSRF::AppSession->connect('open-ils.cstore'); - my $ids = [ map { $_->{id} } @{ - $cstore->request( - 'open-ils.cstore.json_query.atomic', $query - )->gather(1) - } ]; - $cstore->disconnect; - - if (not $whole_obj or @$ids < 1) { - $e->disconnect; - return $ids; - } - - my $bresv_list = $e->search_booking_reservation([ - {"id" => $ids}, - {"flesh" => 1, - "flesh_fields" => { - "bresv" => - [qw/target_resource current_resource target_resource_type/] - } - }] - ); - $e->disconnect; - return $bresv_list ? $bresv_list : []; -} -__PACKAGE__->register_method( - method => "reservation_list_by_filters", - api_name => "open-ils.booking.reservations.filtered_id_list", - argc => 3, - signature=> { - params => [ - {type => 'string', desc => 'Authentication token'}, - {type => "object", desc => "Filter object: see notes for details"}, - {type => "bool", desc => "Return whole object instead of ID? (default false)"} - ], - return => { desc => "An array of bresv ids matching the requested filters." }, - }, - notes => <<'NOTES' - -The filter object parameter can contain the following keys: - * user => The id of a user that has requested a bookable item -- filters on bresv.usr - * barcode => The barcode of a user that has requested a bookable item - * type => The id of a booking resource type (brt) -- filters on bresv.target_resource_type - * resource => The id of a booking resource (brsrc) -- filters on bresv.target_resource - * attribute_values => The ids of booking resource type attribute values that the resource must have assigned to it (brav) - * search_start => If search_end is not specified, booking interval (start_time to end_time) must contain this timestamp. - * search_end => If search_start is not specified, booking interval (start_time to end_time) must contain this timestamp. - * fields => An object containing any combination of bresv search filters in standard cstore/pcrud search format. - -Note that at least one of 'user', 'type', 'resource' or 'attribute_values' is required. If both search_start and search_end are specified, -then the result includes any reservations that overlap with that time range. Any filter fields supplied in 'fields' are overridden -by the top-level filters ('user', 'type', 'resource'). - -NOTES -); - - -sub naive_ts_string {strftime("%F %T", localtime($_[0] || time));} -sub naive_start_of_day {strftime("%F", localtime($_[0] || time))." 00:00:00";} - -# Return a map of bresv or an ilsevent on failure. -sub get_uncaptured_bresv_for_brsrc { - my ($e, $o) = @_; # o's keys (all optional): owning_lib, barcode, range - - my $from_clause = { - "bresv" => { - "brsrc" => {"field" => "id", "fkey" => "current_resource"} - } - }; - - my $query = { - "select" => { - "bresv" => [ - "current_resource", - { - "column" => "start_time", - "transform" => "min", - "aggregate" => 1 - } - ] - }, - "from" => $from_clause, - "where" => { - "-and" => [ - {"current_resource" => {"!=" => undef}}, - {"capture_time" => undef}, - {"cancel_time" => undef}, - {"return_time" => undef}, - {"pickup_time" => undef} - ] - } - }; - if ($o->{"owning_lib"}) { - push @{$query->{"where"}->{"-and"}}, - {"+brsrc" => {"owner" => $o->{"owning_lib"}}}; - } - if ($o->{"range"}) { - push @{$query->{"where"}->{"-and"}}, - json_query_ranges_overlap( - $o->{"range"}->[0], $o->{"range"}->[1], - "start_time", "end_time" - ); - } - if ($o->{"barcode"}) { - push @{$query->{"where"}->{"-and"}}, - {"+brsrc" => {"barcode" => $o->{"barcode"}}}; - } - - my $rows = $e->json_query($query); - my $current_resource_bresv_map = {}; - if (@$rows) { - my $id_query = { - "select" => {"bresv" => ["id"]}, - "from" => $from_clause, - "where" => { - "-and" => [ - {"current_resource" => "PLACEHOLDER"}, - {"start_time" => "PLACEHOLDER"}, - {"capture_time" => undef}, - {"cancel_time" => undef}, - {"return_time" => undef}, - {"pickup_time" => undef} - ] - } - }; - if ($o->{"owning_lib"}) { - push @{$id_query->{"where"}->{"-and"}}, - {"+brsrc" => {"owner" => $o->{"owning_lib"}}}; - } - - foreach (@$rows) { - $id_query->{"where"}->{"-and"}->[0]->{"current_resource"} = - $_->{"current_resource"}; - $id_query->{"where"}->{"-and"}->[1]->{"start_time"} = - $_->{"start_time"}; - - my $results = $e->json_query($id_query); - if ($results && @$results) { - $current_resource_bresv_map->{$_->{"current_resource"}} = - [map { $_->{"id"} } @$results]; - } - } - } - return $current_resource_bresv_map; -} - -sub get_pull_list { - my ($self, $client, $auth, $range, $interval_secs, $owning_lib) = @_; - - my $e = new_editor(xact => 1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed("RETRIEVE_RESERVATION_PULL_LIST"); - return $e->die_event unless ( - ref($range) eq "ARRAY" or - ($interval_secs = int($interval_secs)) > 0 - ); - - $owning_lib = $e->requestor->ws_ou if not $owning_lib; - $range = [ naive_ts_string(time), naive_ts_string(time + $interval_secs) ] - if not $range; - - my $uncaptured = get_uncaptured_bresv_for_brsrc( - $e, {"range" => $range, "owning_lib" => $owning_lib} - ); - - if (keys(%$uncaptured)) { - my @all_bresv_ids = map { @{$_} } values %$uncaptured; - my %bresv_lookup = ( - map { $_->id => $_ } @{ - $e->search_booking_reservation([{"id" => [@all_bresv_ids]}, { - flesh => 1, - flesh_fields => { bresv => [ - "usr", "target_resource_type", "current_resource" - ]} - }]) - } - ); - $e->disconnect; - return [ map { - my $key = $_; - my $one = $bresv_lookup{$uncaptured->{$key}->[0]}; - my $result = { - "current_resource" => $one->current_resource, - "target_resource_type" => $one->target_resource_type, - "reservations" => [ - map { $bresv_lookup{$_} } @{$uncaptured->{$key}} - ] - }; - foreach (@{$result->{"reservations"}}) { # deflesh - $_->current_resource($_->current_resource->id); - $_->target_resource_type($_->target_resource_type->id); - } - $result; - } keys %$uncaptured ]; - } else { - $e->disconnect; - return []; - } -} -__PACKAGE__->register_method( - method => "get_pull_list", - api_name => "open-ils.booking.reservations.get_pull_list", - argc => 4, - signature=> { - params => [ - {type => "string", desc => "Authentication token"}, - {type => "array", desc => - "range: Date/time range for reservations (opt)"}, - {type => "int", desc => - "interval: Seconds from now (instead of range)"}, - {type => "number", desc => "(Optional) Owning library"} - ], - return => { desc => "An array of hashes, each containing key/value " . - "pairs describing resource, resource type, and a list of " . - "reservations that claim the given resource." } - } -); - - -sub could_capture { - my ($self, $client, $auth, $barcode) = @_; - - my $e = new_editor("authtoken" => $auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed("COPY_CHECKIN"); - - my $dt_parser = new DateTime::Format::ISO8601; - my $now = now DateTime; # sic - my $res = get_uncaptured_bresv_for_brsrc($e, {"barcode" => $barcode}); - - if ($res and keys %$res) { - my $id; - while ((undef, $id) = each %$res) { - my $bresv = $e->retrieve_booking_reservation([ - $id, { - "flesh" => 1, "flesh_fields" => { - "bresv" => [qw( - usr target_resource_type - target_resource current_resource - )] - } - } - ]); - my $elbow_room = interval_to_seconds( - $bresv->target_resource_type->elbow_room || - $U->ou_ancestor_setting_value( - $bresv->pickup_lib, - "circ.booking_reservation.default_elbow_room" - ) || - "0 seconds" - ); - - unless ($elbow_room) { - $client->respond($bresv); - } else { - my $start_time = $dt_parser->parse_datetime( - clense_ISO8601($bresv->start_time) - ); - - if ($now >= $start_time->subtract("seconds" => $elbow_room)) { - $client->respond($bresv); - } else { - $logger->info( - "not within elbow room: $elbow_room, " . - "else would have returned bresv " . $bresv->id - ); - } - } - } - } - $e->disconnect; - undef; -} -__PACKAGE__->register_method( - method => "could_capture", - api_name => "open-ils.booking.reservations.could_capture", - argc => 2, - streaming=> 1, - signature=> { - params => [ - {type => "string", desc => "Authentication token"}, - {type => "string", desc => "Resource barcode"} - ], - return => {desc => "One or zero reservations; event on error."} - } -); - - -sub get_copy_fleshed_just_right { - my ($self, $client, $auth, $barcode) = @_; - - return undef if not defined $barcode; - return {} if ref($barcode) eq "ARRAY" and not @$barcode; - - my $e = new_editor(authtoken => $auth); - my $results = $e->search_asset_copy([ - {"barcode" => $barcode}, - { - "flesh" => 1, - "flesh_fields" => {"acp" => [qw/call_number location/]} - } - ]); - - if (ref($results) eq "ARRAY") { - $e->disconnect; - return $results->[0] unless ref $barcode; - return +{ map { $_->barcode => $_ } @$results }; - } else { - return $e->die_event; - } -} -__PACKAGE__->register_method( - method => "get_copy_fleshed_just_right", - api_name => "open-ils.booking.asset.get_copy_fleshed_just_right", - argc => 2, - signature=> { - params => [ - {type => "string", desc => "Authentication token"}, - {type => "mixed", desc => "One barcode or an array of them"}, - ], - return => { desc => - "A copy, or a hash of copies keyed by barcode if an array of " . - "barcodes was given" - } - } -); - - -sub best_bresv_candidate { - my ($e, $id_list) = @_; - - # This will almost always be the case. - if (@$id_list == 1) { - $logger->info("best_bresv_candidate (only) " . $id_list->[0]); - return $id_list->[0]; - } - - my @here = (); - my $this_ou = $e->requestor->ws_ou; - my $results = $e->json_query({ - "select" => {"brsrc" => ["pickup_lib"], "bresv" => ["id"]}, - "from" => { - "bresv" => { - "brsrc" => {"field" => "id", "fkey" => "current_resource"} - } - }, - "where" => { - {"+bresv" => {"id" => $id_list}} - } - }); - - foreach (@$results) { - push @here, $_->{"id"} if $_->{"pickup_lib"} == $this_ou; - } - - my $result; - if (@here > 0) { - $result = @here == 1 ? pop @here : (sort @here)[0]; - } else { - $result = (sort @$id_list)[0]; - } - $logger->info( - "best_bresv_candidate from " . join(",", @$id_list) . ": $result" - ); - return $result; -} - - -sub capture_resource_for_reservation { - my ($self, $client, $auth, $barcode, $no_update_copy) = @_; - - my $e = new_editor(authtoken => $auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed("COPY_CHECKIN"); - - my $uncaptured = get_uncaptured_bresv_for_brsrc( - $e, {"barcode" => $barcode} - ); - - if (keys %$uncaptured) { - # Note this will only capture one reservation at a time, even in - # cases with overbooking (multiple "soonest" bresv's on a resource). - my $bresv = best_bresv_candidate( - $e, $uncaptured->{ - (sort(keys %$uncaptured))[0] - } - ); - $e->disconnect; - return capture_reservation( - $self, $client, $auth, $bresv, $no_update_copy - ); - } else { - return new OpenILS::Event( - "RESERVATION_NOT_FOUND", - "desc" => "No capturable reservation found pertaining " . - "to a resource with barcode $barcode", - "payload" => {"fail_cause" => "no-reservation", "captured" => 0} - ); - } -} -__PACKAGE__->register_method( - method => "capture_resource_for_reservation", - api_name => "open-ils.booking.resources.capture_for_reservation", - argc => 3, - signature=> { - params => [ - {type => "string", desc => "Authentication token"}, - {type => "string", desc => "Barcode of booked & targeted resource"}, - {type => "number", desc => "(optional) 1 to not update copy"} - ], - return => { desc => "An OpenILS event describing the capture outcome" } - } -); - - -sub capture_reservation { - my ($self, $client, $auth, $res_id, $no_update_copy) = @_; - - my $e = new_editor("xact" => 1, "authtoken" => $auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed("COPY_CHECKIN"); - my $here = $e->requestor->ws_ou; - - my $reservation = $e->retrieve_booking_reservation([ - $res_id, { - "flesh" => 2, "flesh_fields" => { - "bresv" => [qw/usr current_resource type/], - "au" => ["card"], - "brsrc" => ["type"] - } - } - ]); - - return new OpenILS::Event("RESERVATION_NOT_FOUND") unless $reservation; - return new OpenILS::Event( - "RESERVATION_CAPTURE_FAILED", - payload => {"captured" => 0, "fail_cause" => "no-resource"} - ) unless $reservation->current_resource; - - return new OpenILS::Event( - "RESERVATION_CAPTURE_FAILED", - "payload" => {"captured" => 0, "fail_cause" => "cancelled"} - ) if $reservation->cancel_time; - - $reservation->capture_staff($e->requestor->id); - $reservation->capture_time("now"); - - $e->update_booking_reservation($reservation) or return $e->die_event; - - my $ret = {"captured" => 1, "reservation" => $reservation}; - - my $search_acp_like_this = [ - { - "barcode" => $reservation->current_resource->barcode, - "deleted" => "f" - }, - {"flesh" => 1, "flesh_fields" => {"acp" => ["call_number"]}} - ]; - - if ($here != $reservation->pickup_lib) { - $logger->info("resource isn't at the reservation's pickup lib..."); - return new OpenILS::Event( - "RESERVATION_CAPTURE_FAILED", - "payload" => {"captured" => 0, "fail_cause" => "not-transferable"} - ) unless $U->is_true( - $reservation->current_resource->type->transferable - ); - - # need to transit the item ... is it already in transit? - my $transit = $e->search_action_reservation_transit_copy( - {"reservation" => $res_id, "dest_recv_time" => undef} - )->[0]; - - if (!$transit) { # not yet in transit - $transit = new Fieldmapper::action::reservation_transit_copy; - - $transit->reservation($reservation->id); - $transit->target_copy($reservation->current_resource->id); - $transit->copy_status(15); - $transit->source_send_time("now"); - $transit->source($here); - $transit->dest($reservation->pickup_lib); - - $e->create_action_reservation_transit_copy($transit); - - if ($U->is_true( - $reservation->current_resource->type->catalog_item - )) { - my $copy = $e->search_asset_copy($search_acp_like_this)->[0]; - - if ($copy) { - return new OpenILS::Event( - "OPEN_CIRCULATION_EXISTS", - "payload" => {"captured" => 0, "copy" => $copy} - ) if $copy->status == 1 and not $no_update_copy; - - $ret->{"mvr"} = get_mvr($copy->call_number->record); - if ($no_update_copy) { - $ret->{"new_copy_status"} = 6; - } else { - $copy->status(6); - $e->update_asset_copy($copy) or return $e->die_event; - } - } - } - } - - $ret->{"transit"} = $transit; - } elsif ($U->is_true($reservation->current_resource->type->catalog_item)) { - $logger->info("resource is a catalog item..."); - my $copy = $e->search_asset_copy($search_acp_like_this)->[0]; - - if ($copy) { - return new OpenILS::Event( - "OPEN_CIRCULATION_EXISTS", - "payload" => {"captured" => 0, "copy" => $copy} - ) if $copy->status == 1 and not $no_update_copy; - - $ret->{"mvr"} = get_mvr($copy->call_number->record); - if ($no_update_copy) { - $ret->{"new_copy_status"} = 15; - } else { - $copy->status(15); - $e->update_asset_copy($copy) or return $e->die_event; - } - } - } - - $e->commit or return $e->die_event; - - # XXX I'm not sure whether these last two elements of the payload - # actually get used anywhere. - $ret->{"resource"} = $reservation->current_resource; - $ret->{"type"} = $reservation->current_resource->type; - return new OpenILS::Event("SUCCESS", "payload" => $ret); -} -__PACKAGE__->register_method( - method => "capture_reservation", - api_name => "open-ils.booking.reservations.capture", - argc => 2, - signature=> { - params => [ - {type => 'string', desc => 'Authentication token'}, - {type => 'mixed', desc => - 'Reservation ID (number) or array of resource barcodes'} - ], - return => { desc => "An OpenILS Event object describing the outcome of the capture, with relevant payload." }, - } -); - - -sub cancel_reservation { - my ($self, $client, $auth, $id_list) = @_; - - my $e = new_editor(xact => 1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - # Should the following permission really be checked as relates to each - # individual reservation's request_lib? Hrmm... - return $e->die_event unless $e->allowed("ADMIN_BOOKING_RESERVATION"); - - my $bresv_list = $e->search_booking_reservation([ - {"id" => $id_list}, - {"flesh" => 1, "flesh_fields" => {"bresv" => [ - "current_resource", "target_resource_type" - ]}} - ]); - return $e->die_event if not $bresv_list; - - my @results = (); - my $circ = OpenSRF::AppSession->connect("open-ils.circ") or - return $e->die_event; - foreach my $bresv (@$bresv_list) { - $bresv->cancel_time("now"); - $e->update_booking_reservation($bresv) or do { - $circ->disconnect; - return $e->die_event; - }; - $e->xact_commit; - $e->xact_begin; - - if ( - $bresv->target_resource_type->catalog_item == "t" && - $bresv->current_resource - ) { - $logger->info("result of no-op checkin (upon cxl bresv) is " . - $circ->request( - "open-ils.circ.checkin", $auth, - {"barcode" => $bresv->current_resource->barcode, - "noop" => 1} - )->gather(1)->{"textcode"}); - } - push @results, $bresv->id; - } - - $e->disconnect; - $circ->disconnect; - - return \@results; -} -__PACKAGE__->register_method( - method => "cancel_reservation", - api_name => "open-ils.booking.reservations.cancel", - argc => 2, - signature=> { - params => [ - {type => "string", desc => "Authentication token"}, - {type => "array", desc => "List of reservation IDs"} - ], - return => { desc => "A list of canceled reservation IDs" }, - } -); - - -sub get_captured_reservations { - my ($self, $client, $auth, $barcode, $which) = @_; - - my $e = new_editor(xact => 1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed("VIEW_USER"); - return $e->die_event unless $e->allowed("ADMIN_BOOKING_RESERVATION"); - - # fetch the patron for our uses in any case... - my $patron = $U->fetch_user_by_barcode($barcode); - return $patron if ref($patron) eq "HASH" and exists $patron->{"ilsevent"}; - - my $bresv_flesh = { - "flesh" => 1, - "flesh_fields" => {"bresv" => [ - qw/target_resource_type current_resource/ - ]} - }; - - my $dispatch = { - "patron" => sub { - return $patron; - }, - "ready" => sub { - return $e->search_booking_reservation([ - { - "usr" => $patron->id, - "capture_time" => {"!=" => undef}, - "pickup_time" => undef, - "start_time" => {">=" => naive_start_of_day()}, - "cancel_time" => undef - }, - $bresv_flesh - ]) or $e->die_event; - }, - "out" => sub { - return $e->search_booking_reservation([ - { - "usr" => $patron->id, - "pickup_time" => {"!=" => undef}, - "return_time" => undef, - "cancel_time" => undef - }, - $bresv_flesh - ]) or $e->die_event; - }, - "in" => sub { - return $e->search_booking_reservation([ - { - "usr" => $patron->id, - "return_time" => {">=" => naive_start_of_day()}, - "cancel_time" => undef - }, - $bresv_flesh - ]) or $e->die_event; - } - }; - - my $result = {}; - foreach (@$which) { - my $f = $dispatch->{$_}; - if ($f) { - my $r = &{$f}(); - return $r if (ref($r) eq "HASH" and exists $r->{"ilsevent"}); - $result->{$_} = $r; - } - } - - return $result; -} -__PACKAGE__->register_method( - method => "get_captured_reservations", - api_name => "open-ils.booking.reservations.get_captured", - argc => 3, - signature=> { - params => [ - {type => "string", desc => "Authentication token"}, - {type => "string", desc => "Patron barcode"}, - {type => "array", desc => "Parts wanted (patron, ready, out, in?)"} - ], - return => { desc => "A hash of parts." } # XXX describe more fully - } -); - - -sub get_bresv_by_returnable_resource_barcode { - my ($self, $client, $auth, $barcode) = @_; - - my $e = new_editor(xact => 1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed("VIEW_USER"); -# return $e->die_event unless $e->allowed("ADMIN_BOOKING_RESERVATION"); - - my $rows = $e->json_query({ - "select" => {"bresv" => ["id"]}, - "from" => { - "bresv" => { - "brsrc" => {"field" => "id", "fkey" => "current_resource"} - } - }, - "where" => { - "+brsrc" => {"barcode" => $barcode}, - "-and" => { - "pickup_time" => {"!=" => undef}, - "cancel_time" => undef, - "return_time" => undef - } - } - }) or return $e->die_event; - - if (@$rows < 1) { - $e->rollback; - return $rows; - } else { - # More than one result might be possible, but we don't want to return - # more than one at this time. - my $id = $rows->[0]->{"id"}; - my $resp =$e->retrieve_booking_reservation([ - $id, { - "flesh" => 2, - "flesh_fields" => { - "bresv" => [qw/usr target_resource_type current_resource/], - "au" => ["card"] - } - } - ]) or $e->die_event; - $e->rollback; - return $resp; - } -} - -__PACKAGE__->register_method( - method => "get_bresv_by_returnable_resource_barcode", - api_name => "open-ils.booking.reservations.by_returnable_resource_barcode", - argc => 2, - signature=> { - params => [ - {type => "string", desc => "Authentication token"}, - {type => "string", desc => "Resource barcode"}, - ], - return => { desc => "A fleshed bresv or an ilsevent on error" } - } -); - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Cat.pm b/Open-ILS/src/perlmods/OpenILS/Application/Cat.pm deleted file mode 100644 index b787999899..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Cat.pm +++ /dev/null @@ -1,1229 +0,0 @@ -use strict; use warnings; -package OpenILS::Application::Cat; -use OpenILS::Application::AppUtils; -use OpenILS::Application; -use OpenILS::Application::Cat::Merge; -use OpenILS::Application::Cat::Authority; -use OpenILS::Application::Cat::BibCommon; -use OpenILS::Application::Cat::AssetCommon; -use base qw/OpenILS::Application/; -use Time::HiRes qw(time); -use OpenSRF::EX qw(:try); -use OpenSRF::Utils::JSON; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Event; -use OpenILS::Const qw/:const/; - -use XML::LibXML; -use Unicode::Normalize; -use Data::Dumper; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Perm; -use OpenSRF::Utils::SettingsClient; -use OpenSRF::Utils::Logger qw($logger); -use OpenSRF::AppSession; - -my $U = "OpenILS::Application::AppUtils"; -my $conf; -my %marctemplates; - -__PACKAGE__->register_method( - method => "retrieve_marc_template", - api_name => "open-ils.cat.biblio.marc_template.retrieve", - notes => <<" NOTES"); - Returns a MARC 'record tree' based on a set of pre-defined templates. - Templates include : book - NOTES - -sub retrieve_marc_template { - my( $self, $client, $type ) = @_; - return $marctemplates{$type} if defined($marctemplates{$type}); - $marctemplates{$type} = _load_marc_template($type); - return $marctemplates{$type}; -} - -__PACKAGE__->register_method( - method => 'fetch_marc_template_types', - api_name => 'open-ils.cat.marc_template.types.retrieve' -); - -my $marc_template_files; - -sub fetch_marc_template_types { - my( $self, $conn ) = @_; - __load_marc_templates(); - return [ keys %$marc_template_files ]; -} - -sub __load_marc_templates { - return if $marc_template_files; - if(!$conf) { $conf = OpenSRF::Utils::SettingsClient->new; } - - $marc_template_files = $conf->config_value( - "apps", "open-ils.cat","app_settings", "marctemplates" ); - - $logger->info("Loaded marc templates: " . Dumper($marc_template_files)); -} - -sub _load_marc_template { - my $type = shift; - - __load_marc_templates(); - - my $template = $$marc_template_files{$type}; - open( F, $template ) or - throw OpenSRF::EX::ERROR ("Unable to open MARC template file: $template : $@"); - - my @xml = ; - close(F); - my $xml = join('', @xml); - - return XML::LibXML->new->parse_string($xml)->documentElement->toString; -} - - - -__PACKAGE__->register_method( - method => 'fetch_bib_sources', - api_name => 'open-ils.cat.bib_sources.retrieve.all'); - -sub fetch_bib_sources { - return OpenILS::Application::Cat::BibCommon->fetch_bib_sources(); -} - -__PACKAGE__->register_method( - method => "create_record_xml", - api_name => "open-ils.cat.biblio.record.xml.create.override", - signature => q/@see open-ils.cat.biblio.record.xml.create/); - -__PACKAGE__->register_method( - method => "create_record_xml", - api_name => "open-ils.cat.biblio.record.xml.create", - signature => q/ - Inserts a new biblio with the given XML - / -); - -sub create_record_xml { - my( $self, $client, $login, $xml, $source ) = @_; - - my $override = 1 if $self->api_name =~ /override/; - - my( $user_obj, $evt ) = $U->checksesperm($login, 'CREATE_MARC'); - return $evt if $evt; - - $logger->activity("user ".$user_obj->id." creating new MARC record"); - - my $meth = $self->method_lookup("open-ils.cat.biblio.record.xml.import"); - - $meth = $self->method_lookup( - "open-ils.cat.biblio.record.xml.import.override") if $override; - - my ($s) = $meth->run($login, $xml, $source); - return $s; -} - - - -__PACKAGE__->register_method( - method => "biblio_record_replace_marc", - api_name => "open-ils.cat.biblio.record.xml.update", - argc => 3, - signature => q/ - Updates the XML for a given biblio record. - This does not change any other aspect of the record entry - exception the XML, the editor, and the edit date. - @return The update record object - / -); - -__PACKAGE__->register_method( - method => 'biblio_record_replace_marc', - api_name => 'open-ils.cat.biblio.record.marc.replace', - signature => q/ - @param auth The authtoken - @param recid The record whose MARC we're replacing - @param newxml The new xml to use - / -); - -__PACKAGE__->register_method( - method => 'biblio_record_replace_marc', - api_name => 'open-ils.cat.biblio.record.marc.replace.override', - signature => q/@see open-ils.cat.biblio.record.marc.replace/ -); - -sub biblio_record_replace_marc { - my( $self, $conn, $auth, $recid, $newxml, $source ) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('CREATE_MARC', $e->requestor->ws_ou); - - my $fix_tcn = $self->api_name =~ /replace/o; - my $override = $self->api_name =~ /override/o; - - my $res = OpenILS::Application::Cat::BibCommon->biblio_record_replace_marc( - $e, $recid, $newxml, $source, $fix_tcn, $override); - - $e->commit unless $U->event_code($res); - - #my $ses = OpenSRF::AppSession->create('open-ils.ingest'); - #$ses->request('open-ils.ingest.full.biblio.record', $recid); - - return $res; -} - -__PACKAGE__->register_method( - method => "template_overlay_biblio_record_entry", - api_name => "open-ils.cat.biblio.record_entry.template_overlay", - stream => 1, - signature => q# - Overlays biblio.record_entry MARC values - @param auth The authtoken - @param records The record ids to be updated by the template - @param template The overlay template - @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success" - # -); - -sub template_overlay_biblio_record_entry { - my($self, $conn, $auth, $records, $template) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - - $records = [$records] if (!ref($records)); - - for my $rid ( @$records ) { - my $rec = $e->retrieve_biblio_record_entry($rid); - next unless $rec; - - unless ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) { - $conn->respond({ record => $rid, success => 'f' }); - next; - } - - my $success = $e->json_query( - { from => [ 'vandelay.template_overlay_bib_record', $template, $rid ] } - )->[0]->{'vandelay.template_overlay_bib_record'}; - - $conn->respond({ record => $rid, success => $success }); - } - - $e->commit; - return undef; -} - -__PACKAGE__->register_method( - method => "template_overlay_container", - api_name => "open-ils.cat.container.template_overlay", - stream => 1, - signature => q# - Overlays biblio.record_entry MARC values - @param auth The authtoken - @param container The container, um, containing the records to be updated by the template - @param template The overlay template, or nothing and the method will look for a negative bib id in the container - @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success" - # -); - -__PACKAGE__->register_method( - method => "template_overlay_container", - api_name => "open-ils.cat.container.template_overlay.background", - stream => 1, - signature => q# - Overlays biblio.record_entry MARC values - @param auth The authtoken - @param container The container, um, containing the records to be updated by the template - @param template The overlay template, or nothing and the method will look for a negative bib id in the container - @return Cache key to check for status of the container overlay - # -); - -sub template_overlay_container { - my($self, $conn, $auth, $container, $template) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - - my $actor = OpenSRF::AppSession->create('open-ils.actor') if ($self->api_name =~ /background$/); - - my $items = $e->search_container_biblio_record_entry_bucket_item({ bucket => $container }); - - my $titem; - if (!$template) { - ($titem) = grep { $_->target_biblio_record_entry < 0 } @$items; - if (!$titem) { - $e->rollback; - return undef; - } - $items = [grep { $_->target_biblio_record_entry > 0 } @$items]; - - $template = $e->retrieve_biblio_record_entry( $titem->target_biblio_record_entry )->marc; - } - - my $responses = []; - my $some_failed = 0; - - $self->respond_complete( - $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses)->gather(1) - ) if ($actor); - - for my $item ( @$items ) { - my $rec = $e->retrieve_biblio_record_entry($item->target_biblio_record_entry); - next unless $rec; - - my $success = 'f'; - if ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) { - $success = $e->json_query( - { from => [ 'vandelay.template_overlay_bib_record', $template, $rec->id ] } - )->[0]->{'vandelay.template_overlay_bib_record'}; - } - - $some_failed++ if ($success eq 'f'); - - if ($actor) { - push @$responses, { record => $rec->id, success => $success }; - $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses); - } else { - $conn->respond({ record => $rec->id, success => $success }); - } - - if ($success eq 't') { - unless ($e->delete_container_biblio_record_entry_bucket_item($item)) { - $e->rollback; - if ($actor) { - push @$responses, { complete => 1, success => 'f' }; - $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses); - return undef; - } else { - return { complete => 1, success => 'f' }; - } - } - } - } - - if ($titem && !$some_failed) { - return $e->die_event unless ($e->delete_container_biblio_record_entry_bucket_item($titem)); - } - - if ($e->commit) { - if ($actor) { - push @$responses, { complete => 1, success => 't' }; - $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses); - } else { - return { complete => 1, success => 't' }; - } - } else { - if ($actor) { - push @$responses, { complete => 1, success => 'f' }; - $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses); - } else { - return { complete => 1, success => 'f' }; - } - } - return undef; -} - -__PACKAGE__->register_method( - method => "update_biblio_record_entry", - api_name => "open-ils.cat.biblio.record_entry.update", - signature => q/ - Updates a biblio.record_entry - @param auth The authtoken - @param record The record with updated values - @return 1 on success, Event on error. - / -); - -sub update_biblio_record_entry { - my($self, $conn, $auth, $record) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('UPDATE_RECORD'); - $e->update_biblio_record_entry($record) or return $e->die_event; - $e->commit; - return 1; -} - -__PACKAGE__->register_method( - method => "undelete_biblio_record_entry", - api_name => "open-ils.cat.biblio.record_entry.undelete", - signature => q/ - Un-deletes a record and sets active=true - @param auth The authtoken - @param record The record_id to ressurect - @return 1 on success, Event on error. - / -); -sub undelete_biblio_record_entry { - my($self, $conn, $auth, $record_id) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('UPDATE_RECORD'); - - my $record = $e->retrieve_biblio_record_entry($record_id) - or return $e->die_event; - $record->deleted('f'); - $record->active('t'); - - # Set the leader/05 to indicate that the record has been corrected/revised - my $marc = $record->marc(); - $marc =~ s{(.{5}).}{$1c}; - $record->marc($marc); - - # no 2 non-deleted records can have the same tcn_value - my $existing = $e->search_biblio_record_entry( - { deleted => 'f', - tcn_value => $record->tcn_value, - id => {'!=' => $record_id} - }, {idlist => 1}); - return OpenILS::Event->new('TCN_EXISTS') if @$existing; - - $e->update_biblio_record_entry($record) or return $e->die_event; - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - method => "biblio_record_xml_import", - api_name => "open-ils.cat.biblio.record.xml.import.override", - signature => q/@see open-ils.cat.biblio.record.xml.import/); - -__PACKAGE__->register_method( - method => "biblio_record_xml_import", - api_name => "open-ils.cat.biblio.record.xml.import", - notes => <<" NOTES"); - Takes a marcxml record and imports the record into the database. In this - case, the marcxml record is assumed to be a complete record (i.e. valid - MARC). The title control number is taken from (whichever comes first) - tags 001, 039[ab], 020a, 022a, 010, 035a and whichever does not already exist - in the database. - user_session must have IMPORT_MARC permissions - NOTES - - -sub biblio_record_xml_import { - my( $self, $client, $authtoken, $xml, $source, $auto_tcn) = @_; - my $e = new_editor(xact=>1, authtoken=>$authtoken); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('IMPORT_MARC', $e->requestor->ws_ou); - - my $override = $self->api_name =~ /override/; - my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import( - $e, $xml, $source, $auto_tcn, $override); - - return $record if $U->event_code($record); - - $e->commit; - - #my $ses = OpenSRF::AppSession->create('open-ils.ingest'); - #$ses->request('open-ils.ingest.full.biblio.record', $record->id); - - return $record; -} - -__PACKAGE__->register_method( - method => "biblio_record_record_metadata", - api_name => "open-ils.cat.biblio.record.metadata.retrieve", - authoritative => 1, - argc => 1, #(session_id, biblio_tree ) - notes => "Walks the tree and commits any changed nodes " . - "adds any new nodes, and deletes any deleted nodes", -); - -sub biblio_record_record_metadata { - my( $self, $client, $authtoken, $ids ) = @_; - - return [] unless $ids and @$ids; - - my $editor = new_editor(authtoken => $authtoken); - return $editor->event unless $editor->checkauth; - return $editor->event unless $editor->allowed('VIEW_USER'); - - my @results; - - for(@$ids) { - return $editor->event unless - my $rec = $editor->retrieve_biblio_record_entry($_); - $rec->creator($editor->retrieve_actor_user($rec->creator)); - $rec->editor($editor->retrieve_actor_user($rec->editor)); - $rec->clear_marc; # slim the record down - push( @results, $rec ); - } - - return \@results; -} - - - -__PACKAGE__->register_method( - method => "biblio_record_marc_cn", - api_name => "open-ils.cat.biblio.record.marc_cn.retrieve", - argc => 1, #(bib id ) - signature => { - desc => 'Extracts call number candidates from a bibliographic record', - params => [ - {desc => 'Record ID', type => 'number'}, - {desc => '(Optional) Classification scheme ID', type => 'number'}, - ] - }, - return => {desc => 'Hash of candidate call numbers identified by tag' } -); - -sub biblio_record_marc_cn { - my( $self, $client, $id, $class ) = @_; - - my $e = new_editor(); - my $marc = $e->retrieve_biblio_record_entry($id)->marc; - - my $doc = XML::LibXML->new->parse_string($marc); - $doc->documentElement->setNamespace( "http://www.loc.gov/MARC21/slim", "marc", 1 ); - - my @fields; - my @res; - if ($class) { - @fields = split(/,/, $e->retrieve_asset_call_number_class($class)->field); - } else { - @fields = qw/050ab 055ab 060ab 070ab 080ab 082ab 086ab 088ab 090 092 096 098 099/; - } - - # Get field/subfield combos based on acnc value; for example "050ab,055ab" - - foreach my $field (@fields) { - my $tag = substr($field, 0, 3); - $logger->debug("Tag = $tag"); - my @node = $doc->findnodes("//marc:datafield[\@tag='$tag']"); - - # Now parse the subfields and build up the subfield XPath - my @subfields = split(//, substr($field, 3)); - - # If they give us no subfields to parse, default to just the 'a' - if (!@subfields) { - @subfields = ('a'); - } - my $subxpath; - foreach my $sf (@subfields) { - $subxpath .= "\@code='$sf' or "; - } - $subxpath = substr($subxpath, 0, -4); - $logger->debug("subxpath = $subxpath"); - - # Find the contents of the specified subfields - foreach my $x (@node) { - my $cn = $x->findvalue("marc:subfield[$subxpath]"); - push @res, {$tag => $cn} if ($cn); - } - } - - return \@res; -} - -__PACKAGE__->register_method( - method => 'autogen_barcodes', - api_name => "open-ils.cat.item.barcode.autogen", - signature => { - desc => 'Returns N generated barcodes following a specified barcode.', - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Barcode which the sequence should follow from', type => 'string'}, - {desc => 'Number of barcodes to generate', type => 'number'}, - {desc => 'Options hash. Currently you can pass in checkdigit : false to disable the use of checkdigits.'} - ], - return => {desc => 'Array of generated barcodes'} - } -); - -sub autogen_barcodes { - my( $self, $client, $auth, $barcode, $num_of_barcodes, $options ) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('UPDATE_COPY', $e->requestor->ws_ou); - $options ||= {}; - - my $barcode_text = ''; - my $barcode_number = 0; - - if ($barcode =~ /^(\D+)/) { $barcode_text = $1; } - if ($barcode =~ /(\d+)$/) { $barcode_number = $1; } - - my @res; - for (my $i = 1; $i <= $num_of_barcodes; $i++) { - my $calculated_barcode; - - # default is to use checkdigits, so looking for an explicit false here - if (defined $$options{'checkdigit'} && ! $$options{'checkdigit'}) { - $calculated_barcode = $barcode_number + $i; - } else { - if ($barcode_number =~ /^\d{8}$/) { - $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0); - } elsif ($barcode_number =~ /^\d{9}$/) { - $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit - } elsif ($barcode_number =~ /^\d{13}$/) { - $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0); - } elsif ($barcode_number =~ /^\d{14}$/) { - $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit - } else { - $calculated_barcode = $barcode_number + $i; - } - } - push @res, $barcode_text . $calculated_barcode; - } - return \@res -} - -# Codabar doesn't define a checkdigit algorithm, but this one is typically used by libraries. gmcharlt++ -sub add_codabar_checkdigit { - my $barcode = shift; - my $strip_last_digit = shift; - - return $barcode if $barcode =~ /\D/; - $barcode = substr($barcode, 0, length($barcode)-1) if $strip_last_digit; - my @digits = split //, $barcode; - my $total = 0; - for (my $i = 1; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 1,3,5,7,9,11 - $total += $digits[$i]; - } - for (my $i = 0; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 0,2,4,6,8,10,12 - $total += (2 * $digits[$i] >= 10) ? (2 * $digits[$i] - 9) : (2 * $digits[$i]); - } - my $remainder = $total % 10; - my $checkdigit = ($remainder == 0) ? $remainder : 10 - $remainder; - return $barcode . $checkdigit; -} - -__PACKAGE__->register_method( - method => "orgs_for_title", - authoritative => 1, - api_name => "open-ils.cat.actor.org_unit.retrieve_by_title" -); - -sub orgs_for_title { - my( $self, $client, $record_id ) = @_; - - my $vols = $U->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.asset.call_number.search.atomic", - { record => $record_id, deleted => 'f' }); - - my $orgs = { map {$_->owning_lib => 1 } @$vols }; - return [ keys %$orgs ]; -} - - -__PACKAGE__->register_method( - method => "retrieve_copies", - authoritative => 1, - api_name => "open-ils.cat.asset.copy_tree.retrieve"); - -__PACKAGE__->register_method( - method => "retrieve_copies", - api_name => "open-ils.cat.asset.copy_tree.global.retrieve"); - -# user_session may be null/undef -sub retrieve_copies { - - my( $self, $client, $user_session, $docid, @org_ids ) = @_; - - if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; } - - $docid = "$docid"; - - # grabbing copy trees should be available for everyone.. - if(!@org_ids and $user_session) { - my($user_obj, $evt) = OpenILS::Application::AppUtils->checkses($user_session); - return $evt if $evt; - @org_ids = ($user_obj->home_ou); - } - - if( $self->api_name =~ /global/ ) { - return _build_volume_list( { record => $docid, deleted => 'f', label => { '<>' => '##URI##' } } ); - - } else { - - my @all_vols; - for my $orgid (@org_ids) { - my $vols = _build_volume_list( - { record => $docid, owning_lib => $orgid, deleted => 'f', label => { '<>' => '##URI##' } } ); - push( @all_vols, @$vols ); - } - - return \@all_vols; - } - - return undef; -} - - -sub _build_volume_list { - my $search_hash = shift; - - $search_hash->{deleted} = 'f'; - my $e = new_editor(); - - my $vols = $e->search_asset_call_number([$search_hash, { 'order_by' => { - 'acn' => 'oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib' - } } ] ); - - my @volumes; - - for my $volume (@$vols) { - - my $copies = $e->search_asset_copy( - { call_number => $volume->id , deleted => 'f' }); - - $copies = [ sort { $a->barcode cmp $b->barcode } @$copies ]; - - for my $c (@$copies) { - if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) { - $c->circulations( - $e->search_action_circulation( - [ - { target_copy => $c->id }, - { - order_by => { circ => 'xact_start desc' }, - limit => 1 - } - ] - ) - ) - } - } - - $volume->copies($copies); - push( @volumes, $volume ); - } - - #$session->disconnect(); - return \@volumes; - -} - - -__PACKAGE__->register_method( - method => "fleshed_copy_update", - api_name => "open-ils.cat.asset.copy.fleshed.batch.update",); - -__PACKAGE__->register_method( - method => "fleshed_copy_update", - api_name => "open-ils.cat.asset.copy.fleshed.batch.update.override",); - - -sub fleshed_copy_update { - my( $self, $conn, $auth, $copies, $delete_stats ) = @_; - return 1 unless ref $copies; - my( $reqr, $evt ) = $U->checkses($auth); - return $evt if $evt; - my $editor = new_editor(requestor => $reqr, xact => 1); - my $override = $self->api_name =~ /override/; - my $retarget_holds = []; - $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies( - $editor, $override, undef, $copies, $delete_stats, $retarget_holds, undef); - - if( $evt ) { - $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt)); - $editor->rollback; - return $evt; - } - - $editor->commit; - $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies"); - reset_hold_list($auth, $retarget_holds); - - return 1; -} - -sub reset_hold_list { - my($auth, $hold_ids) = @_; - return unless @$hold_ids; - $logger->info("reseting holds after copy status change: @$hold_ids"); - my $ses = OpenSRF::AppSession->create('open-ils.circ'); - $ses->request('open-ils.circ.hold.reset.batch', $auth, $hold_ids); -} - - -__PACKAGE__->register_method( - method => 'in_db_merge', - api_name => 'open-ils.cat.biblio.records.merge', - signature => q/ - Merges a group of records - @param auth The login session key - @param master The id of the record all other records should be merged into - @param records Array of records to be merged into the master record - @return 1 on success, Event on error. - / -); - -sub in_db_merge { - my( $self, $conn, $auth, $master, $records ) = @_; - - my $editor = new_editor( authtoken => $auth, xact => 1 ); - return $editor->die_event unless $editor->checkauth; - return $editor->die_event unless $editor->allowed('MERGE_BIB_RECORDS'); # TODO see below about record ownership - - my $count = 0; - for my $source ( @$records ) { - #XXX we actually /will/ want to check perms for master and sources after record ownership exists - - # This stored proc (asset.merge_record_assets(target,source)) has the side effects of - # moving call_number, title-type (and some volume-type) hold_request and uri-mapping - # objects from the source record to the target record, so must be called from within - # a transaction. - - $count += $editor->json_query({ - select => { - bre => [{ - alias => 'count', - transform => 'asset.merge_record_assets', - column => 'id', - params => [$source] - }] - }, - from => 'bre', - where => { id => $master } - })->[0]->{count}; # count of objects moved, of all types - - } - - $editor->commit; - return $count; -} - -__PACKAGE__->register_method( - method => 'in_db_auth_merge', - api_name => 'open-ils.cat.authority.records.merge', - signature => q/ - Merges a group of authority records - @param auth The login session key - @param master The id of the record all other records should be merged into - @param records Array of records to be merged into the master record - @return 1 on success, Event on error. - / -); - -sub in_db_auth_merge { - my( $self, $conn, $auth, $master, $records ) = @_; - - my $editor = new_editor( authtoken => $auth, xact => 1 ); - return $editor->die_event unless $editor->checkauth; - return $editor->die_event unless $editor->allowed('MERGE_AUTH_RECORDS'); # TODO see below about record ownership - - my $count = 0; - for my $source ( @$records ) { - $count += $editor->json_query({ - select => { - are => [{ - alias => 'count', - transform => 'authority.merge_records', - column => 'id', - params => [$source] - }] - }, - from => 'are', - where => { id => $master } - })->[0]->{count}; # count of objects moved, of all types - } - - $editor->commit; - return $count; -} - -__PACKAGE__->register_method( - method => "fleshed_volume_update", - api_name => "open-ils.cat.asset.volume.fleshed.batch.update",); - -__PACKAGE__->register_method( - method => "fleshed_volume_update", - api_name => "open-ils.cat.asset.volume.fleshed.batch.update.override",); - -sub fleshed_volume_update { - my( $self, $conn, $auth, $volumes, $delete_stats, $options ) = @_; - my( $reqr, $evt ) = $U->checkses($auth); - return $evt if $evt; - $options ||= {}; - - my $override = ($self->api_name =~ /override/); - my $editor = new_editor( requestor => $reqr, xact => 1 ); - my $retarget_holds = []; - my $auto_merge_vols = $options->{auto_merge_vols}; - - for my $vol (@$volumes) { - $logger->info("vol-update: investigating volume ".$vol->id); - - $vol->editor($reqr->id); - $vol->edit_date('now'); - - my $copies = $vol->copies; - $vol->clear_copies; - - $vol->editor($editor->requestor->id); - $vol->edit_date('now'); - - if( $vol->isdeleted ) { - - $logger->info("vol-update: deleting volume"); - my $cs = $editor->search_asset_copy( - { call_number => $vol->id, deleted => 'f' } ); - return OpenILS::Event->new( - 'VOLUME_NOT_EMPTY', payload => $vol->id ) if @$cs; - - $vol->deleted('t'); - return $editor->event unless - $editor->update_asset_call_number($vol); - - - } elsif( $vol->isnew ) { - $logger->info("vol-update: creating volume"); - $evt = OpenILS::Application::Cat::AssetCommon->create_volume( $override, $editor, $vol ); - return $evt if $evt; - - } elsif( $vol->ischanged ) { - $logger->info("vol-update: update volume"); - my $resp = update_volume($vol, $editor, ($override or $auto_merge_vols)); - return $resp->{evt} if $resp->{evt}; - $vol = $resp->{merge_vol}; - } - - # now update any attached copies - if( $copies and @$copies and !$vol->isdeleted ) { - $_->call_number($vol->id) for @$copies; - $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies( - $editor, $override, $vol, $copies, $delete_stats, $retarget_holds, undef); - return $evt if $evt; - } - } - - $editor->finish; - reset_hold_list($auth, $retarget_holds); - return scalar(@$volumes); -} - - -sub update_volume { - my $vol = shift; - my $editor = shift; - my $auto_merge = shift; - my $evt; - my $merge_vol; - - return {evt => $evt} - if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) ); - - my $vols = $editor->search_asset_call_number({ - owning_lib => $vol->owning_lib, - record => $vol->record, - label => $vol->label, - deleted => 'f', - id => {'!=' => $vol->id} - }); - - if(@$vols) { - - if($auto_merge) { - - # If the auto-merge option is on, merge our updated volume into the existing - # volume with the same record + owner + label. - ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]); - return {evt => $evt, merge_vol => $merge_vol}; - - } else { - return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)}; - } - } - - return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol); - return {}; -} - - - -__PACKAGE__->register_method ( - method => 'delete_bib_record', - api_name => 'open-ils.cat.biblio.record_entry.delete'); - -sub delete_bib_record { - my($self, $conn, $auth, $rec_id) = @_; - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou); - my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'}); - return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols; - my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id); - if($evt) { $e->rollback; return $evt; } - $e->commit; - return 1; -} - - - -__PACKAGE__->register_method ( - method => 'batch_volume_transfer', - api_name => 'open-ils.cat.asset.volume.batch.transfer', -); - -__PACKAGE__->register_method ( - method => 'batch_volume_transfer', - api_name => 'open-ils.cat.asset.volume.batch.transfer.override', -); - - -sub batch_volume_transfer { - my( $self, $conn, $auth, $args ) = @_; - - my $evt; - my $rec = $$args{docid}; - my $o_lib = $$args{lib}; - my $vol_ids = $$args{volumes}; - - my $override = 1 if $self->api_name =~ /override/; - - $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec"); - - my $e = new_editor(authtoken => $auth, xact =>1); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib); - - my $dorg = $e->retrieve_actor_org_unit($o_lib) - or return $e->event; - - my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type) - or return $e->event; - - return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) ); - - my $vols = $e->batch_retrieve_asset_call_number($vol_ids); - my @seen; - - my @rec_ids; - - for my $vol (@$vols) { - - # if we've already looked at this volume, go to the next - next if !$vol or grep { $vol->id == $_ } @seen; - - # grab all of the volumes in the list that have - # the same label so they can be merged - my @all = grep { $_->label eq $vol->label } @$vols; - - # take note of the fact that we've looked at this set of volumes - push( @seen, $_->id ) for @all; - push( @rec_ids, $_->record ) for @all; - - # for each volume, see if there are any copies that have a - # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ). - # if so, warn them - unless( $override ) { - for my $v (@all) { - - $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id); - my $args = { - call_number => $v->id, - circ_lib => { "not in" => [ $o_lib, $v->owning_lib ] }, - deleted => 'f' - }; - - my $copies = $e->search_asset_copy($args, {idlist=>1}); - - # if the copy's circ_lib matches the destination lib, - # that's ok too - return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies; - } - } - - # see if there is a volume at the destination lib that - # already has the requested label - my $existing_vol = $e->search_asset_call_number( - { - label => $vol->label, - record => $rec, - owning_lib => $o_lib, - deleted => 'f' - } - )->[0]; - - if( $existing_vol ) { - - if( grep { $_->id == $existing_vol->id } @all ) { - # this volume is already accounted for in our list of volumes to merge - $existing_vol = undef; - - } else { - # this volume exists on the destination record/owning_lib and must - # be used as the destination for merging - $logger->debug("merge: volume already exists at destination record: ". - $existing_vol->id.' : '.$existing_vol->label) if $existing_vol; - } - } - - if( @all > 1 || $existing_vol ) { - $logger->info("merge: found collisions in volume transfer"); - my @args = ($e, \@all); - @args = ($e, \@all, $existing_vol) if $existing_vol; - ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args); - return $evt if $evt; - } - - if( !$existing_vol ) { - - $vol->owning_lib($o_lib); - $vol->record($rec); - $vol->editor($e->requestor->id); - $vol->edit_date('now'); - - $logger->info("merge: updating volume ".$vol->id); - $e->update_asset_call_number($vol) or return $e->event; - - } else { - $logger->info("merge: bypassing volume update because existing volume used as target"); - } - - # regardless of what volume was used as the destination, - # update any copies that have moved over to the new lib - my $copies = $e->search_asset_copy({call_number=>$vol->id, deleted => 'f'}); - - # update circ lib on the copies - make this a method flag? - for my $copy (@$copies) { - next if $copy->circ_lib == $o_lib; - $logger->info("merge: transfer moving circ lib on copy ".$copy->id); - $copy->circ_lib($o_lib); - $copy->editor($e->requestor->id); - $copy->edit_date('now'); - $e->update_asset_copy($copy) or return $e->event; - } - - # Now see if any empty records need to be deleted after all of this - - for(@rec_ids) { - $logger->debug("merge: seeing if we should delete record $_..."); - $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_) - if OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_); - return $evt if $evt; - } - } - - $logger->info("merge: transfer succeeded"); - $e->commit; - return 1; -} - - - - -__PACKAGE__->register_method( - api_name => 'open-ils.cat.call_number.find_or_create', - method => 'find_or_create_volume', -); - -sub find_or_create_volume { - my( $self, $conn, $auth, $label, $record_id, $org_id ) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - my ($vol, $evt, $exists) = - OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id); - return $evt if $evt; - $e->rollback if $exists; - $e->commit if $vol; - return $vol->id; -} - - -__PACKAGE__->register_method( - method => "create_serial_record_xml", - api_name => "open-ils.cat.serial.record.xml.create.override", - signature => q/@see open-ils.cat.serial.record.xml.create/); - -__PACKAGE__->register_method( - method => "create_serial_record_xml", - api_name => "open-ils.cat.serial.record.xml.create", - signature => q/ - Inserts a new serial record with the given XML - / -); - -sub create_serial_record_xml { - my( $self, $client, $login, $source, $owning_lib, $record_id, $xml ) = @_; - - my $override = 1 if $self->api_name =~ /override/; # not currently used - - my $e = new_editor(xact=>1, authtoken=>$login); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib); - - # Auto-populate the location field of a placeholder MFHD record with the library name - my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event; - - my $mfhd = Fieldmapper::serial::record_entry->new; - - $mfhd->source($source) if $source; - $mfhd->record($record_id); - $mfhd->creator($e->requestor->id); - $mfhd->editor($e->requestor->id); - $mfhd->create_date('now'); - $mfhd->edit_date('now'); - $mfhd->owning_lib($owning_lib); - - # If the caller did not pass in MFHD XML, create a placeholder record. - # The placeholder will only contain the name of the owning library. - # The goal is to generate common patterns for the caller in the UI that - # then get passed in here. - if (!$xml) { - my $aou_name = $aou->name; - $xml = < -00307ny a22001094 4500 -42153 -20090601182414.0 -$record_id - 4u####8###l# 4 uueng1 - $aou_name - -HERE - } - my $marcxml = XML::LibXML->new->parse_string($xml); - $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 ); - $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim"); - - $mfhd->marc($U->entityize($marcxml->documentElement->toString)); - - $e->create_serial_record_entry($mfhd) or return $e->die_event; - - $e->commit; - return $mfhd->id; -} - -__PACKAGE__->register_method( - method => "create_update_asset_copy_template", - api_name => "open-ils.cat.asset.copy_template.create_or_update" -); - -sub create_update_asset_copy_template { - my ($self, $client, $authtoken, $act) = @_; - - my $e = new_editor("xact" => 1, "authtoken" => $authtoken); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed( - "ADMIN_ASSET_COPY_TEMPLATE", $act->owning_lib - ); - - $act->editor($e->requestor->id); - $act->edit_date("now"); - - my $retval; - if (!$act->id) { - $act->creator($e->requestor->id); - $act->create_date("now"); - - $e->create_asset_copy_template($act) or return $e->die_event; - $retval = $e->data; - } else { - $e->update_asset_copy_template($act) or return $e->die_event; - $retval = $e->retrieve_asset_copy_template($e->data); - } - $e->commit and return $retval; -} - -1; - -# vi:et:ts=4:sw=4 diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Cat/AssetCommon.pm b/Open-ILS/src/perlmods/OpenILS/Application/Cat/AssetCommon.pm deleted file mode 100644 index b2dffc5518..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Cat/AssetCommon.pm +++ /dev/null @@ -1,513 +0,0 @@ -package OpenILS::Application::Cat::AssetCommon; -use strict; use warnings; -use OpenILS::Application::Cat::BibCommon; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenSRF::Utils::Logger qw($logger); -use OpenILS::Application::Cat::Merge; -use OpenILS::Application::AppUtils; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Const qw/:const/; -use OpenSRF::AppSession; -use OpenILS::Event; -use OpenILS::Application::Circ::CircCommon; -my $U = 'OpenILS::Application::AppUtils'; - - -# --------------------------------------------------------------------------- -# Shared copy mangling code. Do not publish methods from here. -# --------------------------------------------------------------------------- - -sub org_cannot_have_vols { - my($class, $e, $org_id) = @_; - my $org = $e->retrieve_actor_org_unit([ - $org_id, - { flesh => 1, - flesh_fields => {aou => ['ou_type']} - }]) or return $e->event; - - return OpenILS::Event->new('ORG_CANNOT_HAVE_VOLS') - unless $U->is_true($org->ou_type->can_have_vols); - - return 0; -} - -sub fix_copy_price { - my $class = shift; - my $copy = shift; - - if(defined $copy->price) { - my $p = $copy->price || 0; - $p =~ s/\$//og; - $copy->price($p); - } - - my $d = $copy->deposit_amount || 0; - $d =~ s/\$//og; - $copy->deposit_amount($d); -} - -sub create_copy { - my($class, $editor, $vol, $copy) = @_; - - my $existing = $editor->search_asset_copy( - { barcode => $copy->barcode, deleted => 'f' } ); - - return OpenILS::Event->new('ITEM_BARCODE_EXISTS') if @$existing; - - # see if the volume this copy references is marked as deleted - return OpenILS::Event->new('VOLUME_DELETED', vol => $vol->id) - if $U->is_true($vol->deleted); - - my $evt; - my $org = (ref $copy->circ_lib) ? $copy->circ_lib->id : $copy->circ_lib; - return $evt if ($evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $org)); - - $copy->clear_id; - $copy->editor($editor->requestor->id); - $copy->creator($editor->requestor->id); - $copy->create_date('now'); - $copy->call_number($vol->id); - $class->fix_copy_price($copy); - - $editor->create_asset_copy($copy) or return $editor->die_event; - return undef; -} - - -# if 'delete_stats' is true, the copy->stat_cat_entries data is -# treated as the authoritative list for the copy. existing entries -# that are not in said list will be deleted from the DB -sub update_copy_stat_entries { - my($class, $editor, $copy, $delete_stats) = @_; - - return undef if $copy->isdeleted; - return undef unless $copy->ischanged or $copy->isnew; - - my $evt; - my $entries = $copy->stat_cat_entries; - - if( $delete_stats ) { - $entries = ($entries and @$entries) ? $entries : []; - } else { - return undef unless ($entries and @$entries); - } - - my $maps = $editor->search_asset_stat_cat_entry_copy_map({owning_copy=>$copy->id}); - - if(!$copy->isnew) { - # if there is no stat cat entry on the copy who's id matches the - # current map's id, remove the map from the database - for my $map (@$maps) { - if(! grep { $_->id == $map->stat_cat_entry } @$entries ) { - - $logger->info("copy update found stale ". - "stat cat entry map ".$map->id. " on copy ".$copy->id); - - $editor->delete_asset_stat_cat_entry_copy_map($map) - or return $editor->event; - } - } - } - - # go through the stat cat update/create process - for my $entry (@$entries) { - next unless $entry; - - # if this link already exists in the DB, don't attempt to re-create it - next if( grep{$_->stat_cat_entry == $entry->id} @$maps ); - - my $new_map = Fieldmapper::asset::stat_cat_entry_copy_map->new(); - - my $sc = ref($entry->stat_cat) ? $entry->stat_cat->id : $entry->stat_cat; - - $new_map->stat_cat( $sc ); - $new_map->stat_cat_entry( $entry->id ); - $new_map->owning_copy( $copy->id ); - - $editor->create_asset_stat_cat_entry_copy_map($new_map) - or return $editor->event; - - $logger->info("copy update created new stat cat entry map ".$editor->data); - } - - return undef; -} - - -sub update_copy { - my($class, $editor, $override, $vol, $copy, $retarget_holds, $force_delete_empty_bib) = @_; - - my $evt; - my $org = (ref $copy->circ_lib) ? $copy->circ_lib->id : $copy->circ_lib; - return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $org) ); - - $logger->info("vol-update: updating copy ".$copy->id); - my $orig_copy = $editor->retrieve_asset_copy($copy->id); - my $orig_vol = $editor->retrieve_asset_call_number($copy->call_number); - - $copy->editor($editor->requestor->id); - $copy->edit_date('now'); - - $copy->age_protect( $copy->age_protect->id ) - if ref $copy->age_protect; - - $class->fix_copy_price($copy); - $class->check_hold_retarget($editor, $copy, $orig_copy, $retarget_holds); - - return $editor->event unless $editor->update_asset_copy($copy); - return $class->remove_empty_objects($editor, $override, $orig_vol, $force_delete_empty_bib); -} - -sub check_hold_retarget { - my($class, $editor, $copy, $orig_copy, $retarget_holds) = @_; - return unless $retarget_holds; - - if( !($copy->isdeleted or $U->is_true($copy->deleted)) ) { - # see if a status change warrants a retarget - - $orig_copy = $editor->retrieve_asset_copy($copy->id) unless $orig_copy; - - if($orig_copy->status == $copy->status) { - # no status change, no retarget - return; - } - - my $stat = $editor->retrieve_config_copy_status($copy->status); - - # new status is holdable, no retarget. Later add logic to find potential - # holds and retarget those to pick up the newly available copy - return if $U->is_true($stat->holdable); - } - - my $hold_ids = $editor->search_action_hold_request( - { current_copy => $copy->id, - cancel_time => undef, - fulfillment_time => undef - }, {idlist => 1} - ); - - push(@$retarget_holds, @$hold_ids); -} - - -# this does the actual work -sub update_fleshed_copies { - my($class, $editor, $override, $vol, $copies, $delete_stats, $retarget_holds, $force_delete_empty_bib) = @_; - - my $evt; - my $fetchvol = ($vol) ? 0 : 1; - - my %cache; - $cache{$vol->id} = $vol if $vol; - - for my $copy (@$copies) { - - my $copyid = $copy->id; - $logger->info("vol-update: inspecting copy $copyid"); - - if( !($vol = $cache{$copy->call_number}) ) { - $vol = $cache{$copy->call_number} = - $editor->retrieve_asset_call_number($copy->call_number); - return $editor->event unless $vol; - } - - return $editor->event unless - $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy)); - - $copy->editor($editor->requestor->id); - $copy->edit_date('now'); - - $copy->status( $copy->status->id ) if ref($copy->status); - $copy->location( $copy->location->id ) if ref($copy->location); - $copy->circ_lib( $copy->circ_lib->id ) if ref($copy->circ_lib); - - my $sc_entries = $copy->stat_cat_entries; - $copy->clear_stat_cat_entries; - - if( $copy->isdeleted ) { - $evt = $class->delete_copy($editor, $override, $vol, $copy, $retarget_holds, $force_delete_empty_bib); - return $evt if $evt; - - } elsif( $copy->isnew ) { - $evt = $class->create_copy( $editor, $vol, $copy ); - return $evt if $evt; - - } elsif( $copy->ischanged ) { - - $evt = $class->update_copy( $editor, $override, $vol, $copy, $retarget_holds, $force_delete_empty_bib); - return $evt if $evt; - } - - $copy->stat_cat_entries( $sc_entries ); - $evt = $class->update_copy_stat_entries($editor, $copy, $delete_stats); - return $evt if $evt; - } - - $logger->debug("vol-update: done updating copy batch"); - - return undef; -} - - -sub delete_copy { - my($class, $editor, $override, $vol, $copy, $retarget_holds, $force_delete_empty_bib) = @_; - - return $editor->event unless - $editor->allowed('DELETE_COPY', $class->copy_perm_org($vol, $copy)); - - my $stat = $U->copy_status($copy->status)->id; - - unless($override) { - return OpenILS::Event->new('COPY_DELETE_WARNING', payload => $copy->id ) - if $stat == OILS_COPY_STATUS_CHECKED_OUT or - $stat == OILS_COPY_STATUS_IN_TRANSIT or - $stat == OILS_COPY_STATUS_ON_HOLDS_SHELF or - $stat == OILS_COPY_STATUS_ILL; - } - - $logger->info("vol-update: deleting copy ".$copy->id); - $copy->deleted('t'); - - $copy->editor($editor->requestor->id); - $copy->edit_date('now'); - $editor->update_asset_copy($copy) or return $editor->event; - - # Delete any open transits for this copy - my $transits = $editor->search_action_transit_copy( - { target_copy=>$copy->id, dest_recv_time => undef } ); - - for my $t (@$transits) { - $editor->delete_action_transit_copy($t) - or return $editor->event; - } - - $class->check_hold_retarget($editor, $copy, undef, $retarget_holds); - - return $class->remove_empty_objects($editor, $override, $vol, $force_delete_empty_bib); -} - - - -sub create_volume { - my($class, $override, $editor, $vol) = @_; - my $evt; - - return $evt if ( $evt = $class->org_cannot_have_vols($editor, $vol->owning_lib) ); - - # see if the record this volume references is marked as deleted - my $rec = $editor->retrieve_biblio_record_entry($vol->record) - or return $editor->die_event; - return OpenILS::Event->new('BIB_RECORD_DELETED', rec => $rec->id) - if $U->is_true($rec->deleted); - - # first lets see if there are any collisions - my $vols = $editor->search_asset_call_number( { - owning_lib => $vol->owning_lib, - record => $vol->record, - label => $vol->label, - deleted => 'f' - } - ); - - my $label = undef; - if(@$vols) { - # we've found an exising volume - if($override) { - $label = $vol->label; - } else { - return OpenILS::Event->new( - 'VOLUME_LABEL_EXISTS', payload => $vol->id); - } - } - - # create a temp label so we can create the new volume, - # then de-dup it with the existing volume - $vol->label( "__SYSTEM_TMP_$$".time) if $label; - - $vol->creator($editor->requestor->id); - $vol->create_date('now'); - $vol->editor($editor->requestor->id); - $vol->edit_date('now'); - $vol->clear_id; - - $editor->create_asset_call_number($vol) or return $editor->die_event; - - if($label) { - # now restore the label and merge into the existing record - $vol->label($label); - (undef, $evt) = - OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $$vols[0]); - return $evt if $evt; - } - - return undef; -} - -# returns the volume if it exists -sub volume_exists { - my($class, $e, $rec_id, $label, $owning_lib) = @_; - return $e->search_asset_call_number( - {label => $label, record => $rec_id, owning_lib => $owning_lib, deleted => 'f'})->[0]; -} - -sub find_or_create_volume { - my($class, $e, $label, $record_id, $org_id) = @_; - - my $vol; - - if($record_id == OILS_PRECAT_RECORD) { - $vol = $e->retrieve_asset_call_number(OILS_PRECAT_CALL_NUMBER) - or return (undef, $e->die_event); - - } else { - $vol = $class->volume_exists($e, $record_id, $label, $org_id); - } - - # If the volume exists, return the ID - return ($vol, undef, 1) if $vol; - - # ----------------------------------------------------------------- - # Otherwise, create a new volume with the given attributes - # ----------------------------------------------------------------- - return (undef, $e->die_event) unless $e->allowed('UPDATE_VOLUME', $org_id); - - $vol = Fieldmapper::asset::call_number->new; - $vol->owning_lib($org_id); - $vol->label($label); - $vol->record($record_id); - - my $evt = OpenILS::Application::Cat::AssetCommon->create_volume(0, $e, $vol); - return (undef, $evt) if $evt; - - return ($vol); -} - - -sub create_copy_note { - my($class, $e, $copy, $title, $value, $pub) = @_; - my $note = Fieldmapper::asset::copy_note->new; - $note->owning_copy($copy->id); - $note->creator($e->requestor->id); - $note->pub('t'); - $note->value($value); - $note->title($title); - $e->create_asset_copy_note($note) or return $e->die_event; - return undef; -} - - -sub remove_empty_objects { - my($class, $editor, $override, $vol, $force_delete_empty_bib) = @_; - - my $koe = $U->ou_ancestor_setting_value( - $editor->requestor->ws_ou, 'cat.bib.keep_on_empty', $editor); - my $aoe = $U->ou_ancestor_setting_value( - $editor->requestor->ws_ou, 'cat.bib.alert_on_empty', $editor); - - if( OpenILS::Application::Cat::BibCommon->title_is_empty($editor, $vol->record, $vol->id) ) { - - # delete this volume if it's not already marked as deleted - unless( $U->is_true($vol->deleted) || $vol->isdeleted ) { - $vol->deleted('t'); - $vol->editor($editor->requestor->id); - $vol->edit_date('now'); - $editor->update_asset_call_number($vol) or return $editor->event; - } - - return OpenILS::Event->new('TITLE_LAST_COPY', payload => $vol->record ) - if $aoe and not $override and not $force_delete_empty_bib; - - unless($koe and not $force_delete_empty_bib) { - # delete the bib record if the keep-on-empty setting is not set (and we're not otherwise forcing things, say through acq settings) - my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($editor, $vol->record); - return $evt if $evt; - } - } - - return undef; -} - - -sub copy_perm_org { - my($class, $vol, $copy) = @_; - my $org = $vol->owning_lib; - if( $vol->id == OILS_PRECAT_CALL_NUMBER ) { - $org = ref($copy->circ_lib) ? $copy->circ_lib->id : $copy->circ_lib; - } - $logger->debug("using copy perm org $org"); - return $org; -} - - -sub set_item_lost { - my($class, $e, $copy_id) = @_; - - my $copy = $e->retrieve_asset_copy([ - $copy_id, - {flesh => 1, flesh_fields => {'acp' => ['call_number']}}]) - or return $e->die_event; - - my $owning_lib = - ($copy->call_number->id == OILS_PRECAT_CALL_NUMBER) ? - $copy->circ_lib : $copy->call_number->owning_lib; - - my $circ = $e->search_action_circulation( - {checkin_time => undef, target_copy => $copy->id} )->[0] - or return $e->die_event; - - $e->allowed('SET_CIRC_LOST', $circ->circ_lib) or return $e->die_event; - - return $e->die_event(OpenILS::Event->new('COPY_MARKED_LOST')) - if $copy->status == OILS_COPY_STATUS_LOST; - - # --------------------------------------------------------------------- - # fetch the related org settings - my $proc_fee = $U->ou_ancestor_setting_value( - $owning_lib, OILS_SETTING_LOST_PROCESSING_FEE, $e) || 0; - my $void_overdue = $U->ou_ancestor_setting_value( - $owning_lib, OILS_SETTING_VOID_OVERDUE_ON_LOST, $e) || 0; - - # --------------------------------------------------------------------- - # move the copy into LOST status - $copy->status(OILS_COPY_STATUS_LOST); - $copy->editor($e->requestor->id); - $copy->edit_date('now'); - $e->update_asset_copy($copy) or return $e->die_event; - - my $price = $U->get_copy_price($e, $copy, $copy->call_number); - - if( $price > 0 ) { - my $evt = OpenILS::Application::Circ::CircCommon->create_bill( - $e, $price, 3, 'Lost Materials', $circ->id); - return $evt if $evt; - } - - # --------------------------------------------------------------------- - # if there is a processing fee, charge that too - if( $proc_fee > 0 ) { - my $evt = OpenILS::Application::Circ::CircCommon->create_bill( - $e, $proc_fee, 4, 'Lost Materials Processing Fee', $circ->id); - return $evt if $evt; - } - - # --------------------------------------------------------------------- - # mark the circ as lost and stop the fines - $circ->stop_fines(OILS_STOP_FINES_LOST); - $circ->stop_fines_time('now') unless $circ->stop_fines_time; - $e->update_action_circulation($circ) or return $e->die_event; - - # --------------------------------------------------------------------- - # void all overdue fines on this circ if configured - if( $void_overdue ) { - my $evt = OpenILS::Application::Circ::CircCommon->void_overdues($e, $circ); - return $evt if $evt; - } - - my $evt = OpenILS::Application::Circ::CircCommon->reopen_xact($e, $circ->id); - return $evt if $evt; - - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - $ses->request('open-ils.trigger.event.autocreate', 'lost', $circ, $circ->circ_lib); - - return undef; -} diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Cat/AuthCommon.pm b/Open-ILS/src/perlmods/OpenILS/Application/Cat/AuthCommon.pm deleted file mode 100644 index a8ef1f0bcb..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Cat/AuthCommon.pm +++ /dev/null @@ -1,67 +0,0 @@ -package OpenILS::Application::Cat::AuthCommon; -use strict; use warnings; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenSRF::Utils::Logger qw($logger); -use OpenILS::Application::AppUtils; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Const qw/:const/; -use OpenSRF::AppSession; -use OpenILS::Event; -my $U = 'OpenILS::Application::AppUtils'; -my $MARC_NAMESPACE = 'http://www.loc.gov/MARC21/slim'; - - -# --------------------------------------------------------------------------- -# Shared authority mangling code. Do not publish methods from here. -# --------------------------------------------------------------------------- - -# generate a MARC XML document from a MARC XML string -sub marc_xml_to_doc { - my $xml = shift; - my $marc_doc = XML::LibXML->new->parse_string($xml); - $marc_doc->documentElement->setNamespace($MARC_NAMESPACE, 'marc', 1); - $marc_doc->documentElement->setNamespace($MARC_NAMESPACE); - return $marc_doc; -} - - -sub import_authority_record { - my($class, $e, $marc_xml, $source) = @_; - - my $marc_doc = marc_xml_to_doc($marc_xml); - my $rec = Fieldmapper::authority::record_entry->new; - $rec->creator($e->requestor->id); - $rec->editor($e->requestor->id); - $rec->create_date('now'); - $rec->edit_date('now'); - $rec->marc($U->entityize($marc_doc->documentElement->toString)); - - $rec = $e->create_authority_record_entry($rec) or return $e->die_event; - - # we don't care about the result, just fire off the request - #my $ses = OpenSRF::AppSession->create('open-ils.ingest'); - #$ses->request('open-ils.ingest.full.authority.record', $recid); - - return $rec; -} - - -sub overlay_authority_record { - my($class, $e, $rec_id, $marc_xml, $source) = @_; - - my $marc_doc = marc_xml_to_doc($marc_xml); - my $rec = $e->retrieve_authority_record_entry($rec_id) or return $e->die_event; - $rec->editor($e->requestor->id); - $rec->edit_date('now'); - $rec->marc($U->entityize($marc_doc->documentElement->toString)); - - $rec = $e->update_authority_record_entry($rec) or return $e->die_event; - - # we don't care about the result, just fire off the request - #my $ses = OpenSRF::AppSession->create('open-ils.ingest'); - #$ses->request('open-ils.ingest.full.authority.record', $recid); - - return $rec; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Cat/Authority.pm b/Open-ILS/src/perlmods/OpenILS/Application/Cat/Authority.pm deleted file mode 100644 index 1995edf887..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Cat/Authority.pm +++ /dev/null @@ -1,229 +0,0 @@ -package OpenILS::Application::Cat::Authority; -use strict; use warnings; -use base qw/OpenILS::Application/; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Application::Cat::AuthCommon; -use OpenSRF::Utils::Logger qw($logger); -use OpenILS::Application::AppUtils; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Const qw/:const/; -use OpenILS::Event; -my $U = 'OpenILS::Application::AppUtils'; -my $MARC_NAMESPACE = 'http://www.loc.gov/MARC21/slim'; - - -# generate a MARC XML document from a MARC XML string -sub marc_xml_to_doc { - my $xml = shift; - my $marc_doc = XML::LibXML->new->parse_string($xml); - $marc_doc->documentElement->setNamespace($MARC_NAMESPACE, 'marc', 1); - $marc_doc->documentElement->setNamespace($MARC_NAMESPACE); - return $marc_doc; -} - - -__PACKAGE__->register_method( - method => 'import_authority_record', - api_name => 'open-ils.cat.authority.record.import', -); - -sub import_authority_record { - my($self, $conn, $auth, $marc_xml, $source) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('CREATE_AUTHORITY_RECORD'); - my $rec = OpenILS::Application::Cat::AuthCommon->import_authority_record($marc_xml, $source); - $e->commit unless $U->event_code($rec); - return $rec; -} - -__PACKAGE__->register_method( - method => 'create_authority_record_from_bib_field', - api_name => 'open-ils.cat.authority.record.create_from_bib', - signature => { - desc => q/Create an authority record entry from a field in a bibliographic record/, - params => q/ - @param field A hash representing the field to control, consisting of: { tag: string, ind1: string, ind2: string, subfields: [ [code, value] ... ] } - @param identifier A MARC control number identifier - @param authtoken A valid authentication token - @returns The new record object - /} -); - -__PACKAGE__->register_method( - method => 'create_authority_record_from_bib_field', - api_name => 'open-ils.cat.authority.record.create_from_bib.readonly', - signature => { - desc => q/Creates MARCXML for an authority record entry from a field in a bibliographic record/, - params => q/ - @param field A hash representing the field to control, consisting of: { tag: string, ind1: string, ind2: string, subfields: [ [code, value] ... ] } - @param identifier A MARC control number identifier - @returns The MARCXML for the authority record - /} -); - -sub create_authority_record_from_bib_field { - my($self, $conn, $field, $cni, $auth) = @_; - - # Control number identifier should have been passed in - if (!$cni) { - $cni = 'UNSET'; - } - - # Change the first character of the incoming bib field tag to a '1' - # for use in our authority record; close enough for now? - my $tag = $field->{'tag'}; - $tag =~ s/^./1/; - - my $ind1 = $field->{ind1} || ' '; - my $ind2 = $field->{ind2} || ' '; - - my $control = qq{}; - foreach my $sf (@{$field->{subfields}}) { - my $code = $sf->[0]; - my $val = $U->entityize($sf->[1]); - $control .= qq{$val}; - } - $control .= ''; - - # ARN, or "authority record number", used to need to be unique across the database. - # Of course, we have no idea what's in the database, and if the - # cat.maintain_control_numbers flag is set to "TRUE" then the 001 will - # be reset to the record ID anyway. - my $arn = 'AUTOGEN-' . time(); - - # Placeholder MARCXML; - # 001/003 can be be properly filled in via database triggers - # 005 will be filled in automatically at creation time - # 008 needs to be set by a cataloguer (could be some OU settings, I suppose) - # 040 should come from OU settings / OU shortname - # - my $marc_xml = < nz a22 o 4500 -$arn - |||||||||||||||||||||||||||||||||| -$cni$cni -$control - -MARCXML - - if ($self->api_name =~ m/readonly$/) { - return $marc_xml; - } else { - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('CREATE_AUTHORITY_RECORD'); - my $rec = OpenILS::Application::Cat::AuthCommon->import_authority_record($e, $marc_xml); - $e->commit unless $U->event_code($rec); - return $rec; - } -} - -__PACKAGE__->register_method( - method => 'overlay_authority_record', - api_name => 'open-ils.cat.authority.record.overlay', -); - -sub overlay_authority_record { - my($self, $conn, $auth, $rec_id, $marc_xml, $source) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('UPDATE_AUTHORITY_RECORD'); - my $rec = OpenILS::Application::Cat::AuthCommon->overlay_authority_record($rec_id, $marc_xml, $source); - $e->commit unless $U->event_code($rec); - return $rec; - -} - -__PACKAGE__->register_method( - method => 'retrieve_authority_record', - api_name => 'open-ils.cat.authority.record.retrieve', - signature => { - desc => q/Retrieve an authority record entry/, - params => [ - {desc => q/hash of options. Options include "clear_marc" which clears - the MARC xml from the record before it is returned/} - ] - } -); -sub retrieve_authority_record { - my($self, $conn, $auth, $rec_id, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $rec = $e->retrieve_authority_record($rec_id) or return $e->event; - $rec->clear_marc if $$options{clear_marc}; - return $rec; -} - -__PACKAGE__->register_method( - method => 'batch_retrieve_authority_record', - api_name => 'open-ils.cat.authority.record.batch.retrieve', - stream => 1, - signature => { - desc => q/Retrieve a set of authority record entry objects/, - params => [ - {desc => q/hash of options. Options include "clear_marc" which clears - the MARC xml from the record before it is returned/} - ] - } -); -sub batch_retrieve_authority_record { - my($self, $conn, $auth, $rec_id_list, $options) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->die_event unless $e->checkauth; - for my $rec_id (@$rec_id_list) { - my $rec = $e->retrieve_authority_record($rec_id) or return $e->event; - $rec->clear_marc if $$options{clear_marc}; - $conn->respond($rec); - } - return undef; -} - -__PACKAGE__->register_method( - method => 'count_linked_bibs', - api_name => 'open-ils.cat.authority.records.count_linked_bibs', - signature => q/ - Counts the number of bib records linked to each authority record in the input list - @param records Array of authority records to return counts - @return A list of hashes containing the authority record ID ("id") and linked bib count ("bibs") - / -); - -sub count_linked_bibs { - my( $self, $conn, $records ) = @_; - - my $editor = new_editor(); - - my $link_count; - my @clean_records; - for my $auth ( @$records ) { - # Protection against SQL injection? Might be overkill. - my $intauth = int($auth); - if ($intauth) { - push(@clean_records, $intauth); - } - } - return $link_count if !@clean_records; - - $link_count = $editor->json_query({ - "select" => { - "abl" => [ - { - "column" => "authority" - }, - { - "alias" => "bibs", - "transform" => "count", - "column" => "bib", - "aggregate" => 1 - } - ] - }, - "from" => "abl", - "where" => { "authority" => \@clean_records } - }); - - return $link_count; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Cat/BibCommon.pm b/Open-ILS/src/perlmods/OpenILS/Application/Cat/BibCommon.pm deleted file mode 100644 index 4d928a86a3..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Cat/BibCommon.pm +++ /dev/null @@ -1,377 +0,0 @@ -package OpenILS::Application::Cat::BibCommon; -use strict; use warnings; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenSRF::Utils::Logger qw($logger); -use OpenILS::Application::AppUtils; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Const qw/:const/; -use OpenSRF::AppSession; -use OpenILS::Event; -my $U = 'OpenILS::Application::AppUtils'; -my $MARC_NAMESPACE = 'http://www.loc.gov/MARC21/slim'; - - -# --------------------------------------------------------------------------- -# Shared bib mangling code. Do not publish methods from here. -# --------------------------------------------------------------------------- - -my $__bib_sources; -sub bib_source_from_name { - my $name = shift; - $logger->debug("searching for bib source: $name"); - - fetch_bib_sources(); - - my ($s) = grep { lc($_->source) eq lc($name) } @$__bib_sources; - - return $s->id if $s; - return undef; -} - -sub fetch_bib_sources { - $__bib_sources = new_editor()->retrieve_all_config_bib_source() - unless $__bib_sources; - return $__bib_sources; -} - - -sub biblio_record_replace_marc { - my($class, $e, $recid, $newxml, $source, $fixtcn, $override) = @_; - - my $rec = $e->retrieve_biblio_record_entry($recid) - or return $e->die_event; - - # See if there is a different record in the database that has our TCN value - # If we're not updating the TCN, all we care about it the marcdoc - # XXX should .update even bother with the tcn_info if it's not going to replace it? - # there is the potential for returning a TCN_EXISTS event, even though no replacement happens - - my( $tcn, $tsource, $marcdoc, $evt); - - if($fixtcn or $override) { - - ($tcn, $tsource, $marcdoc, $evt) = - _find_tcn_info($e, $newxml, $override, $recid); - - return $evt if $evt; - - $rec->tcn_value($tcn) if ($tcn); - $rec->tcn_source($tsource); - - } else { - - $marcdoc = __make_marc_doc($newxml); - } - - - $rec->source(bib_source_from_name($source)) if $source; - $rec->editor($e->requestor->id); - $rec->edit_date('now'); - $rec->marc( $U->entityize( $marcdoc->documentElement->toString ) ); - $e->update_biblio_record_entry($rec) or return $e->die_event; - - return $rec; -} - -sub biblio_record_xml_import { - my($class, $e, $xml, $source, $auto_tcn, $override) = @_; - - my( $evt, $tcn, $tcn_source, $marcdoc ); - - my $use_id = $e->retrieve_config_global_flag('cat.bib.use_id_for_tcn'); - $use_id = ($use_id and $U->is_true($use_id->enabled)); - - if( $auto_tcn or $use_id ) { - # auto_tcn forces a blank TCN value so the DB will have to generate one for us - $marcdoc = __make_marc_doc($xml); - } else { - ( $tcn, $tcn_source, $marcdoc, $evt ) = _find_tcn_info($e, $xml, $override); - return $evt if $evt; - } - - # Silence warnings when _find_tcn_info() fails - $tcn ||= ''; - $tcn_source ||= ''; - $logger->info("user ".$e->requestor->id. - " creating new biblio entry with tcn=$tcn and tcn_source $tcn_source"); - - my $record = Fieldmapper::biblio::record_entry->new; - - $record->source(bib_source_from_name($source)) if $source; - $record->tcn_source($tcn_source); - $record->tcn_value($tcn) if ($tcn); - $record->creator($e->requestor->id); - $record->editor($e->requestor->id); - $record->create_date('now'); - $record->edit_date('now'); - $record->marc($U->entityize($marcdoc->documentElement->toString)); - - $record = $e->create_biblio_record_entry($record) or return $e->die_event; - - if($use_id) { - my $existing = $e->search_biblio_record_entry( - { - tcn_value => $record->id, - deleted => 'f' - }, { - idlist => 1 - } - ); - - if(@$existing) { - # leave the auto-generated tcn_value in place - $logger->warn("Collision using internal ID as tcn_value for record " . $record->id); - } else { - $record->tcn_value($record->id); - $e->update_biblio_record_entry($record) or return $e->die_event; - } - } - - $logger->info("marc create/import created new record ".$record->id); - return $record; -} - -sub __make_marc_doc { - my $xml = shift; - my $marcxml = XML::LibXML->new->parse_string($xml); - $marcxml->documentElement->setNamespace($MARC_NAMESPACE, "marc", 1 ); - $marcxml->documentElement->setNamespace($MARC_NAMESPACE); - __remove_empty_marc_nodes($marcxml); - return $marcxml; -} - -# remove empty control fields, subfields, and variable data fields, which -# can creep in via less-than-correct imported MARC records or issues -# with templates -sub __remove_empty_marc_nodes { - my $marcxml = shift; - - __remove_if_childless($_) foreach $marcxml->documentElement->getElementsByTagNameNS($MARC_NAMESPACE, 'controlfield'); - __remove_if_childless($_) foreach $marcxml->documentElement->getElementsByTagNameNS($MARC_NAMESPACE, 'subfield'); - __remove_if_childless($_) foreach $marcxml->documentElement->getElementsByTagNameNS($MARC_NAMESPACE, 'datafield'); -} - -sub __remove_if_childless { - my $node = shift; - my @children = $node->childNodes(); - my $has_nonblank_children = 0; - # can do this more concisely by requiring XML::LibXML >= 1.70 and using nonBlankChildNodes() - foreach my $node ($node->childNodes()) { - if ($node->nodeType != XML::LibXML::XML_TEXT_NODE || $node->nodeValue !~ /^\s*$/) { - $has_nonblank_children = 1; - last; - } - } - $node->parentNode->removeChild($node) unless $has_nonblank_children; -} - -sub _find_tcn_info { - my $editor = shift; - my $xml = shift; - my $override = shift; - my $existing_rec = shift || 0; - - # parse the XML - my $marcxml = __make_marc_doc($xml); - - my $xpath = '//marc:controlfield[@tag="001"]'; - my $tcn = $marcxml->documentElement->findvalue($xpath); - $logger->info("biblio import located 001 (tcn) value of $tcn"); - - $xpath = '//marc:controlfield[@tag="003"]'; - my $tcn_source = $marcxml->documentElement->findvalue($xpath) || "System Local"; - - if(my $rec = _tcn_exists($editor, $tcn, $tcn_source, $existing_rec) ) { - - my $origtcn = $tcn; - $tcn = find_free_tcn( $marcxml, $editor, $existing_rec ); - - # if we're overriding, try to find a different TCN to use - if( $override ) { - - # XXX Create ALLOW_ALT_TCN permission check support - - $logger->info("tcn value $tcn already exists, attempting to override"); - - if(!$tcn) { - return ( - undef, - undef, - undef, - OpenILS::Event->new( - 'OPEN_TCN_NOT_FOUND', - payload => $marcxml->toString()) - ); - } - - } else { - - $logger->warn("tcn value $origtcn already exists in import/create"); - - # otherwise, return event - return ( - undef, - undef, - undef, - OpenILS::Event->new( - 'TCN_EXISTS', payload => { - dup_record => $rec, - tcn => $origtcn, - new_tcn => $tcn - } - ) - ); - } - } - - return ($tcn, $tcn_source, $marcxml); -} - -sub find_free_tcn { - - my $marcxml = shift; - my $editor = shift; - my $existing_rec = shift; - - my $xpath = '//marc:datafield[@tag="901"]/marc:subfield[@code="a"]'; - my ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o; - - if (!$tcn) { - $xpath = '//marc:datafield[@tag="039"]/marc:subfield[@code="a"]'; - ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o; - } - - $xpath = '//marc:datafield[@tag="901"]/marc:subfield[@code="b"]'; - my ($tcn_source) = $marcxml->documentElement->findvalue($xpath); - if (!$tcn_source) { - $xpath = '//marc:datafield[@tag="039"]/marc:subfield[@code="b"]'; - $tcn_source = $marcxml->documentElement->findvalue($xpath) || "System Local"; - } - - if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) { - $tcn = undef; - } - - - if(!$tcn) { - $xpath = '//marc:datafield[@tag="020"]/marc:subfield[@code="a"]'; - ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o; - $tcn_source = "ISBN"; - if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;} - } - - if(!$tcn) { - $xpath = '//marc:datafield[@tag="022"]/marc:subfield[@code="a"]'; - ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o; - $tcn_source = "ISSN"; - if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;} - } - - if(!$tcn) { - $xpath = '//marc:datafield[@tag="010"]'; - ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o; - $tcn_source = "LCCN"; - if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;} - } - - if(!$tcn) { - $xpath = '//marc:datafield[@tag="035"]/marc:subfield[@code="a"]'; - ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o; - $tcn_source = "System Legacy"; - if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;} - - if($tcn) { - $marcxml->documentElement->removeChild( - $marcxml->documentElement->findnodes( '//marc:datafield[@tag="035"]' ) - ); - } - } - - return undef unless $tcn; - return $tcn; -} - - - -sub _tcn_exists { - my $editor = shift; - my $tcn = shift; - my $source = shift; - my $existing_rec = shift || 0; - - if(!$tcn) {return 0;} - - $logger->debug("tcn_exists search for tcn $tcn and source $source and id $existing_rec"); - - # XXX why does the source matter? -# my $req = $session->request( -# { tcn_value => $tcn, tcn_source => $source, deleted => 'f' } ); - - my $recs = $editor->search_biblio_record_entry( - {tcn_value => $tcn, deleted => 'f', id => {'!=' => $existing_rec}}, {idlist =>1}); - - if(@$recs) { - $logger->debug("_tcn_exists is true for tcn : $tcn ($source)"); - return $recs->[0]; - } - - $logger->debug("_tcn_exists is false for tcn : $tcn ($source)"); - return 0; -} - - -sub delete_rec { - my($class, $editor, $rec_id ) = @_; - - my $rec = $editor->retrieve_biblio_record_entry($rec_id) - or return $editor->event; - - return undef if $U->is_true($rec->deleted); - - $rec->deleted('t'); - $rec->active('f'); - $rec->editor( $editor->requestor->id ); - $rec->edit_date('now'); - - # Set the leader/05 to indicate that the record has been deleted - my $marc = $rec->marc(); - $marc =~ s{(.{5}).}{$1d}; - $rec->marc($marc); - - $editor->update_biblio_record_entry($rec) or return $editor->event; - - return undef; -} - - -# --------------------------------------------------------------------------- -# returns true if the given title (id) has no un-deleted volumes or -# copies attached. If a context volume is defined, a record -# is considered empty only if the context volume is the only -# remaining volume on the record. -# --------------------------------------------------------------------------- -sub title_is_empty { - my($class, $editor, $rid, $vol_id) = @_; - - return 0 if $rid == OILS_PRECAT_RECORD; - - my $cnlist = $editor->search_asset_call_number( - { record => $rid, deleted => 'f' }, { idlist => 1 } ); - - return 1 unless @$cnlist; # no attached volumes - return 0 if @$cnlist > 1; # multiple attached volumes - return 0 unless $$cnlist[0] == $vol_id; # attached volume is not the context vol. - - # see if the sole remaining context volume has any attached copies - for my $cn (@$cnlist) { - my $copylist = $editor->search_asset_copy( - [ - { call_number => $cn, deleted => 'f' }, - { limit => 1 }, - ], { idlist => 1 }); - return 0 if @$copylist; # false if we find any copies - } - - return 1; -} -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Cat/Merge.pm b/Open-ILS/src/perlmods/OpenILS/Application/Cat/Merge.pm deleted file mode 100644 index b354df6aac..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Cat/Merge.pm +++ /dev/null @@ -1,260 +0,0 @@ -use strict; use warnings; -package OpenILS::Application::Cat::Merge; -use base qw/OpenILS::Application/; -use OpenSRF::Application; -use OpenILS::Application::AppUtils; -use OpenSRF::EX qw(:try); -use OpenILS::Utils::Fieldmapper; -use OpenILS::Event; -use OpenSRF::Utils::Logger qw($logger); -use Data::Dumper; -my $U = "OpenILS::Application::AppUtils"; - -my $storage; - - -# removes items from an array and returns the removed items -# example : my @d = rgrep(sub { $_ =~ /o/ }, \@a); -# there's surely a smarter way to do this -sub rgrep { - my( $sub, $arr ) = @_; - my @del; - for( my $i = 0; $i < @$arr; $i++ ) { - my $a = $$arr[$i]; - local $_ = $a; - if($sub->()) { - splice(@$arr, $i--, 1); - push( @del, $a ); - } - } - return @del; -} - - - -# takes a master record and a list of -# sub-records to merge into the master record -sub merge_records { - my( $editor, $master, $records ) = @_; - - # bib records are global objects, so no org context required. - return (undef, $editor->die_event) - unless $editor->allowed('MERGE_BIB_RECORDS'); - - my $vol; - my $evt; - - my %r = map { $_ => 1 } ($master, @$records); # unique the ids - my @recs = keys %r; - - my $reqr = $editor->requestor; - $logger->activity("merge: user ".$reqr->id." merging bib records: @recs with master = $master"); - - # ----------------------------------------------------------- - # collect all of the volumes, merge any with duplicate - # labels, then move all of the volumes to the master record - # ----------------------------------------------------------- - my @volumes; - for (@recs) { - my $vs = $editor->search_asset_call_number({record => $_, deleted=>'f'}); - push( @volumes, @$vs ); - } - - $logger->info("merge: merge recovered ".scalar(@volumes)." total volumes"); - - my @trimmed; - # de-duplicate any volumes with the same label and owning_lib - - my %seen_vols; - - for my $v (@volumes) { - my $l = $v->label; - my $o = $v->owning_lib; - - if($seen_vols{$v->id}) { - $logger->debug("merge: skipping ".$v->id." since it's already been merged"); - next; - } - - $seen_vols{$v->id} = 1; - - $logger->debug("merge: [".$v->id."] looking for dupes with label $l and owning_lib $o"); - - my @dups; - for my $vv (@volumes) { - if( $vv->label eq $v->label and $vv->owning_lib == $v->owning_lib ) { - $logger->debug("merge: pushing dupe volume ".$vv->id) if @dups; - push( @dups, $vv ); - $seen_vols{$vv->id} = 1; - } - } - - if( @dups == 1 ) { - $logger->debug("merge: pushing unique volume into trimmed volume set: ".$v->id); - push( @trimmed, @dups ); - - } else { - my($vol, $e) = merge_volumes($editor, \@dups); - return $e if $e; - $logger->debug("merge: pushing vol-merged volume into trimmed volume set: ".$vol->id); - push(@trimmed, $vol); - } - } - - my $s = 'merge: trimmed volume set contains the following vols: '; - $s .= 'id = '.$_->id .' : record = '.$_->record.' | ' for @trimmed; - $logger->debug($s); - - # make all the volumes point to the master record - my $stat; - for $vol (@trimmed) { - if( $vol->record ne $master ) { - - $logger->debug("merge: moving volume ". - $vol->id." from record ".$vol->record. " to $master"); - - $vol->editor( $editor->requestor->id ); - $vol->edit_date('now'); - $vol->record( $master ); - $editor->update_asset_call_number($vol) - or return $editor->die_event; - } - } - - # cycle through and delete the non-master records - for my $rec (@recs) { - - my $record = $editor->retrieve_biblio_record_entry($rec) - or return $editor->die_event; - - $logger->debug("merge: seeing if record $rec needs to be deleted or un-deleted"); - - if( $rec == $master ) { - # make sure the master record is not deleted - if( $U->is_true($record->deleted) ) { - $logger->info("merge: master record is marked as deleted...un-deleting."); - $record->deleted('f'); - $record->editor($reqr->id); - $record->edit_date('now'); - $editor->update_biblio_record_entry($record) - or return $editor->die_event; - } - - } else { - $logger->info("merge: deleting record $rec"); - $record->deleted('t'); - $record->editor($reqr->id); - $record->edit_date('now'); - $editor->update_biblio_record_entry($record) - or return $editor->die_event; - } - } - - return undef; -} - - - -# takes a list of volume objects, picks the volume with most -# copies and moves all copies attached to the other volumes -# into said volume. all other volumes are deleted -sub merge_volumes { - my( $editor, $volumes, $master ) = @_; - my %copies; - my $evt; - - return ($$volumes[0]) if !$master and @$volumes == 1; - - return ($$volumes[0]) if - $master and @$volumes == 1 - and $master->id == $$volumes[0]->id; - - $logger->debug("merge: fetching copies for volume list of size ".scalar(@$volumes)); - - # collect all of the copies attached to the selected volumes - for( @$volumes ) { - $copies{$_->id} = $editor->search_asset_copy({call_number=>$_->id, deleted=>'f'}); - $logger->debug("merge: found ".scalar(@{$copies{$_->id}})." copies for volume ".$_->id); - } - - my $bigcn; - if( $master ) { - - # the caller has chosen the master record - $bigcn = $master->id; - push( @$volumes, $master ); - - } else { - - # find the CN with the most copies and make it the master CN - my $big = 0; - for my $cn (keys %copies) { - my $count = scalar(@{$copies{$cn}}); - if( $count > $big ) { - $big = $count; - $bigcn = $cn; - } - } - } - - $bigcn = $$volumes[0]->id unless $bigcn; - - $logger->info("merge: merge using volume $bigcn as the master"); - - # now move all of the copies to the new volume - for my $cn (keys %copies) { - next if $cn == $bigcn; - for my $copy (@{$copies{$cn}}) { - $logger->debug("merge: setting call_number to $bigcn for copy ".$copy->id); - $copy->call_number($bigcn); - $copy->editor($editor->requestor->id); - $copy->edit_date('now'); - $editor->update_asset_copy($copy) or return (undef, $editor->die_event); - } - } - - for( @$volumes ) { - next if $_->id == $bigcn; - $logger->debug("merge: marking call_number as deleted: ".$_->id); - $_->deleted('t'); - $_->editor($editor->requestor->id); - $_->edit_date('now'); - $editor->update_asset_call_number($_) or return (undef, $editor->die_event); - merge_volume_holds($editor, $bigcn, $_->id); - } - - my ($mvol) = grep { $_->id == $bigcn } @$volumes; - $logger->debug("merge: returning master volume ".$mvol->id); - return ($mvol); -} - -sub merge_volume_holds { - my($e, $master_id, $vol_id) = @_; - - my $holds = $e->search_action_hold_request( - { cancel_time => undef, - fulfillment_time => undef, - hold_type => 'V', - target => $vol_id - } - ); - - for my $hold (@$holds) { - - $logger->info("Changing hold ".$hold->id. - " target from ".$hold->target." to $master_id in volume merge"); - - $hold->target($master_id); - unless($e->update_action_hold_request($hold)) { - my $evt = $e->event; - $logger->error("Error updating hold ". $evt->textcode .":". $evt->desc .":". $evt->stacktrace); - } - } - - return undef; -} - - -1; - - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ.pm deleted file mode 100644 index 52e76bc900..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ.pm +++ /dev/null @@ -1,1862 +0,0 @@ -package OpenILS::Application::Circ; -use OpenILS::Application; -use base qw/OpenILS::Application/; -use strict; use warnings; - -use OpenILS::Application::Circ::Circulate; -use OpenILS::Application::Circ::Survey; -use OpenILS::Application::Circ::StatCat; -use OpenILS::Application::Circ::Holds; -use OpenILS::Application::Circ::HoldNotify; -use OpenILS::Application::Circ::CreditCard; -use OpenILS::Application::Circ::Money; -use OpenILS::Application::Circ::NonCat; -use OpenILS::Application::Circ::CopyLocations; -use OpenILS::Application::Circ::CircCommon; - -use DateTime; -use DateTime::Format::ISO8601; - -use OpenILS::Application::AppUtils; - -use OpenSRF::Utils qw/:datetime/; -use OpenSRF::AppSession; -use OpenILS::Utils::ModsParser; -use OpenILS::Event; -use OpenSRF::EX qw(:try); -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::Editor; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Const qw/:const/; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Application::Cat::AssetCommon; - -my $apputils = "OpenILS::Application::AppUtils"; -my $U = $apputils; - -my $holdcode = "OpenILS::Application::Circ::Holds"; - -# ------------------------------------------------------------------------ -# Top level Circ package; -# ------------------------------------------------------------------------ - -sub initialize { - my $self = shift; - OpenILS::Application::Circ::Circulate->initialize(); -} - - -__PACKAGE__->register_method( - method => 'retrieve_circ', - authoritative => 1, - api_name => 'open-ils.circ.retrieve', - signature => q/ - Retrieve a circ object by id - @param authtoken Login session key - @pararm circid The id of the circ object - / -); -sub retrieve_circ { - my( $s, $c, $a, $i ) = @_; - my $e = new_editor(authtoken => $a); - return $e->event unless $e->checkauth; - my $circ = $e->retrieve_action_circulation($i) or return $e->event; - if( $e->requestor->id ne $circ->usr ) { - return $e->event unless $e->allowed('VIEW_CIRCULATIONS'); - } - return $circ; -} - - -__PACKAGE__->register_method( - method => 'fetch_circ_mods', - api_name => 'open-ils.circ.circ_modifier.retrieve.all'); -sub fetch_circ_mods { - my($self, $conn, $args) = @_; - my $mods = new_editor()->retrieve_all_config_circ_modifier; - return [ map {$_->code} @$mods ] unless $$args{full}; - return $mods; -} - -__PACKAGE__->register_method( - method => 'fetch_bill_types', - api_name => 'open-ils.circ.billing_type.retrieve.all'); -sub fetch_bill_types { - my $conf = OpenSRF::Utils::SettingsClient->new; - return $conf->config_value( - 'apps', 'open-ils.circ', 'app_settings', 'billing_types', 'type' ); -} - - -__PACKAGE__->register_method( - method => 'ranged_billing_types', - api_name => 'open-ils.circ.billing_type.ranged.retrieve.all'); - -sub ranged_billing_types { - my($self, $conn, $auth, $org_id, $depth) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_BILLING_TYPE', $org_id); - return $e->search_config_billing_type( - {owner => $U->get_org_full_path($org_id, $depth)}); -} - - - -# ------------------------------------------------------------------------ -# Returns an array of {circ, record} hashes checked out by the user. -# ------------------------------------------------------------------------ -__PACKAGE__->register_method( - method => "checkouts_by_user", - api_name => "open-ils.circ.actor.user.checked_out", - stream => 1, - NOTES => <<" NOTES"); - Returns a list of open circulations as a pile of objects. Each object - contains the relevant copy, circ, and record - NOTES - -sub checkouts_by_user { - my($self, $client, $auth, $user_id) = @_; - - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - my $circ_ids = $e->search_action_circulation( - { usr => $user_id, - checkin_time => undef, - '-or' => [ - {stop_fines => undef}, - {stop_fines => ['MAXFINES','LONGOVERDUE']} - ] - }, - {idlist => 1} - ); - - for my $id (@$circ_ids) { - my $circ = $e->retrieve_action_circulation([ - $id, - { flesh => 3, - flesh_fields => { - circ => ['target_copy'], - acp => ['call_number'], - acn => ['record'] - } - } - ]); - - # un-flesh for consistency - my $c = $circ->target_copy; - $circ->target_copy($c->id); - - my $cn = $c->call_number; - $c->call_number($cn->id); - - my $t = $cn->record; - $cn->record($t->id); - - $client->respond( - { circ => $circ, - copy => $c, - record => $U->record_to_mvr($t) - } - ); - } - - return undef; -} - - - -__PACKAGE__->register_method( - method => "checkouts_by_user_slim", - api_name => "open-ils.circ.actor.user.checked_out.slim", - NOTES => <<" NOTES"); - Returns a list of open circulation objects - NOTES - -# DEPRECAT ME?? XXX -sub checkouts_by_user_slim { - my( $self, $client, $user_session, $user_id ) = @_; - - my( $requestor, $target, $copy, $record, $evt ); - - ( $requestor, $target, $evt ) = - $apputils->checkses_requestor( $user_session, $user_id, 'VIEW_CIRCULATIONS'); - return $evt if $evt; - - $logger->debug( 'User ' . $requestor->id . - " retrieving checked out items for user " . $target->id ); - - # XXX Make the call correct.. - return $apputils->simplereq( - 'open-ils.cstore', - "open-ils.cstore.direct.action.open_circulation.search.atomic", - { usr => $target->id, checkin_time => undef } ); -# { usr => $target->id } ); -} - - -__PACKAGE__->register_method( - method => "checkouts_by_user_opac", - api_name => "open-ils.circ.actor.user.checked_out.opac",); - -# XXX Deprecate Me -sub checkouts_by_user_opac { - my( $self, $client, $auth, $user_id ) = @_; - - my $e = OpenILS::Utils::Editor->new( authtoken => $auth ); - return $e->event unless $e->checkauth; - $user_id ||= $e->requestor->id; - return $e->event unless - my $patron = $e->retrieve_actor_user($user_id); - - my $data; - my $search = {usr => $user_id, stop_fines => undef}; - - if( $user_id ne $e->requestor->id ) { - $data = $e->search_action_circulation( - $search, {checkperm=>1, permorg=>$patron->home_ou}) - or return $e->event; - - } else { - $data = $e->search_action_circulation($search); - } - - return $data; -} - - -__PACKAGE__->register_method( - method => "title_from_transaction", - api_name => "open-ils.circ.circ_transaction.find_title", - NOTES => <<" NOTES"); - Returns a mods object for the title that is linked to from the - copy from the hold that created the given transaction - NOTES - -sub title_from_transaction { - my( $self, $client, $login_session, $transactionid ) = @_; - - my( $user, $circ, $title, $evt ); - - ( $user, $evt ) = $apputils->checkses( $login_session ); - return $evt if $evt; - - ( $circ, $evt ) = $apputils->fetch_circulation($transactionid); - return $evt if $evt; - - ($title, $evt) = $apputils->fetch_record_by_copy($circ->target_copy); - return $evt if $evt; - - return $apputils->record_to_mvr($title); -} - -__PACKAGE__->register_method( - method => "staff_age_to_lost", - api_name => "open-ils.circ.circulation.age_to_lost", - stream => 1, - signature => q/ - This fires a circ.staff_age_to_lost Action-Trigger event against all - overdue circulations in scope of the specified context library and - user profile, which effectively marks the associated items as Lost. - This is likely to be done at the end of a semester in an academic - library, etc. - @param auth - @param args : circ_lib, user_profile - / -); - -sub staff_age_to_lost { - my( $self, $conn, $auth, $args ) = @_; - - my $orgs = $U->get_org_descendants($args->{'circ_lib'}); - my $profiles = $U->fetch_permission_group_descendants($args->{'user_profile'}); - - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - - my $method = 'open-ils.trigger.passive.event.autocreate.batch'; - my $hook = 'circ.staff_age_to_lost'; - my $context_org = 'circ_lib'; - my $opt_granularity = undef; - my $filter = { - "checkin_time" => undef, - "due_date" => { "<" => "now" }, - "-or" => [ - { "stop_fines" => ["MAXFINES", "LONGOVERDUE"] }, # FIXME: CLAIMSRETURNED also? - { "stop_fines" => undef } - ], - "-and" => [ - {"-exists" => { - "select" => {"au" => ["id"]}, - "from" => "au", - "where" => { - "profile" => $profiles, - "id" => { "=" => {"+circ" => "usr"} } - } - }}, - {"-exists" => { - "select" => {"aou" => ["id"]}, - "from" => "aou", - "where" => { - "-and" => [ - {"id" => { "=" => {"+circ" => "circ_lib"} }}, - {"id" => $orgs} - ] - } - }} - ] - }; - my $req_timeout = 10800; - my $chunk_size = 100; - my $progress = 1; - - my $req = $ses->request($method, $hook, $context_org, $filter, $opt_granularity); - my @event_ids; my @chunked_ids; - while (my $resp = $req->recv(timeout => $req_timeout)) { - push(@event_ids, $resp->content); - push(@chunked_ids, $resp->content); - if (scalar(@chunked_ids) > $chunk_size) { - $conn->respond({'progress'=>$progress++}); # 'event_ids'=>@chunked_ids - @chunked_ids = (); - } - } - if (scalar(@chunked_ids) > 0) { - $conn->respond({'progress'=>$progress++}); # 'event_ids'=>@chunked_ids - } - - if(@event_ids) { - $logger->info("staff_age_to_lost: created ".scalar(@event_ids)." events for circ.staff_age_to_lost"); - $conn->respond_complete({'total_progress'=>$progress-1,'created'=>scalar(@event_ids)}); - } elsif($req->complete) { - $logger->info("staff_age_to_lost: no events to create for circ.staff_age_to_lost"); - $conn->respond_complete({'total_progress'=>$progress-1,'created'=>0}); - } else { - $logger->warn("staff_age_to_lost: timeout occurred during event creation for circ.staff_age_to_lost"); - $conn->respond_complete({'total_progress'=>$progress-1,'error'=>'timeout'}); - } - - return undef; -} - - -__PACKAGE__->register_method( - method => "new_set_circ_lost", - api_name => "open-ils.circ.circulation.set_lost", - signature => q/ - Sets the copy and related open circulation to lost - @param auth - @param args : barcode - / -); - - -# --------------------------------------------------------------------- -# Sets a circulation to lost. updates copy status to lost -# applies copy and/or prcoessing fees depending on org settings -# --------------------------------------------------------------------- -sub new_set_circ_lost { - my( $self, $conn, $auth, $args ) = @_; - - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - - my $copy = $e->search_asset_copy({barcode=>$$args{barcode}, deleted=>'f'})->[0] - or return $e->die_event; - - my $evt = OpenILS::Application::Cat::AssetCommon->set_item_lost($e, $copy->id); - return $evt if $evt; - - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - method => "set_circ_claims_returned", - api_name => "open-ils.circ.circulation.set_claims_returned", - signature => { - desc => q/Sets the circ for a given item as claims returned - If a backdate is provided, overdue fines will be voided - back to the backdate/, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Arguments, including "barcode" and optional "backdate"', type => 'object'} - ], - return => {desc => q/1 on success, failure event on error, and - PATRON_EXCEEDS_CLAIMS_RETURN_COUNT if the patron exceeds the - configured claims return maximum/} - } -); - -__PACKAGE__->register_method( - method => "set_circ_claims_returned", - api_name => "open-ils.circ.circulation.set_claims_returned.override", - signature => { - desc => q/This adds support for overrideing the configured max - claims returned amount. - @see open-ils.circ.circulation.set_claims_returned./, - } -); - -sub set_circ_claims_returned { - my( $self, $conn, $auth, $args ) = @_; - - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - - my $barcode = $$args{barcode}; - my $backdate = $$args{backdate}; - - my $copy = $e->search_asset_copy({barcode=>$barcode, deleted=>'f'})->[0] - or return $e->die_event; - - my $circ = $e->search_action_circulation( - {checkin_time => undef, target_copy => $copy->id})->[0] - or return $e->die_event; - - $backdate = $circ->due_date if $$args{use_due_date}; - - $logger->info("marking circ for item $barcode as claims returned". - (($backdate) ? " with backdate $backdate" : '')); - - my $patron = $e->retrieve_actor_user($circ->usr); - my $max_count = $U->ou_ancestor_setting_value( - $circ->circ_lib, 'circ.max_patron_claim_return_count', $e); - - # If the patron has too instances of many claims returned, - # require an override to continue. A configured max of - # 0 means all attempts require an override - if(defined $max_count and $patron->claims_returned_count >= $max_count) { - - if($self->api_name =~ /override/) { - - # see if we're allowed to override - return $e->die_event unless - $e->allowed('SET_CIRC_CLAIMS_RETURNED.override', $circ->circ_lib); - - } else { - - # exit early and return the max claims return event - $e->rollback; - return OpenILS::Event->new( - 'PATRON_EXCEEDS_CLAIMS_RETURN_COUNT', - payload => { - patron_count => $patron->claims_returned_count, - max_count => $max_count - } - ); - } - } - - $e->allowed('SET_CIRC_CLAIMS_RETURNED', $circ->circ_lib) - or return $e->die_event; - - $circ->stop_fines(OILS_STOP_FINES_CLAIMSRETURNED); - $circ->stop_fines_time('now') unless $circ->stop_fines_time; - - if( $backdate ) { - $backdate = cleanse_ISO8601($backdate); - - my $original_date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($circ->due_date)); - my $new_date = DateTime::Format::ISO8601->new->parse_datetime($backdate); - $backdate = $new_date->ymd . 'T' . $original_date->strftime('%T%z'); - - # clean it up once again; need a : in the timezone offset. E.g. -06:00 not -0600 - $backdate = cleanse_ISO8601($backdate); - - # make it look like the circ stopped at the cliams returned time - $circ->stop_fines_time($backdate); - my $evt = OpenILS::Application::Circ::CircCommon->void_overdues($e, $circ, $backdate); - return $evt if $evt; - } - - $e->update_action_circulation($circ) or return $e->die_event; - - # see if there is a configured post-claims-return copy status - if(my $stat = $U->ou_ancestor_setting_value($circ->circ_lib, 'circ.claim_return.copy_status')) { - $copy->status($stat); - $copy->edit_date('now'); - $copy->editor($e->requestor->id); - $e->update_asset_copy($copy) or return $e->die_event; - } - - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - method => "post_checkin_backdate_circ", - api_name => "open-ils.circ.post_checkin_backdate", - signature => { - desc => q/Back-date an already checked in circulation/, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Circ ID', type => 'number'}, - {desc => 'ISO8601 backdate', type => 'string'}, - ], - return => {desc => q/1 on success, failure event on error/} - } -); - -__PACKAGE__->register_method( - method => "post_checkin_backdate_circ", - api_name => "open-ils.circ.post_checkin_backdate.batch", - stream => 1, - signature => { - desc => q/@see open-ils.circ.post_checkin_backdate. Batch mode/, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'List of Circ ID', type => 'array'}, - {desc => 'ISO8601 backdate', type => 'string'}, - ], - return => {desc => q/Set of: 1 on success, failure event on error/} - } -); - - -sub post_checkin_backdate_circ { - my( $self, $conn, $auth, $circ_id, $backdate ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->die_event unless $e->checkauth; - if($self->api_name =~ /batch/) { - foreach my $c (@$circ_id) { - $conn->respond(post_checkin_backdate_circ_impl($e, $c, $backdate)); - } - } else { - $conn->respond_complete(post_checkin_backdate_circ_impl($e, $circ_id, $backdate)); - } - - $e->disconnect; - return undef; -} - - -sub post_checkin_backdate_circ_impl { - my($e, $circ_id, $backdate) = @_; - - $e->xact_begin; - - my $circ = $e->retrieve_action_circulation($circ_id) - or return $e->die_event; - - # anyone with checkin perms can backdate (more restrictive?) - return $e->die_event unless $e->allowed('COPY_CHECKIN', $circ->circ_lib); - - # don't allow back-dating an open circulation - return OpenILS::Event->new('BAD_PARAMS') unless - $backdate and $circ->checkin_time; - - # update the checkin and stop_fines times to reflect the new backdate - $circ->stop_fines_time(cleanse_ISO8601($backdate)); - $circ->checkin_time(cleanse_ISO8601($backdate)); - $e->update_action_circulation($circ) or return $e->die_event; - - # now void the overdues "erased" by the back-dating - my $evt = OpenILS::Application::Circ::CircCommon->void_overdues($e, $circ, $backdate); - return $evt if $evt; - - # If the circ was closed before and the balance owned !=0, re-open the transaction - $evt = OpenILS::Application::Circ::CircCommon->reopen_xact($e, $circ->id); - return $evt if $evt; - - $e->xact_commit; - return 1; -} - - - -__PACKAGE__->register_method ( - method => 'set_circ_due_date', - api_name => 'open-ils.circ.circulation.due_date.update', - signature => q/ - Updates the due_date on the given circ - @param authtoken - @param circid The id of the circ to update - @param date The timestamp of the new due date - / -); - -sub set_circ_due_date { - my( $self, $conn, $auth, $circ_id, $date ) = @_; - - my $e = new_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - my $circ = $e->retrieve_action_circulation($circ_id) - or return $e->die_event; - - return $e->die_event unless $e->allowed('CIRC_OVERRIDE_DUE_DATE', $circ->circ_lib); - $date = cleanse_ISO8601($date); - - if (!(interval_to_seconds($circ->duration) % 86400)) { # duration is divisible by days - my $original_date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($circ->due_date)); - my $new_date = DateTime::Format::ISO8601->new->parse_datetime($date); - $date = cleanse_ISO8601( $new_date->ymd . 'T' . $original_date->strftime('%T%z') ); - } - - $circ->due_date($date); - $e->update_action_circulation($circ) or return $e->die_event; - $e->commit; - - return $circ; -} - - -__PACKAGE__->register_method( - method => "create_in_house_use", - api_name => 'open-ils.circ.in_house_use.create', - signature => q/ - Creates an in-house use action. - @param $authtoken The login session key - @param params A hash of params including - 'location' The org unit id where the in-house use occurs - 'copyid' The copy in question - 'count' The number of in-house uses to apply to this copy - @return An array of id's representing the id's of the newly created - in-house use objects or an event on an error - /); - -__PACKAGE__->register_method( - method => "create_in_house_use", - api_name => 'open-ils.circ.non_cat_in_house_use.create', -); - - -sub create_in_house_use { - my( $self, $client, $auth, $params ) = @_; - - my( $evt, $copy ); - my $org = $params->{location}; - my $copyid = $params->{copyid}; - my $count = $params->{count} || 1; - my $nc_type = $params->{non_cat_type}; - my $use_time = $params->{use_time} || 'now'; - - my $e = new_editor(xact=>1,authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('CREATE_IN_HOUSE_USE'); - - my $non_cat = 1 if $self->api_name =~ /non_cat/; - - unless( $non_cat ) { - if( $copyid ) { - $copy = $e->retrieve_asset_copy($copyid) or return $e->event; - } else { - $copy = $e->search_asset_copy({barcode=>$params->{barcode}, deleted => 'f'})->[0] - or return $e->event; - $copyid = $copy->id; - } - } - - if( $use_time ne 'now' ) { - $use_time = cleanse_ISO8601($use_time); - $logger->debug("in_house_use setting use time to $use_time"); - } - - my @ids; - for(1..$count) { - - my $ihu; - my $method; - my $cmeth; - - if($non_cat) { - $ihu = Fieldmapper::action::non_cat_in_house_use->new; - $ihu->item_type($nc_type); - $method = 'open-ils.storage.direct.action.non_cat_in_house_use.create'; - $cmeth = "create_action_non_cat_in_house_use"; - - } else { - $ihu = Fieldmapper::action::in_house_use->new; - $ihu->item($copyid); - $method = 'open-ils.storage.direct.action.in_house_use.create'; - $cmeth = "create_action_in_house_use"; - } - - $ihu->staff($e->requestor->id); - $ihu->org_unit($org); - $ihu->use_time($use_time); - - $ihu = $e->$cmeth($ihu) or return $e->event; - push( @ids, $ihu->id ); - } - - $e->commit; - return \@ids; -} - - - - - -__PACKAGE__->register_method( - method => "view_circs", - api_name => "open-ils.circ.copy_checkout_history.retrieve", - notes => q/ - Retrieves the last X circs for a given copy - @param authtoken The login session key - @param copyid The copy to check - @param count How far to go back in the item history - @return An array of circ ids - /); - -# ---------------------------------------------------------------------- -# Returns $count most recent circs. If count exceeds the configured -# max, use the configured max instead -# ---------------------------------------------------------------------- -sub view_circs { - my( $self, $client, $authtoken, $copyid, $count ) = @_; - - my $e = new_editor(authtoken => $authtoken); - return $e->event unless $e->checkauth; - - my $copy = $e->retrieve_asset_copy([ - $copyid, - { flesh => 1, - flesh_fields => {acp => ['call_number']} - } - ]) or return $e->event; - - return $e->event unless $e->allowed( - 'VIEW_COPY_CHECKOUT_HISTORY', - ($copy->call_number == OILS_PRECAT_CALL_NUMBER) ? - $copy->circ_lib : $copy->call_number->owning_lib); - - my $max_history = $U->ou_ancestor_setting_value( - $e->requestor->ws_ou, 'circ.item_checkout_history.max', $e); - - if(defined $max_history) { - $count = $max_history unless defined $count and $count < $max_history; - } else { - $count = 4 unless defined $count; - } - - return $e->search_action_circulation([ - {target_copy => $copyid}, - {limit => $count, order_by => { circ => "xact_start DESC" }} - ]); -} - - -__PACKAGE__->register_method( - method => "circ_count", - api_name => "open-ils.circ.circulation.count", - notes => q/ - Returns the number of times the item has circulated - @param copyid The copy to check - /); - -sub circ_count { - my( $self, $client, $copyid, $range ) = @_; - my $e = OpenILS::Utils::Editor->new; - return $e->request('open-ils.storage.asset.copy.circ_count', $copyid, $range); -} - - - -__PACKAGE__->register_method( - method => 'fetch_notes', - authoritative => 1, - api_name => 'open-ils.circ.copy_note.retrieve.all', - signature => q/ - Returns an array of copy note objects. - @param args A named hash of parameters including: - authtoken : Required if viewing non-public notes - itemid : The id of the item whose notes we want to retrieve - pub : True if all the caller wants are public notes - @return An array of note objects - /); - -__PACKAGE__->register_method( - method => 'fetch_notes', - api_name => 'open-ils.circ.call_number_note.retrieve.all', - signature => q/@see open-ils.circ.copy_note.retrieve.all/); - -__PACKAGE__->register_method( - method => 'fetch_notes', - api_name => 'open-ils.circ.title_note.retrieve.all', - signature => q/@see open-ils.circ.copy_note.retrieve.all/); - - -# NOTE: VIEW_COPY/VOLUME/TITLE_NOTES perms should always be global -sub fetch_notes { - my( $self, $connection, $args ) = @_; - - my $id = $$args{itemid}; - my $authtoken = $$args{authtoken}; - my( $r, $evt); - - if( $self->api_name =~ /copy/ ) { - if( $$args{pub} ) { - return $U->cstorereq( - 'open-ils.cstore.direct.asset.copy_note.search.atomic', - { owning_copy => $id, pub => 't' } ); - } else { - ( $r, $evt ) = $U->checksesperm($authtoken, 'VIEW_COPY_NOTES'); - return $evt if $evt; - return $U->cstorereq( - 'open-ils.cstore.direct.asset.copy_note.search.atomic', {owning_copy => $id} ); - } - - } elsif( $self->api_name =~ /call_number/ ) { - if( $$args{pub} ) { - return $U->cstorereq( - 'open-ils.cstore.direct.asset.call_number_note.search.atomic', - { call_number => $id, pub => 't' } ); - } else { - ( $r, $evt ) = $U->checksesperm($authtoken, 'VIEW_VOLUME_NOTES'); - return $evt if $evt; - return $U->cstorereq( - 'open-ils.cstore.direct.asset.call_number_note.search.atomic', { call_number => $id } ); - } - - } elsif( $self->api_name =~ /title/ ) { - if( $$args{pub} ) { - return $U->cstorereq( - 'open-ils.cstore.direct.bilbio.record_note.search.atomic', - { record => $id, pub => 't' } ); - } else { - ( $r, $evt ) = $U->checksesperm($authtoken, 'VIEW_TITLE_NOTES'); - return $evt if $evt; - return $U->cstorereq( - 'open-ils.cstore.direct.biblio.record_note.search.atomic', { record => $id } ); - } - } - - return undef; -} - -__PACKAGE__->register_method( - method => 'has_notes', - api_name => 'open-ils.circ.copy.has_notes'); -__PACKAGE__->register_method( - method => 'has_notes', - api_name => 'open-ils.circ.call_number.has_notes'); -__PACKAGE__->register_method( - method => 'has_notes', - api_name => 'open-ils.circ.title.has_notes'); - - -sub has_notes { - my( $self, $conn, $authtoken, $id ) = @_; - my $editor = OpenILS::Utils::Editor->new(authtoken => $authtoken); - return $editor->event unless $editor->checkauth; - - my $n = $editor->search_asset_copy_note( - {owning_copy=>$id}, {idlist=>1}) if $self->api_name =~ /copy/; - - $n = $editor->search_asset_call_number_note( - {call_number=>$id}, {idlist=>1}) if $self->api_name =~ /call_number/; - - $n = $editor->search_biblio_record_note( - {record=>$id}, {idlist=>1}) if $self->api_name =~ /title/; - - return scalar @$n; -} - - - -__PACKAGE__->register_method( - method => 'create_copy_note', - api_name => 'open-ils.circ.copy_note.create', - signature => q/ - Creates a new copy note - @param authtoken The login session key - @param note The note object to create - @return The id of the new note object - /); - -sub create_copy_note { - my( $self, $connection, $authtoken, $note ) = @_; - - my $e = new_editor(xact=>1, authtoken=>$authtoken); - return $e->event unless $e->checkauth; - my $copy = $e->retrieve_asset_copy( - [ - $note->owning_copy, - { flesh => 1, - flesh_fields => { 'acp' => ['call_number'] } - } - ] - ); - - return $e->event unless - $e->allowed('CREATE_COPY_NOTE', $copy->call_number->owning_lib); - - $note->create_date('now'); - $note->creator($e->requestor->id); - $note->pub( ($U->is_true($note->pub)) ? 't' : 'f' ); - $note->clear_id; - - $e->create_asset_copy_note($note) or return $e->event; - $e->commit; - return $note->id; -} - - -__PACKAGE__->register_method( - method => 'delete_copy_note', - api_name => 'open-ils.circ.copy_note.delete', - signature => q/ - Deletes an existing copy note - @param authtoken The login session key - @param noteid The id of the note to delete - @return 1 on success - Event otherwise. - /); -sub delete_copy_note { - my( $self, $conn, $authtoken, $noteid ) = @_; - - my $e = new_editor(xact=>1, authtoken=>$authtoken); - return $e->die_event unless $e->checkauth; - - my $note = $e->retrieve_asset_copy_note([ - $noteid, - { flesh => 2, - flesh_fields => { - 'acpn' => [ 'owning_copy' ], - 'acp' => [ 'call_number' ], - } - } - ]) or return $e->die_event; - - if( $note->creator ne $e->requestor->id ) { - return $e->die_event unless - $e->allowed('DELETE_COPY_NOTE', $note->owning_copy->call_number->owning_lib); - } - - $e->delete_asset_copy_note($note) or return $e->die_event; - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - method => 'age_hold_rules', - api_name => 'open-ils.circ.config.rules.age_hold_protect.retrieve.all', -); - -sub age_hold_rules { - my( $self, $conn ) = @_; - return new_editor()->retrieve_all_config_rules_age_hold_protect(); -} - - - -__PACKAGE__->register_method( - method => 'copy_details_barcode', - authoritative => 1, - api_name => 'open-ils.circ.copy_details.retrieve.barcode'); -sub copy_details_barcode { - my( $self, $conn, $auth, $barcode ) = @_; - my $e = new_editor(); - my $cid = $e->search_asset_copy({barcode=>$barcode, deleted=>'f'}, {idlist=>1})->[0]; - return $e->event unless $cid; - return copy_details( $self, $conn, $auth, $cid ); -} - - -__PACKAGE__->register_method( - method => 'copy_details', - api_name => 'open-ils.circ.copy_details.retrieve'); - -sub copy_details { - my( $self, $conn, $auth, $copy_id ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - my $flesh = { flesh => 1 }; - - my $copy = $e->retrieve_asset_copy( - [ - $copy_id, - { - flesh => 2, - flesh_fields => { - acp => ['call_number'], - acn => ['record'] - } - } - ]) or return $e->event; - - - # De-flesh the copy for backwards compatibility - my $mvr; - my $vol = $copy->call_number; - if( ref $vol ) { - $copy->call_number($vol->id); - my $record = $vol->record; - if( ref $record ) { - $vol->record($record->id); - $mvr = $U->record_to_mvr($record); - } - } - - - my $hold = $e->search_action_hold_request( - { - current_copy => $copy_id, - capture_time => { "!=" => undef }, - fulfillment_time => undef, - cancel_time => undef, - } - )->[0]; - - OpenILS::Application::Circ::Holds::flesh_hold_transits([$hold]) if $hold; - - my $transit = $e->search_action_transit_copy( - { target_copy => $copy_id, dest_recv_time => undef } )->[0]; - - # find the latest circ, open or closed - my $circ = $e->search_action_circulation( - [ - { target_copy => $copy_id }, - { - flesh => 1, - flesh_fields => { - circ => [ - 'workstation', - 'checkin_workstation', - 'duration_rule', - 'max_fine_rule', - 'recurring_fine_rule' - ] - }, - order_by => { circ => 'xact_start desc' }, - limit => 1 - } - ] - )->[0]; - - - return { - copy => $copy, - hold => $hold, - transit => $transit, - circ => $circ, - volume => $vol, - mvr => $mvr, - }; -} - - - - -__PACKAGE__->register_method( - method => 'mark_item', - api_name => 'open-ils.circ.mark_item_damaged', - signature => q/ - Changes the status of a copy to "damaged". Requires MARK_ITEM_DAMAGED permission. - @param authtoken The login session key - @param copy_id The ID of the copy to mark as damaged - @return 1 on success - Event otherwise. - / -); -__PACKAGE__->register_method( - method => 'mark_item', - api_name => 'open-ils.circ.mark_item_missing', - signature => q/ - Changes the status of a copy to "missing". Requires MARK_ITEM_MISSING permission. - @param authtoken The login session key - @param copy_id The ID of the copy to mark as missing - @return 1 on success - Event otherwise. - / -); -__PACKAGE__->register_method( - method => 'mark_item', - api_name => 'open-ils.circ.mark_item_bindery', - signature => q/ - Changes the status of a copy to "bindery". Requires MARK_ITEM_BINDERY permission. - @param authtoken The login session key - @param copy_id The ID of the copy to mark as bindery - @return 1 on success - Event otherwise. - / -); -__PACKAGE__->register_method( - method => 'mark_item', - api_name => 'open-ils.circ.mark_item_on_order', - signature => q/ - Changes the status of a copy to "on order". Requires MARK_ITEM_ON_ORDER permission. - @param authtoken The login session key - @param copy_id The ID of the copy to mark as on order - @return 1 on success - Event otherwise. - / -); -__PACKAGE__->register_method( - method => 'mark_item', - api_name => 'open-ils.circ.mark_item_ill', - signature => q/ - Changes the status of a copy to "inter-library loan". Requires MARK_ITEM_ILL permission. - @param authtoken The login session key - @param copy_id The ID of the copy to mark as inter-library loan - @return 1 on success - Event otherwise. - / -); -__PACKAGE__->register_method( - method => 'mark_item', - api_name => 'open-ils.circ.mark_item_cataloging', - signature => q/ - Changes the status of a copy to "cataloging". Requires MARK_ITEM_CATALOGING permission. - @param authtoken The login session key - @param copy_id The ID of the copy to mark as cataloging - @return 1 on success - Event otherwise. - / -); -__PACKAGE__->register_method( - method => 'mark_item', - api_name => 'open-ils.circ.mark_item_reserves', - signature => q/ - Changes the status of a copy to "reserves". Requires MARK_ITEM_RESERVES permission. - @param authtoken The login session key - @param copy_id The ID of the copy to mark as reserves - @return 1 on success - Event otherwise. - / -); -__PACKAGE__->register_method( - method => 'mark_item', - api_name => 'open-ils.circ.mark_item_discard', - signature => q/ - Changes the status of a copy to "discard". Requires MARK_ITEM_DISCARD permission. - @param authtoken The login session key - @param copy_id The ID of the copy to mark as discard - @return 1 on success - Event otherwise. - / -); - -sub mark_item { - my( $self, $conn, $auth, $copy_id, $args ) = @_; - my $e = new_editor(authtoken=>$auth, xact =>1); - return $e->die_event unless $e->checkauth; - $args ||= {}; - - my $copy = $e->retrieve_asset_copy([ - $copy_id, - {flesh => 1, flesh_fields => {'acp' => ['call_number']}}]) - or return $e->die_event; - - my $owning_lib = - ($copy->call_number->id == OILS_PRECAT_CALL_NUMBER) ? - $copy->circ_lib : $copy->call_number->owning_lib; - - return $e->die_event unless $e->allowed('UPDATE_COPY', $owning_lib); - - - my $perm = 'MARK_ITEM_MISSING'; - my $stat = OILS_COPY_STATUS_MISSING; - - if( $self->api_name =~ /damaged/ ) { - $perm = 'MARK_ITEM_DAMAGED'; - $stat = OILS_COPY_STATUS_DAMAGED; - my $evt = handle_mark_damaged($e, $copy, $owning_lib, $args); - return $evt if $evt; - - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - $ses->request('open-ils.trigger.event.autocreate', 'damaged', $copy, $owning_lib); - - } elsif ( $self->api_name =~ /bindery/ ) { - $perm = 'MARK_ITEM_BINDERY'; - $stat = OILS_COPY_STATUS_BINDERY; - } elsif ( $self->api_name =~ /on_order/ ) { - $perm = 'MARK_ITEM_ON_ORDER'; - $stat = OILS_COPY_STATUS_ON_ORDER; - } elsif ( $self->api_name =~ /ill/ ) { - $perm = 'MARK_ITEM_ILL'; - $stat = OILS_COPY_STATUS_ILL; - } elsif ( $self->api_name =~ /cataloging/ ) { - $perm = 'MARK_ITEM_CATALOGING'; - $stat = OILS_COPY_STATUS_CATALOGING; - } elsif ( $self->api_name =~ /reserves/ ) { - $perm = 'MARK_ITEM_RESERVES'; - $stat = OILS_COPY_STATUS_RESERVES; - } elsif ( $self->api_name =~ /discard/ ) { - $perm = 'MARK_ITEM_DISCARD'; - $stat = OILS_COPY_STATUS_DISCARD; - } - - - $copy->status($stat); - $copy->edit_date('now'); - $copy->editor($e->requestor->id); - - $e->update_asset_copy($copy) or return $e->die_event; - - my $holds = $e->search_action_hold_request( - { - current_copy => $copy->id, - fulfillment_time => undef, - cancel_time => undef, - } - ); - - $e->commit; - - $logger->debug("resetting holds that target the marked copy"); - OpenILS::Application::Circ::Holds->_reset_hold($e->requestor, $_) for @$holds; - - return 1; -} - -sub handle_mark_damaged { - my($e, $copy, $owning_lib, $args) = @_; - - my $apply = $args->{apply_fines} || ''; - return undef if $apply eq 'noapply'; - - my $new_amount = $args->{override_amount}; - my $new_btype = $args->{override_btype}; - my $new_note = $args->{override_note}; - - # grab the last circulation - my $circ = $e->search_action_circulation([ - { target_copy => $copy->id}, - { limit => 1, - order_by => {circ => "xact_start DESC"}, - flesh => 2, - flesh_fields => {circ => ['target_copy', 'usr'], au => ['card']} - } - ])->[0]; - - return undef unless $circ; - - my $charge_price = $U->ou_ancestor_setting_value( - $owning_lib, 'circ.charge_on_damaged', $e); - - my $proc_fee = $U->ou_ancestor_setting_value( - $owning_lib, 'circ.damaged_item_processing_fee', $e) || 0; - - my $void_overdue = $U->ou_ancestor_setting_value( - $owning_lib, 'circ.damaged.void_ovedue', $e) || 0; - - return undef unless $charge_price or $proc_fee; - - my $copy_price = ($charge_price) ? $U->get_copy_price($e, $copy) : 0; - my $total = $copy_price + $proc_fee; - - if($apply) { - - if($new_amount and $new_btype) { - - # Allow staff to override the amount to charge for a damaged item - # Consider the case where the item is only partially damaged - # This value is meant to take the place of the item price and - # optional processing fee. - - my $evt = OpenILS::Application::Circ::CircCommon->create_bill( - $e, $new_amount, $new_btype, 'Damaged Item Override', $circ->id, $new_note); - return $evt if $evt; - - } else { - - if($charge_price and $copy_price) { - my $evt = OpenILS::Application::Circ::CircCommon->create_bill( - $e, $copy_price, 7, 'Damaged Item', $circ->id); - return $evt if $evt; - } - - if($proc_fee) { - my $evt = OpenILS::Application::Circ::CircCommon->create_bill( - $e, $proc_fee, 8, 'Damaged Item Processing Fee', $circ->id); - return $evt if $evt; - } - } - - # the assumption is that you would not void the overdues unless you - # were also charging for the item and/or applying a processing fee - if($void_overdue) { - my $evt = OpenILS::Application::Circ::CircCommon->void_overdues($e, $circ); - return $evt if $evt; - } - - my $evt = OpenILS::Application::Circ::CircCommon->reopen_xact($e, $circ->id); - return $evt if $evt; - - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - $ses->request('open-ils.trigger.event.autocreate', 'checkout.damaged', $circ, $circ->circ_lib); - - return undef; - - } else { - return OpenILS::Event->new('DAMAGE_CHARGE', - payload => { - circ => $circ, - charge => $total - } - ); - } -} - - - -# ---------------------------------------------------------------------- -__PACKAGE__->register_method( - method => 'mark_item_missing_pieces', - api_name => 'open-ils.circ.mark_item_missing_pieces', - signature => q/ - Changes the status of a copy to "damaged" or to a custom status based on the - circ.missing_pieces.copy_status org unit setting. Requires MARK_ITEM_MISSING_PIECES - permission. - @param authtoken The login session key - @param copy_id The ID of the copy to mark as damaged - @return Success event with circ and copy objects in the payload, or error Event otherwise. - / -); - -sub mark_item_missing_pieces { - my( $self, $conn, $auth, $copy_id, $args ) = @_; - ### FIXME: We're starting a transaction here, but we're doing a lot of things outside of the transaction - my $e = new_editor(authtoken=>$auth, xact =>1); - return $e->die_event unless $e->checkauth; - $args ||= {}; - - my $copy = $e->retrieve_asset_copy([ - $copy_id, - {flesh => 1, flesh_fields => {'acp' => ['call_number']}}]) - or return $e->die_event; - - my $owning_lib = - ($copy->call_number->id == OILS_PRECAT_CALL_NUMBER) ? - $copy->circ_lib : $copy->call_number->owning_lib; - - return $e->die_event unless $e->allowed('MARK_ITEM_MISSING_PIECES', $owning_lib); - - #### grab the last circulation - my $circ = $e->search_action_circulation([ - { target_copy => $copy->id}, - { limit => 1, - order_by => {circ => "xact_start DESC"} - } - ])->[0]; - - if ($circ) { - if (! $circ->checkin_time) { # if circ active, attempt renew - my ($res) = $self->method_lookup('open-ils.circ.renew')->run($e->authtoken,{'copy_id'=>$circ->target_copy}); - if (ref $res ne 'ARRAY') { $res = [ $res ]; } - if ( $res->[0]->{textcode} eq 'SUCCESS' ) { - $circ = $res->[0]->{payload}{'circ'}; - $circ->target_copy( $copy->id ); - $logger->info('open-ils.circ.mark_item_missing_pieces: successful renewal'); - } else { - $logger->info('open-ils.circ.mark_item_missing_pieces: non-successful renewal'); - } - } else { - - my $co_params = { - 'copy_id'=>$circ->target_copy, - 'patron_id'=>$circ->usr, - 'skip_deposit_fee'=>1, - 'skip_rental_fee'=>1 - }; - - if ($U->ou_ancestor_setting_value($e->requestor->ws_ou, 'circ.block_renews_for_holds')) { - - my ($hold, undef, $retarget) = $holdcode->find_nearest_permitted_hold( - $e, $copy, $e->requestor, 1 ); - - if ($hold) { # needed for hold? then due now - - $logger->info('open-ils.circ.mark_item_missing_pieces: item needed for hold, shortening due date'); - my $due_date = DateTime->now(time_zone => 'local'); - $co_params->{'due_date'} = cleanse_ISO8601( $due_date->strftime('%FT%T%z') ); - } else { - $logger->info('open-ils.circ.mark_item_missing_pieces: item not needed for hold'); - } - } - - my ($res) = $self->method_lookup('open-ils.circ.checkout.full.override')->run($e->authtoken,$co_params); - if (ref $res ne 'ARRAY') { $res = [ $res ]; } - if ( $res->[0]->{textcode} eq 'SUCCESS' ) { - $logger->info('open-ils.circ.mark_item_missing_pieces: successful checkout'); - $circ = $res->[0]->{payload}{'circ'}; - } else { - $logger->info('open-ils.circ.mark_item_missing_pieces: non-successful checkout'); - $e->rollback; - return $res; - } - } - } else { - $logger->info('open-ils.circ.mark_item_missing_pieces: no previous checkout'); - $e->rollback; - return OpenILS::Event->new('ACTION_CIRCULATION_NOT_FOUND',{'copy'=>$copy}); - } - - ### Update the item status - - my $custom_stat = $U->ou_ancestor_setting_value( - $owning_lib, 'circ.missing_pieces.copy_status', $e); - my $stat = $custom_stat || OILS_COPY_STATUS_DAMAGED; - - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - $ses->request('open-ils.trigger.event.autocreate', 'missing_pieces', $copy, $owning_lib); - - $copy->status($stat); - $copy->edit_date('now'); - $copy->editor($e->requestor->id); - - $e->update_asset_copy($copy) or return $e->die_event; - - my $holds = $e->search_action_hold_request( - { - current_copy => $copy->id, - fulfillment_time => undef, - cancel_time => undef, - } - ); - - $logger->debug("resetting holds that target the marked copy"); - OpenILS::Application::Circ::Holds->_reset_hold($e->requestor, $_) for @$holds; - - if ($e->commit) { - - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - $ses->request('open-ils.trigger.event.autocreate', 'circ.missing_pieces', $circ, $circ->circ_lib); - - return OpenILS::Event->new('SUCCESS', - payload => { - circ => $circ, - copy => $copy, - slip => $U->fire_object_event(undef, 'circ.format.missing_pieces.slip.print', $circ, $circ->circ_lib), - letter => $U->fire_object_event(undef, 'circ.format.missing_pieces.letter.print', $circ, $circ->circ_lib) - } - ); - - } else { - return $e->die_event; - } -} - - - - - -# ---------------------------------------------------------------------- -__PACKAGE__->register_method( - method => 'magic_fetch', - api_name => 'open-ils.agent.fetch' -); - -my @FETCH_ALLOWED = qw/ aou aout acp acn bre /; - -sub magic_fetch { - my( $self, $conn, $auth, $args ) = @_; - my $e = new_editor( authtoken => $auth ); - return $e->event unless $e->checkauth; - - my $hint = $$args{hint}; - my $id = $$args{id}; - - # Is the call allowed to fetch this type of object? - return undef unless grep { $_ eq $hint } @FETCH_ALLOWED; - - # Find the class the implements the given hint - my ($class) = grep { - $Fieldmapper::fieldmap->{$_}{hint} eq $hint } Fieldmapper->classes; - - $class =~ s/Fieldmapper:://og; - $class =~ s/::/_/og; - my $method = "retrieve_$class"; - - my $obj = $e->$method($id) or return $e->event; - return $obj; -} -# ---------------------------------------------------------------------- - - -__PACKAGE__->register_method( - method => "fleshed_circ_retrieve", - authoritative => 1, - api_name => "open-ils.circ.fleshed.retrieve",); - -sub fleshed_circ_retrieve { - my( $self, $client, $id ) = @_; - my $e = new_editor(); - my $circ = $e->retrieve_action_circulation( - [ - $id, - { - flesh => 4, - flesh_fields => { - circ => [ qw/ target_copy / ], - acp => [ qw/ location status stat_cat_entry_copy_maps notes age_protect call_number / ], - ascecm => [ qw/ stat_cat stat_cat_entry / ], - acn => [ qw/ record / ], - } - } - ] - ) or return $e->event; - - my $copy = $circ->target_copy; - my $vol = $copy->call_number; - my $rec = $circ->target_copy->call_number->record; - - $vol->record($rec->id); - $copy->call_number($vol->id); - $circ->target_copy($copy->id); - - my $mvr; - - if( $rec->id == OILS_PRECAT_RECORD ) { - $rec = undef; - $vol = undef; - } else { - $mvr = $U->record_to_mvr($rec); - $rec->marc(''); # drop the bulky marc data - } - - return { - circ => $circ, - copy => $copy, - volume => $vol, - record => $rec, - mvr => $mvr, - }; -} - - - -__PACKAGE__->register_method( - method => "test_batch_circ_events", - api_name => "open-ils.circ.trigger_event_by_def_and_barcode.fire" -); - -# method for testing the behavior of a given event definition -sub test_batch_circ_events { - my($self, $conn, $auth, $event_def, $barcode) = @_; - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_CIRCULATIONS'); - - my $copy = $e->search_asset_copy({barcode => $barcode, deleted => 'f'})->[0] - or return $e->event; - - my $circ = $e->search_action_circulation( - {target_copy => $copy->id, checkin_time => undef})->[0] - or return $e->event; - - return undef unless $circ; - - return $U->fire_object_event($event_def, undef, $circ, $e->requestor->ws_ou) -} - - -__PACKAGE__->register_method( - method => "fire_circ_events", - api_name => "open-ils.circ.fire_circ_trigger_events", - signature => q/ - General event def runner for circ objects. If no event def ID - is provided, the hook will be used to find the best event_def - match based on the context org unit - / -); - -__PACKAGE__->register_method( - method => "fire_circ_events", - api_name => "open-ils.circ.fire_hold_trigger_events", - signature => q/ - General event def runner for hold objects. If no event def ID - is provided, the hook will be used to find the best event_def - match based on the context org unit - / -); - -__PACKAGE__->register_method( - method => "fire_circ_events", - api_name => "open-ils.circ.fire_user_trigger_events", - signature => q/ - General event def runner for user objects. If no event def ID - is provided, the hook will be used to find the best event_def - match based on the context org unit - / -); - - -sub fire_circ_events { - my($self, $conn, $auth, $org_id, $event_def, $hook, $granularity, $target_ids, $user_data) = @_; - - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->event unless $e->checkauth; - - my $targets; - - if($self->api_name =~ /hold/) { - return $e->event unless $e->allowed('VIEW_HOLD', $org_id); - $targets = $e->batch_retrieve_action_hold_request($target_ids); - } elsif($self->api_name =~ /user/) { - return $e->event unless $e->allowed('VIEW_USER', $org_id); - $targets = $e->batch_retrieve_actor_user($target_ids); - } else { - return $e->event unless $e->allowed('VIEW_CIRCULATIONS', $org_id); - $targets = $e->batch_retrieve_action_circulation($target_ids); - } - $e->rollback; # FIXME using transaction because of pgpool/slony setups, but not - # simply making this method authoritative because of weirdness - # with transaction handling in A/T code that causes rollback - # failure down the line if handling many targets - - return undef unless @$targets; - return $U->fire_object_event($event_def, $hook, $targets, $org_id, $granularity, $user_data); -} - -__PACKAGE__->register_method( - method => "user_payments_list", - api_name => "open-ils.circ.user_payments.filtered.batch", - stream => 1, - signature => { - desc => q/Returns a fleshed, date-limited set of all payments a user - has made. By default, ordered by payment date. Optionally - ordered by other columns in the top-level "mp" object/, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'User ID', type => 'number'}, - {desc => 'Order by column(s), optional. Array of "mp" class columns', type => 'array'} - ], - return => {desc => q/List of "mp" objects, fleshed with the billable transaction - and the related fully-realized payment object (e.g money.cash_payment)/} - } -); - -sub user_payments_list { - my($self, $conn, $auth, $user_id, $start_date, $end_date, $order_by) = @_; - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - my $user = $e->retrieve_actor_user($user_id) or return $e->event; - return $e->event unless $e->allowed('VIEW_CIRCULATIONS', $user->home_ou); - - $order_by ||= ['payment_ts']; - - # all payments by user, between start_date and end_date - my $payments = $e->json_query({ - select => {mp => ['id']}, - from => { - mp => { - mbt => { - fkey => 'xact', field => 'id'} - } - }, - where => { - '+mbt' => {usr => $user_id}, - '+mp' => {payment_ts => {between => [$start_date, $end_date]}} - }, - order_by => {mp => $order_by} - }); - - for my $payment_id (@$payments) { - my $payment = $e->retrieve_money_payment([ - $payment_id->{id}, - { - flesh => 2, - flesh_fields => { - mp => [ - 'xact', - 'cash_payment', - 'credit_card_payment', - 'credit_payment', - 'check_payment', - 'work_payment', - 'forgive_payment', - 'goods_payment' - ], - mbt => [ - 'circulation', - 'grocery', - 'reservation' - ] - } - } - ]); - $conn->respond($payment); - } - - return undef; -} - - -__PACKAGE__->register_method( - method => "retrieve_circ_chain", - api_name => "open-ils.circ.renewal_chain.retrieve_by_circ", - stream => 1, - signature => { - desc => q/Given a circulation, this returns all circulation objects - that are part of the same chain of renewals./, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Circ ID', type => 'number'}, - ], - return => {desc => q/List of circ objects, orderd by oldest circ first/} - } -); - -__PACKAGE__->register_method( - method => "retrieve_circ_chain", - api_name => "open-ils.circ.renewal_chain.retrieve_by_circ.summary", - signature => { - desc => q/Given a circulation, this returns a summary of the circulation objects - that are part of the same chain of renewals./, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Circ ID', type => 'number'}, - ], - return => {desc => q/Circulation Chain Summary/} - } -); - -sub retrieve_circ_chain { - my($self, $conn, $auth, $circ_id) = @_; - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_CIRCULATIONS'); - - if($self->api_name =~ /summary/) { - return $U->create_circ_chain_summary($e, $circ_id); - - } else { - - my $chain = $e->json_query({from => ['action.circ_chain', $circ_id]}); - - for my $circ_info (@$chain) { - my $circ = Fieldmapper::action::circulation->new; - $circ->$_($circ_info->{$_}) for keys %$circ_info; - $conn->respond($circ); - } - } - - return undef; -} - -__PACKAGE__->register_method( - method => "retrieve_prev_circ_chain", - api_name => "open-ils.circ.prev_renewal_chain.retrieve_by_circ", - stream => 1, - signature => { - desc => q/Given a circulation, this returns all circulation objects - that are part of the previous chain of renewals./, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Circ ID', type => 'number'}, - ], - return => {desc => q/List of circ objects, orderd by oldest circ first/} - } -); - -__PACKAGE__->register_method( - method => "retrieve_prev_circ_chain", - api_name => "open-ils.circ.prev_renewal_chain.retrieve_by_circ.summary", - signature => { - desc => q/Given a circulation, this returns a summary of the circulation objects - that are part of the previous chain of renewals./, - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Circ ID', type => 'number'}, - ], - return => {desc => q/Object containing Circulation Chain Summary and User Id/} - } -); - -sub retrieve_prev_circ_chain { - my($self, $conn, $auth, $circ_id) = @_; - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_CIRCULATIONS'); - - if($self->api_name =~ /summary/) { - my $first_circ = $e->json_query({from => ['action.circ_chain', $circ_id]})->[0]; - my $target_copy = $$first_circ{'target_copy'}; - my $usr = $$first_circ{'usr'}; - my $last_circ_from_prev_chain = $e->json_query({ - 'select' => { 'circ' => ['id','usr'] }, - 'from' => 'circ', - 'where' => { - target_copy => $target_copy, - xact_start => { '<' => $$first_circ{'xact_start'} } - }, - 'order_by' => [{ 'class'=>'circ', 'field'=>'xact_start', 'direction'=>'desc' }], - 'limit' => 1 - })->[0]; - return undef unless $last_circ_from_prev_chain; - return undef unless $$last_circ_from_prev_chain{'id'}; - my $sum = $e->json_query({from => ['action.summarize_circ_chain', $$last_circ_from_prev_chain{'id'}]})->[0]; - return undef unless $sum; - my $obj = Fieldmapper::action::circ_chain_summary->new; - $obj->$_($sum->{$_}) for keys %$sum; - return { 'summary' => $obj, 'usr' => $$last_circ_from_prev_chain{'usr'} }; - - } else { - - my $first_circ = $e->json_query({from => ['action.circ_chain', $circ_id]})->[0]; - my $target_copy = $$first_circ{'target_copy'}; - my $last_circ_from_prev_chain = $e->json_query({ - 'select' => { 'circ' => ['id'] }, - 'from' => 'circ', - 'where' => { - target_copy => $target_copy, - xact_start => { '<' => $$first_circ{'xact_start'} } - }, - 'order_by' => [{ 'class'=>'circ', 'field'=>'xact_start', 'direction'=>'desc' }], - 'limit' => 1 - })->[0]; - return undef unless $last_circ_from_prev_chain; - return undef unless $$last_circ_from_prev_chain{'id'}; - my $chain = $e->json_query({from => ['action.circ_chain', $$last_circ_from_prev_chain{'id'}]}); - - for my $circ_info (@$chain) { - my $circ = Fieldmapper::action::circulation->new; - $circ->$_($circ_info->{$_}) for keys %$circ_info; - $conn->respond($circ); - } - } - - return undef; -} - - -__PACKAGE__->register_method( - method => "get_copy_due_date", - api_name => "open-ils.circ.copy.due_date.retrieve", - signature => { - desc => q/ - Given a copy ID, returns the due date for the copy if it's - currently circulating. Otherwise, returns null. Note, this is a public - method requiring no authentication. Only the due date is exposed. - /, - params => [ - {desc => 'Copy ID', type => 'number'} - ], - return => {desc => q/ - Due date (ISO date stamp) if the copy is circulating, null otherwise. - /} - } -); - -sub get_copy_due_date { - my($self, $conn, $copy_id) = @_; - my $e = new_editor(); - - my $circ = $e->json_query({ - select => {circ => ['due_date']}, - from => 'circ', - where => { - target_copy => $copy_id, - checkin_time => undef, - '-or' => [ - {stop_fines => ["MAXFINES","LONGOVERDUE"]}, - {stop_fines => undef} - ], - }, - limit => 1 - })->[0] or return undef; - - return $circ->{due_date}; -} - - - - - -# {"select":{"acp":["id"],"circ":[{"aggregate":true,"transform":"count","alias":"count","column":"id"}]},"from":{"acp":{"circ":{"field":"target_copy","fkey":"id","type":"left"},"acn"{"field":"id","fkey":"call_number"}}},"where":{"+acn":{"record":200057}} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ/CircCommon.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ/CircCommon.pm deleted file mode 100644 index 1319201554..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ/CircCommon.pm +++ /dev/null @@ -1,109 +0,0 @@ -package OpenILS::Application::Circ::CircCommon; -use strict; use warnings; -use DateTime; -use DateTime::Format::ISO8601; -use OpenILS::Application::AppUtils; -use OpenSRF::Utils qw/:datetime/; -use OpenILS::Event; -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Const qw/:const/; - -my $U = "OpenILS::Application::AppUtils"; - -# ----------------------------------------------------------------- -# Do not publish methods here. This code is shared across apps. -# ----------------------------------------------------------------- - - -# ----------------------------------------------------------------- -# Voids overdue fines on the given circ. if a backdate is -# provided, then we only void back to the backdate -# ----------------------------------------------------------------- -sub void_overdues { - my($class, $e, $circ, $backdate, $note) = @_; - - my $bill_search = { - xact => $circ->id, - btype => 1 - }; - - if( $backdate ) { - # ------------------------------------------------------------------ - # Fines for overdue materials are assessed up to, but not including, - # one fine interval after the fines are applicable. Here, we add - # one fine interval to the backdate to ensure that we are not - # voiding fines that were applicable before the backdate. - # ------------------------------------------------------------------ - - # if there is a raw time component (e.g. from postgres), - # turn it into an interval that interval_to_seconds can parse - my $duration = $circ->fine_interval; - $duration =~ s/(\d{2}):(\d{2}):(\d{2})/$1 h $2 m $3 s/o; - my $interval = OpenSRF::Utils->interval_to_seconds($duration); - - my $date = DateTime::Format::ISO8601->parse_datetime($backdate); - $backdate = $U->epoch2ISO8601($date->epoch + $interval); - $logger->info("applying backdate $backdate in overdue voiding"); - $$bill_search{billing_ts} = {'>=' => $backdate}; - } - - my $bills = $e->search_money_billing($bill_search); - - for my $bill (@$bills) { - next if $U->is_true($bill->voided); - $logger->info("voiding overdue bill ".$bill->id); - $bill->voided('t'); - $bill->void_time('now'); - $bill->voider($e->requestor->id); - my $n = ($bill->note) ? sprintf("%s\n", $bill->note) : ""; - $bill->note(sprintf("$n%s", ($note) ? $note : "System: VOIDED FOR BACKDATE")); - $e->update_money_billing($bill) or return $e->die_event; - } - - return undef; -} - - -sub reopen_xact { - my($class, $e, $xactid) = @_; - - # ----------------------------------------------------------------- - # make sure the transaction is not closed - my $xact = $e->retrieve_money_billable_transaction($xactid) - or return $e->die_event; - - if( $xact->xact_finish ) { - my ($mbts) = $U->fetch_mbts($xactid, $e); - if( $mbts->balance_owed != 0 ) { - $logger->info("* re-opening xact $xactid, orig xact_finish is ".$xact->xact_finish); - $xact->clear_xact_finish; - $e->update_money_billable_transaction($xact) - or return $e->die_event; - } - } - - return undef; -} - - -sub create_bill { - my($class, $e, $amount, $btype, $type, $xactid, $note) = @_; - - $logger->info("The system is charging $amount [$type] on xact $xactid"); - $note ||= 'SYSTEM GENERATED'; - - # ----------------------------------------------------------------- - # now create the billing - my $bill = Fieldmapper::money::billing->new; - $bill->xact($xactid); - $bill->amount($amount); - $bill->billing_type($type); - $bill->btype($btype); - $bill->note($note); - $e->create_money_billing($bill) or return $e->die_event; - - return undef; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ/Circulate.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ/Circulate.pm deleted file mode 100644 index c000676b45..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ/Circulate.pm +++ /dev/null @@ -1,3433 +0,0 @@ -package OpenILS::Application::Circ::Circulate; -use strict; use warnings; -use base 'OpenILS::Application'; -use OpenSRF::EX qw(:try); -use OpenSRF::AppSession; -use OpenSRF::Utils::SettingsClient; -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Const qw/:const/; -use OpenILS::Application::AppUtils; -use DateTime; -my $U = "OpenILS::Application::AppUtils"; - -my %scripts; -my $script_libs; -my $legacy_script_support = 0; -my $booking_status; - -sub determine_booking_status { - unless (defined $booking_status) { - my $ses = create OpenSRF::AppSession("router"); - $booking_status = grep {$_ eq "open-ils.booking"} @{ - $ses->request("opensrf.router.info.class.list")->gather(1) - }; - $ses->disconnect; - $logger->info("booking status: " . ($booking_status ? "on" : "off")); - } - - return $booking_status; -} - - -my $MK_ENV_FLESH = { - flesh => 2, - flesh_fields => {acp => ['call_number'], acn => ['record']} -}; - -sub initialize { - - my $self = shift; - my $conf = OpenSRF::Utils::SettingsClient->new; - my @pfx2 = ( "apps", "open-ils.circ","app_settings" ); - - $legacy_script_support = $conf->config_value(@pfx2, 'legacy_script_support'); - $legacy_script_support = ($legacy_script_support and $legacy_script_support =~ /true/i); - - my $lb = $conf->config_value( @pfx2, 'script_path' ); - $lb = [ $lb ] unless ref($lb); - $script_libs = $lb; - - return unless $legacy_script_support; - - my @pfx = ( @pfx2, "scripts" ); - my $p = $conf->config_value( @pfx, 'circ_permit_patron' ); - my $c = $conf->config_value( @pfx, 'circ_permit_copy' ); - my $d = $conf->config_value( @pfx, 'circ_duration' ); - my $f = $conf->config_value( @pfx, 'circ_recurring_fines' ); - my $m = $conf->config_value( @pfx, 'circ_max_fines' ); - my $pr = $conf->config_value( @pfx, 'circ_permit_renew' ); - - $logger->error( "Missing circ script(s)" ) - unless( $p and $c and $d and $f and $m and $pr ); - - $scripts{circ_permit_patron} = $p; - $scripts{circ_permit_copy} = $c; - $scripts{circ_duration} = $d; - $scripts{circ_recurring_fines} = $f; - $scripts{circ_max_fines} = $m; - $scripts{circ_permit_renew} = $pr; - - $logger->debug( - "circulator: Loaded rules scripts for circ: " . - "circ permit patron = $p, ". - "circ permit copy = $c, ". - "circ duration = $d, ". - "circ recurring fines = $f, " . - "circ max fines = $m, ". - "circ renew permit = $pr. ". - "lib paths = @$lb. ". - "legacy script support = ". ($legacy_script_support) ? 'yes' : 'no' - ); -} - -__PACKAGE__->register_method( - method => "run_method", - api_name => "open-ils.circ.checkout.permit", - notes => q/ - Determines if the given checkout can occur - @param authtoken The login session key - @param params A trailing hash of named params including - barcode : The copy barcode, - patron : The patron the checkout is occurring for, - renew : true or false - whether or not this is a renewal - @return The event that occurred during the permit check. - /); - - -__PACKAGE__->register_method ( - method => 'run_method', - api_name => 'open-ils.circ.checkout.permit.override', - signature => q/@see open-ils.circ.checkout.permit/, -); - - -__PACKAGE__->register_method( - method => "run_method", - api_name => "open-ils.circ.checkout", - notes => q/ - Checks out an item - @param authtoken The login session key - @param params A named hash of params including: - copy The copy object - barcode If no copy is provided, the copy is retrieved via barcode - copyid If no copy or barcode is provide, the copy id will be use - patron The patron's id - noncat True if this is a circulation for a non-cataloted item - noncat_type The non-cataloged type id - noncat_circ_lib The location for the noncat circ. - precat The item has yet to be cataloged - dummy_title The temporary title of the pre-cataloded item - dummy_author The temporary authr of the pre-cataloded item - Default is the home org of the staff member - @return The SUCCESS event on success, any other event depending on the error - /); - -__PACKAGE__->register_method( - method => "run_method", - api_name => "open-ils.circ.checkin", - argc => 2, - signature => q/ - Generic super-method for handling all copies - @param authtoken The login session key - @param params Hash of named parameters including: - barcode - The copy barcode - force - If true, copies in bad statuses will be checked in and give good statuses - noop - don't capture holds or put items into transit - void_overdues - void all overdues for the circulation (aka amnesty) - ... - / -); - -__PACKAGE__->register_method( - method => "run_method", - api_name => "open-ils.circ.checkin.override", - signature => q/@see open-ils.circ.checkin/ -); - -__PACKAGE__->register_method( - method => "run_method", - api_name => "open-ils.circ.renew.override", - signature => q/@see open-ils.circ.renew/, -); - - -__PACKAGE__->register_method( - method => "run_method", - api_name => "open-ils.circ.renew", - notes => <<" NOTES"); - PARAMS( authtoken, circ => circ_id ); - open-ils.circ.renew(login_session, circ_object); - Renews the provided circulation. login_session is the requestor of the - renewal and if the logged in user is not the same as circ->usr, then - the logged in user must have RENEW_CIRC permissions. - NOTES - -__PACKAGE__->register_method( - method => "run_method", - api_name => "open-ils.circ.checkout.full" -); -__PACKAGE__->register_method( - method => "run_method", - api_name => "open-ils.circ.checkout.full.override" -); -__PACKAGE__->register_method( - method => "run_method", - api_name => "open-ils.circ.reservation.pickup" -); -__PACKAGE__->register_method( - method => "run_method", - api_name => "open-ils.circ.reservation.return" -); -__PACKAGE__->register_method( - method => "run_method", - api_name => "open-ils.circ.checkout.inspect", - desc => q/Returns the circ matrix test result and, on success, the rule set and matrix test object/ -); - - -sub run_method { - my( $self, $conn, $auth, $args ) = @_; - translate_legacy_args($args); - my $api = $self->api_name; - - my $circulator = - OpenILS::Application::Circ::Circulator->new($auth, %$args); - - return circ_events($circulator) if $circulator->bail_out; - - $circulator->use_booking(determine_booking_status()); - - # -------------------------------------------------------------------------- - # First, check for a booking transit, as the barcode may not be a copy - # barcode, but a resource barcode, and nothing else in here will work - # -------------------------------------------------------------------------- - - if ($circulator->use_booking && (my $bc = $circulator->copy_barcode) && $api !~ /checkout|inspect/) { # do we have a barcode? - my $resources = $circulator->editor->search_booking_resource( { barcode => $bc } ); # any resources by this barcode? - if (@$resources) { # yes! - - my $res_id_list = [ map { $_->id } @$resources ]; - my $transit = $circulator->editor->search_action_reservation_transit_copy( - [ - { target_copy => $res_id_list, dest => $circulator->circ_lib, dest_recv_time => undef }, - { order_by => { artc => 'source_send_time' }, limit => 1 } - ] - )->[0]; # Any transit for this barcode? - - if ($transit) { # yes! unwrap it. - - my $reservation = $circulator->editor->retrieve_booking_reservation( $transit->reservation ); - my $res_type = $circulator->editor->retrieve_booking_resource_type( $reservation->target_resource_type ); - - my $success_event = new OpenILS::Event( - "SUCCESS", "payload" => {"reservation" => $reservation} - ); - if ($U->is_true($res_type->catalog_item)) { # is there a copy to be had here? - if (my $copy = $circulator->editor->search_asset_copy([ - { barcode => $bc, deleted => 'f' }, $MK_ENV_FLESH - ])->[0]) { # got a copy - $copy->status( $transit->copy_status ); - $copy->editor($circulator->editor->requestor->id); - $copy->edit_date('now'); - $circulator->editor->update_asset_copy($copy); - $success_event->{"payload"}->{"record"} = - $U->record_to_mvr($copy->call_number->record); - $copy->call_number($copy->call_number->id); - $success_event->{"payload"}->{"copy"} = $copy; - } - } - - $transit->dest_recv_time('now'); - $circulator->editor->update_action_reservation_transit_copy( $transit ); - - $circulator->editor->commit; - # Formerly this branch just stopped here. Argh! - $conn->respond_complete($success_event); - return; - } - } - } - - - - # -------------------------------------------------------------------------- - # Go ahead and load the script runner to make sure we have all - # of the objects we need - # -------------------------------------------------------------------------- - - if ($circulator->use_booking) { - $circulator->is_res_checkin($circulator->is_checkin(1)) - if $api =~ /reservation.return/ or ( - $api =~ /checkin/ and $circulator->seems_like_reservation() - ); - - $circulator->is_res_checkout(1) if $api =~ /reservation.pickup/; - } - - $circulator->is_renewal(1) if $api =~ /renew/; - $circulator->is_checkin(1) if $api =~ /checkin/; - - $circulator->mk_env(); - $circulator->noop(1) if $circulator->claims_never_checked_out; - - if($legacy_script_support and not $circulator->is_checkin) { - $circulator->mk_script_runner(); - $circulator->legacy_script_support(1); - $circulator->circ_permit_patron($scripts{circ_permit_patron}); - $circulator->circ_permit_copy($scripts{circ_permit_copy}); - $circulator->circ_duration($scripts{circ_duration}); - $circulator->circ_permit_renew($scripts{circ_permit_renew}); - } - return circ_events($circulator) if $circulator->bail_out; - - - $circulator->override(1) if $api =~ /override/o; - - if( $api =~ /checkout\.permit/ ) { - $circulator->do_permit(); - - } elsif( $api =~ /checkout.full/ ) { - - # requesting a precat checkout implies that any required - # overrides have been performed. Go ahead and re-override. - $circulator->skip_permit_key(1); - $circulator->override(1) if $circulator->request_precat; - $circulator->do_permit(); - $circulator->is_checkout(1); - unless( $circulator->bail_out ) { - $circulator->events([]); - $circulator->do_checkout(); - } - - } elsif( $circulator->is_res_checkout ) { - $circulator->do_reservation_pickup(); - - } elsif( $api =~ /inspect/ ) { - my $data = $circulator->do_inspect(); - $circulator->editor->rollback; - return $data; - - } elsif( $api =~ /checkout/ ) { - $circulator->is_checkout(1); - $circulator->do_checkout(); - - } elsif( $circulator->is_res_checkin ) { - $circulator->do_reservation_return(); - $circulator->do_checkin() if ($circulator->copy()); - } elsif( $api =~ /checkin/ ) { - $circulator->do_checkin(); - - } elsif( $api =~ /renew/ ) { - $circulator->is_renewal(1); - $circulator->do_renew(); - } - - if( $circulator->bail_out ) { - - my @ee; - # make sure no success event accidentally slip in - $circulator->events( - [ grep { $_->{textcode} ne 'SUCCESS' } @{$circulator->events} ]); - - # Log the events - my @e = @{$circulator->events}; - push( @ee, $_->{textcode} ) for @e; - $logger->info("circulator: bailing out with events: " . (join ", ", @ee)); - - $circulator->editor->rollback; - - } else { - $circulator->editor->commit; - } - - $circulator->script_runner->cleanup if $circulator->script_runner; - - $conn->respond_complete(circ_events($circulator)); - - unless($circulator->bail_out) { - $circulator->do_hold_notify($circulator->notify_hold) - if $circulator->notify_hold; - $circulator->retarget_holds if $circulator->retarget; - $circulator->append_reading_list; - $circulator->make_trigger_events; - } -} - -sub circ_events { - my $circ = shift; - my @e = @{$circ->events}; - # if we have multiple events, SUCCESS should not be one of them; - @e = grep { $_->{textcode} ne 'SUCCESS' } @e if @e > 1; - return (@e == 1) ? $e[0] : \@e; -} - - -sub translate_legacy_args { - my $args = shift; - - if( $$args{barcode} ) { - $$args{copy_barcode} = $$args{barcode}; - delete $$args{barcode}; - } - - if( $$args{copyid} ) { - $$args{copy_id} = $$args{copyid}; - delete $$args{copyid}; - } - - if( $$args{patronid} ) { - $$args{patron_id} = $$args{patronid}; - delete $$args{patronid}; - } - - if( $$args{patron} and !ref($$args{patron}) ) { - $$args{patron_id} = $$args{patron}; - delete $$args{patron}; - } - - - if( $$args{noncat} ) { - $$args{is_noncat} = $$args{noncat}; - delete $$args{noncat}; - } - - if( $$args{precat} ) { - $$args{is_precat} = $$args{request_precat} = $$args{precat}; - delete $$args{precat}; - } -} - - - -# -------------------------------------------------------------------------- -# This package actually manages all of the circulation logic -# -------------------------------------------------------------------------- -package OpenILS::Application::Circ::Circulator; -use strict; use warnings; -use vars q/$AUTOLOAD/; -use DateTime; -use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::Cache; -use Digest::MD5 qw(md5_hex); -use DateTime::Format::ISO8601; -use OpenILS::Utils::PermitHold; -use OpenSRF::Utils qw/:datetime/; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Application::Circ::Holds; -use OpenILS::Application::Circ::Transit; -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Utils::CStoreEditor qw/:funcs/; -use OpenILS::Application::Circ::ScriptBuilder; -use OpenILS::Const qw/:const/; -use OpenILS::Utils::Penalty; -use OpenILS::Application::Circ::CircCommon; -use Time::Local; - -my $holdcode = "OpenILS::Application::Circ::Holds"; -my $transcode = "OpenILS::Application::Circ::Transit"; -my %user_groups; - -sub DESTROY { } - - -# -------------------------------------------------------------------------- -# Add a pile of automagic getter/setter methods -# -------------------------------------------------------------------------- -my @AUTOLOAD_FIELDS = qw/ - notify_hold - remote_hold - backdate - reservation - copy - copy_id - copy_barcode - patron - patron_id - patron_barcode - script_runner - volume - title - is_renewal - is_checkout - is_res_checkout - is_precat - is_noncat - request_precat - is_checkin - is_res_checkin - noncat_type - editor - events - cache_handle - override - circ_permit_patron - circ_permit_copy - circ_duration - circ_recurring_fines - circ_max_fines - circ_permit_renew - circ - transit - hold - permit_key - noncat_circ_lib - noncat_count - checkout_time - dummy_title - dummy_author - dummy_isbn - circ_modifier - circ_lib - barcode - duration_level - recurring_fines_level - duration_rule - recurring_fines_rule - max_fine_rule - renewal_remaining - hard_due_date - due_date - fulfilled_holds - transit - checkin_changed - force - permit_override - pending_checkouts - cancelled_hold_transit - opac_renewal - phone_renewal - desk_renewal - sip_renewal - retarget - matrix_test_result - circ_matrix_matchpoint - circ_test_success - legacy_script_support - is_deposit - is_rental - deposit_billing - rental_billing - capture - noop - void_overdues - parent_circ - return_patron - claims_never_checked_out - skip_permit_key - skip_deposit_fee - skip_rental_fee - use_booking -/; - - -sub AUTOLOAD { - my $self = shift; - my $type = ref($self) or die "$self is not an object"; - my $data = shift; - my $name = $AUTOLOAD; - $name =~ s/.*://o; - - unless (grep { $_ eq $name } @AUTOLOAD_FIELDS) { - $logger->error("circulator: $type: invalid autoload field: $name"); - die "$type: invalid autoload field: $name\n" - } - - { - no strict 'refs'; - *{"${type}::${name}"} = sub { - my $s = shift; - my $v = shift; - $s->{$name} = $v if defined $v; - return $s->{$name}; - } - } - return $self->$name($data); -} - - -sub new { - my( $class, $auth, %args ) = @_; - $class = ref($class) || $class; - my $self = bless( {}, $class ); - - $self->events([]); - $self->editor(new_editor(xact => 1, authtoken => $auth)); - - unless( $self->editor->checkauth ) { - $self->bail_on_events($self->editor->event); - return $self; - } - - $self->cache_handle(OpenSRF::Utils::Cache->new('global')); - - $self->$_($args{$_}) for keys %args; - - $self->circ_lib( - ($self->circ_lib) ? $self->circ_lib : $self->editor->requestor->ws_ou); - - # if this is a renewal, default to desk_renewal - $self->desk_renewal(1) unless - $self->opac_renewal or $self->phone_renewal or $self->sip_renewal; - - $self->capture('') unless $self->capture; - - unless(%user_groups) { - my $gps = $self->editor->retrieve_all_permission_grp_tree; - %user_groups = map { $_->id => $_ } @$gps; - } - - return $self; -} - - -# -------------------------------------------------------------------------- -# True if we should discontinue processing -# -------------------------------------------------------------------------- -sub bail_out { - my( $self, $bool ) = @_; - if( defined $bool ) { - $logger->info("circulator: BAILING OUT") if $bool; - $self->{bail_out} = $bool; - } - return $self->{bail_out}; -} - - -sub push_events { - my( $self, @evts ) = @_; - for my $e (@evts) { - next unless $e; - $e->{payload} = $self->copy if - ($e->{textcode} eq 'COPY_NOT_AVAILABLE'); - - $logger->info("circulator: pushing event ".$e->{textcode}); - push( @{$self->events}, $e ) unless - grep { $_->{textcode} eq $e->{textcode} } @{$self->events}; - } -} - -sub mk_permit_key { - my $self = shift; - return '' if $self->skip_permit_key; - my $key = md5_hex( time() . rand() . "$$" ); - $self->cache_handle->put_cache( "oils_permit_key_$key", 1, 300 ); - return $self->permit_key($key); -} - -sub check_permit_key { - my $self = shift; - return 1 if $self->skip_permit_key; - my $key = $self->permit_key; - return 0 unless $key; - my $k = "oils_permit_key_$key"; - my $one = $self->cache_handle->get_cache($k); - $self->cache_handle->delete_cache($k); - return ($one) ? 1 : 0; -} - -sub seems_like_reservation { - my $self = shift; - - # Some words about the following method: - # 1) It requires the VIEW_USER permission, but that's not an - # issue, right, since all staff should have that? - # 2) It returns only one reservation at a time, even if an item can be - # and is currently overbooked. Hmmm.... - my $booking_ses = create OpenSRF::AppSession("open-ils.booking"); - my $result = $booking_ses->request( - "open-ils.booking.reservations.by_returnable_resource_barcode", - $self->editor->authtoken, - $self->copy_barcode - )->gather(1); - $booking_ses->disconnect; - - return $self->bail_on_events($result) if defined $U->event_code($result); - - if (@$result > 0) { - $self->reservation(shift @$result); - return 1; - } else { - return 0; - } - -} - -# save_trimmed_copy() used just to be a block in mk_env(), but was separated for re-use -sub save_trimmed_copy { - my ($self, $copy) = @_; - - $self->copy($copy); - $self->volume($copy->call_number); - $self->title($self->volume->record); - $self->copy->call_number($self->volume->id); - $self->volume->record($self->title->id); - $self->is_precat(1) if $self->volume->id == OILS_PRECAT_CALL_NUMBER; - if($self->copy->deposit_amount and $self->copy->deposit_amount > 0) { - $self->is_deposit(1) if $U->is_true($self->copy->deposit); - $self->is_rental(1) unless $U->is_true($self->copy->deposit); - } -} - -sub mk_env { - my $self = shift; - my $e = $self->editor; - - # -------------------------------------------------------------------------- - # Grab the fleshed copy - # -------------------------------------------------------------------------- - unless($self->is_noncat) { - my $copy; - if($self->copy_id) { - $copy = $e->retrieve_asset_copy( - [$self->copy_id, $MK_ENV_FLESH ]) or return $e->event; - - } elsif( $self->copy_barcode ) { - - $copy = $e->search_asset_copy( - [{barcode => $self->copy_barcode, deleted => 'f'}, $MK_ENV_FLESH ])->[0]; - } elsif( $self->reservation ) { - my $res = $e->json_query( - { - "select" => {"acp" => ["id"]}, - "from" => { - "acp" => { - "brsrc" => { - "fkey" => "barcode", - "field" => "barcode", - "join" => { - "bresv" => { - "fkey" => "id", - "field" => "current_resource" - } - } - } - } - }, - "where" => { - "+bresv" => { - "id" => (ref $self->reservation) ? - $self->reservation->id : $self->reservation - } - } - } - ); - if (ref $res eq "ARRAY" and scalar @$res) { - $logger->info("circulator: mapped reservation " . - $self->reservation . " to copy " . $res->[0]->{"id"}); - $copy = $e->retrieve_asset_copy([$res->[0]->{"id"}, $MK_ENV_FLESH]); - } - } - - if($copy) { - $self->save_trimmed_copy($copy); - } else { - # We can't renew if there is no copy - return $self->bail_on_events(OpenILS::Event->new('ASSET_COPY_NOT_FOUND')) - if $self->is_renewal; - $self->is_precat(1); - } - } - - # -------------------------------------------------------------------------- - # Grab the patron - # -------------------------------------------------------------------------- - my $patron; - my $flesh = { - flesh => 1, - flesh_fields => {au => [ qw/ card / ]} - }; - - if( $self->patron_id ) { - $patron = $e->retrieve_actor_user([$self->patron_id, $flesh]) - or return $self->bail_on_events(OpenILS::Event->new('ACTOR_USER_NOT_FOUND')); - - } elsif( $self->patron_barcode ) { - - # note: throwing ACTOR_USER_NOT_FOUND instead of ACTOR_CARD_NOT_FOUND is intentional - my $card = $e->search_actor_card({barcode => $self->patron_barcode})->[0] - or return $self->bail_on_events(OpenILS::Event->new('ACTOR_USER_NOT_FOUND')); - - $patron = $e->search_actor_user([{card => $card->id}, $flesh])->[0] - or return $self->bail_on_events(OpenILS::Event->new('ACTOR_USER_NOT_FOUND')); - - } else { - if( my $copy = $self->copy ) { - - $flesh->{flesh} = 2; - $flesh->{flesh_fields}->{circ} = ['usr']; - - my $circ = $e->search_action_circulation([ - {target_copy => $copy->id, checkin_time => undef}, $flesh - ])->[0]; - - if($circ) { - $patron = $circ->usr; - $circ->usr($patron->id); # de-flesh for consistency - $self->circ($circ); - } - } - } - - return $self->bail_on_events(OpenILS::Event->new('ACTOR_USER_NOT_FOUND')) - unless $self->patron($patron) or $self->is_checkin; - - unless($self->is_checkin) { - - # Check for inactivity and patron reg. expiration - - $self->bail_on_events(OpenILS::Event->new('PATRON_INACTIVE')) - unless $U->is_true($patron->active); - - $self->bail_on_events(OpenILS::Event->new('PATRON_CARD_INACTIVE')) - unless $U->is_true($patron->card->active); - - my $expire = DateTime::Format::ISO8601->new->parse_datetime( - cleanse_ISO8601($patron->expire_date)); - - $self->bail_on_events(OpenILS::Event->new('PATRON_ACCOUNT_EXPIRED')) - if( CORE::time > $expire->epoch ) ; - } -} - -# -------------------------------------------------------------------------- -# This builds the script runner environment and fetches most of the -# objects we need -# -------------------------------------------------------------------------- -sub mk_script_runner { - my $self = shift; - my $args = {}; - - - my @fields = - qw/copy copy_barcode copy_id patron - patron_id patron_barcode volume title editor/; - - # Translate our objects into the ScriptBuilder args hash - $$args{$_} = $self->$_() for @fields; - - $args->{ignore_user_status} = 1 if $self->is_checkin; - $$args{fetch_patron_by_circ_copy} = 1; - $$args{fetch_patron_circ_info} = 1 unless $self->is_checkin; - - if( my $pco = $self->pending_checkouts ) { - $logger->info("circulator: we were given a pending checkouts number of $pco"); - $$args{patronItemsOut} = $pco; - } - - # This fetches most of the objects we need - $self->script_runner( - OpenILS::Application::Circ::ScriptBuilder->build($args)); - - # Now we translate the ScriptBuilder objects back into self - $self->$_($$args{$_}) for @fields; - - my @evts = @{$args->{_events}} if $args->{_events}; - - $logger->debug("circulator: script builder returned events: @evts") if @evts; - - - if(@evts) { - # Anything besides ASSET_COPY_NOT_FOUND will stop processing - if(!$self->is_noncat and - @evts == 1 and - $evts[0]->{textcode} eq 'ASSET_COPY_NOT_FOUND') { - $self->is_precat(1); - - } else { - my @e = grep { $_->{textcode} ne 'ASSET_COPY_NOT_FOUND' } @evts; - return $self->bail_on_events(@e); - } - } - - if($self->copy) { - $self->is_precat(1) if $self->copy->call_number == OILS_PRECAT_CALL_NUMBER; - if($self->copy->deposit_amount and $self->copy->deposit_amount > 0) { - $self->is_deposit(1) if $U->is_true($self->copy->deposit); - $self->is_rental(1) unless $U->is_true($self->copy->deposit); - } - } - - # We can't renew if there is no copy - return $self->bail_on_events(@evts) if - $self->is_renewal and !$self->copy; - - # Set some circ-specific flags in the script environment - my $evt = "environment"; - $self->script_runner->insert("$evt.isRenewal", ($self->is_renewal) ? 1 : undef); - - if( $self->is_noncat ) { - $self->script_runner->insert("$evt.isNonCat", 1); - $self->script_runner->insert("$evt.nonCatType", $self->noncat_type); - } - - if( $self->is_precat ) { - $self->script_runner->insert("environment.isPrecat", 1, 1); - } - - $self->script_runner->add_path( $_ ) for @$script_libs; - - return 1; -} - -# -------------------------------------------------------------------------- -# Does the circ permit work -# -------------------------------------------------------------------------- -sub do_permit { - my $self = shift; - - $self->log_me("do_permit()"); - - unless( $self->editor->requestor->id == $self->patron->id ) { - return $self->bail_on_events($self->editor->event) - unless( $self->editor->allowed('VIEW_PERMIT_CHECKOUT') ); - } - - $self->check_captured_holds(); - $self->do_copy_checks(); - return if $self->bail_out; - $self->run_patron_permit_scripts(); - $self->run_copy_permit_scripts() - unless $self->is_precat or $self->is_noncat; - $self->check_item_deposit_events(); - $self->override_events(); - return if $self->bail_out; - - if($self->is_precat and not $self->request_precat) { - $self->push_events( - OpenILS::Event->new( - 'ITEM_NOT_CATALOGED', payload => $self->mk_permit_key)); - return $self->bail_out(1) unless $self->is_renewal; - } - - $self->push_events( - OpenILS::Event->new('SUCCESS', payload => $self->mk_permit_key)); -} - -sub check_item_deposit_events { - my $self = shift; - $self->push_events(OpenILS::Event->new('ITEM_DEPOSIT_REQUIRED', payload => $self->copy)) - if $self->is_deposit and not $self->is_deposit_exempt; - $self->push_events(OpenILS::Event->new('ITEM_RENTAL_FEE_REQUIRED', payload => $self->copy)) - if $self->is_rental and not $self->is_rental_exempt; -} - -# returns true if the user is not required to pay deposits -sub is_deposit_exempt { - my $self = shift; - my $pid = (ref $self->patron->profile) ? - $self->patron->profile->id : $self->patron->profile; - my $groups = $U->ou_ancestor_setting_value( - $self->circ_lib, 'circ.deposit.exempt_groups', $self->editor); - for my $grp (@$groups) { - return 1 if $self->is_group_descendant($grp, $pid); - } - return 0; -} - -# returns true if the user is not required to pay rental fees -sub is_rental_exempt { - my $self = shift; - my $pid = (ref $self->patron->profile) ? - $self->patron->profile->id : $self->patron->profile; - my $groups = $U->ou_ancestor_setting_value( - $self->circ_lib, 'circ.rental.exempt_groups', $self->editor); - for my $grp (@$groups) { - return 1 if $self->is_group_descendant($grp, $pid); - } - return 0; -} - -sub is_group_descendant { - my($self, $p_id, $c_id) = @_; - return 0 unless defined $p_id and defined $c_id; - return 1 if $c_id == $p_id; - while(my $grp = $user_groups{$c_id}) { - $c_id = $grp->parent; - return 0 unless defined $c_id; - return 1 if $c_id == $p_id; - } - return 0; -} - -sub check_captured_holds { - my $self = shift; - my $copy = $self->copy; - my $patron = $self->patron; - - return undef unless $copy; - - my $s = $U->copy_status($copy->status)->id; - return unless $s == OILS_COPY_STATUS_ON_HOLDS_SHELF; - $logger->info("circulator: copy is on holds shelf, searching for the correct hold"); - - # Item is on the holds shelf, make sure it's going to the right person - my $holds = $self->editor->search_action_hold_request( - [ - { - current_copy => $copy->id , - capture_time => { '!=' => undef }, - cancel_time => undef, - fulfillment_time => undef - }, - { limit => 1 } - ] - ); - - if( $holds and $$holds[0] ) { - return undef if $$holds[0]->usr == $patron->id; - } - - $logger->info("circulator: this copy is needed by a different patron to fulfill a hold"); - - $self->push_events(OpenILS::Event->new('ITEM_ON_HOLDS_SHELF')); -} - - -sub do_copy_checks { - my $self = shift; - my $copy = $self->copy; - return unless $copy; - - my $stat = $U->copy_status($copy->status)->id; - - # We cannot check out a copy if it is in-transit - if( $stat == OILS_COPY_STATUS_IN_TRANSIT ) { - return $self->bail_on_events(OpenILS::Event->new('COPY_IN_TRANSIT')); - } - - $self->handle_claims_returned(); - return if $self->bail_out; - - # no claims returned circ was found, check if there is any open circ - unless( $self->is_renewal ) { - - my $circs = $self->editor->search_action_circulation( - { target_copy => $copy->id, checkin_time => undef } - ); - - if(my $old_circ = $circs->[0]) { # an open circ was found - - my $payload = {copy => $copy}; - - if($old_circ->usr == $self->patron->id) { - - $payload->{old_circ} = $old_circ; - - # If there is an open circulation on the checkout item and an auto-renew - # interval is defined, inform the caller that they should go - # ahead and renew the item instead of warning about open circulations. - - my $auto_renew_intvl = $U->ou_ancestor_setting_value( - $self->circ_lib, - 'circ.checkout_auto_renew_age', - $self->editor - ); - - if($auto_renew_intvl) { - my $intvl_seconds = OpenSRF::Utils->interval_to_seconds($auto_renew_intvl); - my $checkout_time = DateTime::Format::ISO8601->new->parse_datetime( cleanse_ISO8601($old_circ->xact_start) ); - - if(DateTime->now > $checkout_time->add(seconds => $intvl_seconds)) { - $payload->{auto_renew} = 1; - } - } - } - - return $self->bail_on_events( - OpenILS::Event->new('OPEN_CIRCULATION_EXISTS', payload => $payload) - ); - } - } -} - -my $LEGACY_CIRC_EVENT_MAP = { - 'no_item' => 'ITEM_NOT_CATALOGED', - 'actor.usr.barred' => 'PATRON_BARRED', - 'asset.copy.circulate' => 'COPY_CIRC_NOT_ALLOWED', - 'asset.copy.status' => 'COPY_NOT_AVAILABLE', - 'asset.copy_location.circulate' => 'COPY_CIRC_NOT_ALLOWED', - 'config.circ_matrix_test.circulate' => 'COPY_CIRC_NOT_ALLOWED', - 'config.circ_matrix_test.max_items_out' => 'PATRON_EXCEEDS_CHECKOUT_COUNT', - 'config.circ_matrix_test.max_overdue' => 'PATRON_EXCEEDS_OVERDUE_COUNT', - 'config.circ_matrix_test.max_fines' => 'PATRON_EXCEEDS_FINES', - 'config.circ_matrix_circ_mod_test' => 'PATRON_EXCEEDS_CHECKOUT_COUNT', -}; - - -# --------------------------------------------------------------------- -# This pushes any patron-related events into the list but does not -# set bail_out for any events -# --------------------------------------------------------------------- -sub run_patron_permit_scripts { - my $self = shift; - my $runner = $self->script_runner; - my $patronid = $self->patron->id; - - my @allevents; - - if(!$self->legacy_script_support) { - - my $results = $self->run_indb_circ_test; - unless($self->circ_test_success) { - # no_item result is OK during noncat checkout - unless(@$results == 1 && $results->[0]->{fail_part} eq 'no_item' and $self->is_noncat) { - push @allevents, $self->matrix_test_result_events; - } - } - - } else { - - # --------------------------------------------------------------------- - # # Now run the patron permit script - # --------------------------------------------------------------------- - $runner->load($self->circ_permit_patron); - my $result = $runner->run or - throw OpenSRF::EX::ERROR ("Circ Permit Patron Script Died: $@"); - - my $patron_events = $result->{events}; - - OpenILS::Utils::Penalty->calculate_penalties($self->editor, $self->patron->id, $self->circ_lib); - my $mask = ($self->is_renewal) ? 'RENEW' : 'CIRC'; - my $penalties = OpenILS::Utils::Penalty->retrieve_penalties($self->editor, $patronid, $self->circ_lib, $mask); - $penalties = $penalties->{fatal_penalties}; - - for my $pen (@$penalties) { - my $event = OpenILS::Event->new($pen->name); - $event->{desc} = $pen->label; - push(@allevents, $event); - } - - push(@allevents, OpenILS::Event->new($_)) for (@$patron_events); - } - - for (@allevents) { - $_->{payload} = $self->copy if - ($_->{textcode} eq 'COPY_NOT_AVAILABLE'); - } - - $logger->info("circulator: permit_patron script returned events: @allevents") if @allevents; - - $self->push_events(@allevents); -} - -sub matrix_test_result_codes { - my $self = shift; - map { $_->{"fail_part"} } @{$self->matrix_test_result}; -} - -sub matrix_test_result_events { - my $self = shift; - map { - my $event = new OpenILS::Event( - $LEGACY_CIRC_EVENT_MAP->{$_->{"fail_part"}} || $_->{"fail_part"} - ); - $event->{"payload"} = {"fail_part" => $_->{"fail_part"}}; - $event; - } (@{$self->matrix_test_result}); -} - -sub run_indb_circ_test { - my $self = shift; - return $self->matrix_test_result if $self->matrix_test_result; - - my $dbfunc = ($self->is_renewal) ? - 'action.item_user_renew_test' : 'action.item_user_circ_test'; - - if( $self->is_precat && $self->request_precat) { - $self->make_precat_copy; - return if $self->bail_out; - } - - my $results = $self->editor->json_query( - { from => [ - $dbfunc, - $self->circ_lib, - ($self->is_noncat or ($self->is_precat and !$self->override and !$self->is_renewal)) ? undef : $self->copy->id, - $self->patron->id, - ] - } - ); - - $self->circ_test_success($U->is_true($results->[0]->{success})); - - if(my $mp = $results->[0]->{matchpoint}) { - $logger->info("circulator: circ policy test found matchpoint $mp"); - $self->circ_matrix_matchpoint( - $self->editor->retrieve_config_circ_matrix_matchpoint([ - $mp, - { flesh => 1, - flesh_fields => {ccmm => - ['duration_rule', 'recurring_fine_rule', 'max_fine_rule', 'hard_due_date']} - } - ]) - ); - } - - return $self->matrix_test_result($results); -} - -# --------------------------------------------------------------------- -# given a use and copy, this will calculate the circulation policy -# parameters. Only works with in-db circ. -# --------------------------------------------------------------------- -sub do_inspect { - my $self = shift; - - return OpenILS::Event->new('ASSET_COPY_NOT_FOUND') unless $self->copy; - - $self->run_indb_circ_test; - - my $results = { - circ_test_success => $self->circ_test_success, - failure_events => [], - failure_codes => [], - matchpoint => $self->circ_matrix_matchpoint - }; - - unless($self->circ_test_success) { - $results->{"failure_codes"} = [ $self->matrix_test_result_codes ]; - $results->{"failure_events"} = [ $self->matrix_test_result_events ]; - } - - if($self->circ_matrix_matchpoint) { - my $duration_rule = $self->circ_matrix_matchpoint->duration_rule; - my $recurring_fine_rule = $self->circ_matrix_matchpoint->recurring_fine_rule; - my $max_fine_rule = $self->circ_matrix_matchpoint->max_fine_rule; - my $hard_due_date = $self->circ_matrix_matchpoint->hard_due_date; - - my $policy = $self->get_circ_policy( - $duration_rule, $recurring_fine_rule, $max_fine_rule, $hard_due_date); - - $$results{$_} = $$policy{$_} for keys %$policy; - } - - return $results; -} - -# --------------------------------------------------------------------- -# Loads the circ policy info for duration, recurring fine, and max -# fine based on the current copy -# --------------------------------------------------------------------- -sub get_circ_policy { - my($self, $duration_rule, $recurring_fine_rule, $max_fine_rule, $hard_due_date) = @_; - - my $policy = { - duration_rule => $duration_rule->name, - recurring_fine_rule => $recurring_fine_rule->name, - max_fine_rule => $max_fine_rule->name, - max_fine => $self->get_max_fine_amount($max_fine_rule), - fine_interval => $recurring_fine_rule->recurrence_interval, - renewal_remaining => $duration_rule->max_renewals - }; - - if($hard_due_date) { - $policy->{duration_date_ceiling} = $hard_due_date->ceiling_date; - $policy->{duration_date_ceiling_force} = $hard_due_date->forceto; - } - else { - $policy->{duration_date_ceiling} = undef; - $policy->{duration_date_ceiling_force} = undef; - } - - $policy->{duration} = $duration_rule->shrt - if $self->copy->loan_duration == OILS_CIRC_DURATION_SHORT; - $policy->{duration} = $duration_rule->normal - if $self->copy->loan_duration == OILS_CIRC_DURATION_NORMAL; - $policy->{duration} = $duration_rule->extended - if $self->copy->loan_duration == OILS_CIRC_DURATION_EXTENDED; - - $policy->{recurring_fine} = $recurring_fine_rule->low - if $self->copy->fine_level == OILS_REC_FINE_LEVEL_LOW; - $policy->{recurring_fine} = $recurring_fine_rule->normal - if $self->copy->fine_level == OILS_REC_FINE_LEVEL_NORMAL; - $policy->{recurring_fine} = $recurring_fine_rule->high - if $self->copy->fine_level == OILS_REC_FINE_LEVEL_HIGH; - - return $policy; -} - -sub get_max_fine_amount { - my $self = shift; - my $max_fine_rule = shift; - my $max_amount = $max_fine_rule->amount; - - # if is_percent is true then the max->amount is - # use as a percentage of the copy price - if ($U->is_true($max_fine_rule->is_percent)) { - my $price = $U->get_copy_price($self->editor, $self->copy, $self->volume); - $max_amount = $price * $max_fine_rule->amount / 100; - } elsif ( - $U->ou_ancestor_setting_value( - $self->circ_lib, - 'circ.max_fine.cap_at_price', - $self->editor - ) - ) { - my $price = $U->get_copy_price($self->editor, $self->copy, $self->volume); - $max_amount = ( $price && $max_amount > $price ) ? $price : $max_amount; - } - - return $max_amount; -} - - - -sub run_copy_permit_scripts { - my $self = shift; - my $copy = $self->copy || return; - my $runner = $self->script_runner; - - my @allevents; - - if(!$self->legacy_script_support) { - my $results = $self->run_indb_circ_test; - push @allevents, $self->matrix_test_result_events - unless $self->circ_test_success; - } else { - - # --------------------------------------------------------------------- - # Capture all of the copy permit events - # --------------------------------------------------------------------- - $runner->load($self->circ_permit_copy); - my $result = $runner->run or - throw OpenSRF::EX::ERROR ("Circ Permit Copy Script Died: $@"); - my $copy_events = $result->{events}; - - # --------------------------------------------------------------------- - # Now collect all of the events together - # --------------------------------------------------------------------- - push( @allevents, OpenILS::Event->new($_)) for @$copy_events; - } - - # See if this copy has an alert message - my $ae = $self->check_copy_alert(); - push( @allevents, $ae ) if $ae; - - # uniquify the events - my %hash = map { ($_->{ilsevent} => $_) } @allevents; - @allevents = values %hash; - - $logger->info("circulator: permit_copy script returned events: @allevents") if @allevents; - - $self->push_events(@allevents); -} - - -sub check_copy_alert { - my $self = shift; - return undef if $self->is_renewal; - return OpenILS::Event->new( - 'COPY_ALERT_MESSAGE', payload => $self->copy->alert_message) - if $self->copy and $self->copy->alert_message; - return undef; -} - - - -# -------------------------------------------------------------------------- -# If the call is overriding and has permissions to override every collected -# event, the are cleared. Any event that the caller does not have -# permission to override, will be left in the event list and bail_out will -# be set -# XXX We need code in here to cancel any holds/transits on copies -# that are being force-checked out -# -------------------------------------------------------------------------- -sub override_events { - my $self = shift; - my @events = @{$self->events}; - return unless @events; - - if(!$self->override) { - return $self->bail_out(1) - if( @events > 1 or $events[0]->{textcode} ne 'SUCCESS' ); - } - - $self->events([]); - - for my $e (@events) { - my $tc = $e->{textcode}; - next if $tc eq 'SUCCESS'; - my $ov = "$tc.override"; - $logger->info("circulator: attempting to override event: $ov"); - - return $self->bail_on_events($self->editor->event) - unless( $self->editor->allowed($ov) ); - } -} - - -# -------------------------------------------------------------------------- -# If there is an open claimsreturn circ on the requested copy, close the -# circ if overriding, otherwise bail out -# -------------------------------------------------------------------------- -sub handle_claims_returned { - my $self = shift; - my $copy = $self->copy; - - my $CR = $self->editor->search_action_circulation( - { - target_copy => $copy->id, - stop_fines => OILS_STOP_FINES_CLAIMSRETURNED, - checkin_time => undef, - } - ); - - return unless ($CR = $CR->[0]); - - my $evt; - - # - If the caller has set the override flag, we will check the item in - if($self->override) { - - $CR->checkin_time('now'); - $CR->checkin_scan_time('now'); - $CR->checkin_lib($self->circ_lib); - $CR->checkin_workstation($self->editor->requestor->wsid); - $CR->checkin_staff($self->editor->requestor->id); - - $evt = $self->editor->event - unless $self->editor->update_action_circulation($CR); - - } else { - $evt = OpenILS::Event->new('CIRC_CLAIMS_RETURNED'); - } - - $self->bail_on_events($evt) if $evt; - return; -} - - -# -------------------------------------------------------------------------- -# This performs the checkout -# -------------------------------------------------------------------------- -sub do_checkout { - my $self = shift; - - $self->log_me("do_checkout()"); - - # make sure perms are good if this isn't a renewal - unless( $self->is_renewal ) { - return $self->bail_on_events($self->editor->event) - unless( $self->editor->allowed('COPY_CHECKOUT') ); - } - - # verify the permit key - unless( $self->check_permit_key ) { - if( $self->permit_override ) { - return $self->bail_on_events($self->editor->event) - unless $self->editor->allowed('CIRC_PERMIT_OVERRIDE'); - } else { - return $self->bail_on_events(OpenILS::Event->new('CIRC_PERMIT_BAD_KEY')) - } - } - - # if this is a non-cataloged circ, build the circ and finish - if( $self->is_noncat ) { - $self->checkout_noncat; - $self->push_events( - OpenILS::Event->new('SUCCESS', - payload => { noncat_circ => $self->circ })); - return; - } - - if( $self->is_precat ) { - $self->make_precat_copy; - return if $self->bail_out; - - } elsif( $self->copy->call_number == OILS_PRECAT_CALL_NUMBER ) { - return $self->bail_on_events(OpenILS::Event->new('ITEM_NOT_CATALOGED')); - } - - $self->do_copy_checks; - return if $self->bail_out; - - $self->run_checkout_scripts(); - return if $self->bail_out; - - $self->build_checkout_circ_object(); - return if $self->bail_out; - - my $modify_to_start = $self->booking_adjusted_due_date(); - return if $self->bail_out; - - $self->apply_modified_due_date($modify_to_start); - return if $self->bail_out; - - return $self->bail_on_events($self->editor->event) - unless $self->editor->create_action_circulation($self->circ); - - # refresh the circ to force local time zone for now - $self->circ($self->editor->retrieve_action_circulation($self->circ->id)); - - $self->copy->status(OILS_COPY_STATUS_CHECKED_OUT); - $self->update_copy; - return if $self->bail_out; - - $self->apply_deposit_fee(); - return if $self->bail_out; - - $self->handle_checkout_holds(); - return if $self->bail_out; - - # ------------------------------------------------------------------------------ - # Update the patron penalty info in the DB. Run it for permit-overrides - # since the penalties are not updated during the permit phase - # ------------------------------------------------------------------------------ - OpenILS::Utils::Penalty->calculate_penalties($self->editor, $self->patron->id, $self->circ_lib); - - my $record = $U->record_to_mvr($self->title) unless $self->is_precat; - - my $pcirc; - if($self->is_renewal) { - # flesh the billing summary for the checked-in circ - $pcirc = $self->editor->retrieve_action_circulation([ - $self->parent_circ, - {flesh => 2, flesh_fields => {circ => ['billable_transaction'], mbt => ['summary']}} - ]); - } - - $self->push_events( - OpenILS::Event->new('SUCCESS', - payload => { - copy => $U->unflesh_copy($self->copy), - circ => $self->circ, - record => $record, - holds_fulfilled => $self->fulfilled_holds, - deposit_billing => $self->deposit_billing, - rental_billing => $self->rental_billing, - parent_circ => $pcirc, - patron => ($self->return_patron) ? $self->patron : undef, - patron_money => $self->editor->retrieve_money_user_summary($self->patron->id) - } - ) - ); -} - -sub apply_deposit_fee { - my $self = shift; - my $copy = $self->copy; - return unless - ($self->is_deposit and not $self->is_deposit_exempt) or - ($self->is_rental and not $self->is_rental_exempt); - - return if $self->is_deposit and $self->skip_deposit_fee; - return if $self->is_rental and $self->skip_rental_fee; - - my $bill = Fieldmapper::money::billing->new; - my $amount = $copy->deposit_amount; - my $billing_type; - my $btype; - - if($self->is_deposit) { - $billing_type = OILS_BILLING_TYPE_DEPOSIT; - $btype = 5; - $self->deposit_billing($bill); - } else { - $billing_type = OILS_BILLING_TYPE_RENTAL; - $btype = 6; - $self->rental_billing($bill); - } - - $bill->xact($self->circ->id); - $bill->amount($amount); - $bill->note(OILS_BILLING_NOTE_SYSTEM); - $bill->billing_type($billing_type); - $bill->btype($btype); - $self->editor->create_money_billing($bill) or $self->bail_on_events($self->editor->event); - - $logger->info("circulator: charged $amount on checkout with billing type $billing_type"); -} - -sub update_copy { - my $self = shift; - my $copy = $self->copy; - - my $stat = $copy->status if ref $copy->status; - my $loc = $copy->location if ref $copy->location; - my $circ_lib = $copy->circ_lib if ref $copy->circ_lib; - - $copy->status($stat->id) if $stat; - $copy->location($loc->id) if $loc; - $copy->circ_lib($circ_lib->id) if $circ_lib; - $copy->editor($self->editor->requestor->id); - $copy->edit_date('now'); - $copy->age_protect($copy->age_protect->id) if ref $copy->age_protect; - - return $self->bail_on_events($self->editor->event) - unless $self->editor->update_asset_copy($self->copy); - - $copy->status($U->copy_status($copy->status)); - $copy->location($loc) if $loc; - $copy->circ_lib($circ_lib) if $circ_lib; -} - -sub update_reservation { - my $self = shift; - my $reservation = $self->reservation; - - my $usr = $reservation->usr; - my $target_rt = $reservation->target_resource_type; - my $target_r = $reservation->target_resource; - my $current_r = $reservation->current_resource; - - $reservation->usr($usr->id) if ref $usr; - $reservation->target_resource_type($target_rt->id) if ref $target_rt; - $reservation->target_resource($target_r->id) if ref $target_r; - $reservation->current_resource($current_r->id) if ref $current_r; - - return $self->bail_on_events($self->editor->event) - unless $self->editor->update_booking_reservation($self->reservation); - - my $evt; - ($reservation, $evt) = $U->fetch_booking_reservation($reservation->id); - $self->reservation($reservation); -} - - -sub bail_on_events { - my( $self, @evts ) = @_; - $self->push_events(@evts); - $self->bail_out(1); -} - - -# ------------------------------------------------------------------------------ -# When an item is checked out, see if we can fulfill a hold for this patron -# ------------------------------------------------------------------------------ -sub handle_checkout_holds { - my $self = shift; - my $copy = $self->copy; - my $patron = $self->patron; - - my $e = $self->editor; - $self->fulfilled_holds([]); - - # pre/non-cats can't fulfill a hold - return if $self->is_precat or $self->is_noncat; - - my $hold = $e->search_action_hold_request({ - current_copy => $copy->id , - cancel_time => undef, - fulfillment_time => undef, - '-or' => [ - {expire_time => undef}, - {expire_time => {'>' => 'now'}} - ] - })->[0]; - - if($hold and $hold->usr != $patron->id) { - # reset the hold since the copy is now checked out - - $logger->info("circulator: un-targeting hold ".$hold->id. - " because copy ".$copy->id." is getting checked out"); - - $hold->clear_prev_check_time; - $hold->clear_current_copy; - $hold->clear_capture_time; - - return $self->bail_on_event($e->event) - unless $e->update_action_hold_request($hold); - - $hold = undef; - } - - unless($hold) { - $hold = $self->find_related_user_hold($copy, $patron) or return; - $logger->info("circulator: found related hold to fulfill in checkout"); - } - - $logger->debug("circulator: checkout fulfilling hold " . $hold->id); - - # if the hold was never officially captured, capture it. - $hold->current_copy($copy->id); - $hold->capture_time('now') unless $hold->capture_time; - $hold->fulfillment_time('now'); - $hold->fulfillment_staff($e->requestor->id); - $hold->fulfillment_lib($self->circ_lib); - - return $self->bail_on_events($e->event) - unless $e->update_action_hold_request($hold); - - $holdcode->delete_hold_copy_maps($e, $hold->id); - return $self->fulfilled_holds([$hold->id]); -} - - -# ------------------------------------------------------------------------------ -# If the circ.checkout_fill_related_hold setting is turned on and no hold for -# the patron directly targets the checked out item, see if there is another hold -# (with hold_type T or V) for the patron that could be fulfilled by the checked -# out item. Fulfill the oldest hold and only fulfill 1 of them. -# ------------------------------------------------------------------------------ -sub find_related_user_hold { - my($self, $copy, $patron) = @_; - my $e = $self->editor; - - return undef if $self->volume->id == OILS_PRECAT_CALL_NUMBER; - - return undef unless $U->ou_ancestor_setting_value( - $self->circ_lib, 'circ.checkout_fills_related_hold', $e); - - # find the oldest unfulfilled hold that has not yet hit the holds shelf. - my $args = { - select => {ahr => ['id']}, - from => { - ahr => { - acp => { - field => 'id', - fkey => 'current_copy', - type => 'left' # there may be no current_copy - } - } - }, - where => { - '+ahr' => { - usr => $patron->id, - fulfillment_time => undef, - cancel_time => undef, - '-or' => [ - {expire_time => undef}, - {expire_time => {'>' => 'now'}} - ] - }, - '-or' => [ - { - '+ahr' => { - hold_type => 'V', - target => $self->volume->id - } - }, - { - '+ahr' => { - hold_type => 'T', - target => $self->title->id - } - }, - ], - '+acp' => { - '-or' => [ - {id => undef}, # left-join copy may be nonexistent - {status => {'!=' => OILS_COPY_STATUS_ON_HOLDS_SHELF}}, - ] - } - }, - order_by => {ahr => {request_time => {direction => 'asc'}}}, - limit => 1 - }; - - my $hold_info = $e->json_query($args)->[0]; - return $e->retrieve_action_hold_request($hold_info->{id}) if $hold_info; - return undef; -} - - -sub run_checkout_scripts { - my $self = shift; - my $nobail = shift; - - my $evt; - my $runner = $self->script_runner; - - my $duration; - my $recurring; - my $max_fine; - my $hard_due_date; - my $duration_name; - my $recurring_name; - my $max_fine_name; - my $hard_due_date_name; - - if(!$self->legacy_script_support) { - $self->run_indb_circ_test(); - $duration = $self->circ_matrix_matchpoint->duration_rule; - $recurring = $self->circ_matrix_matchpoint->recurring_fine_rule; - $max_fine = $self->circ_matrix_matchpoint->max_fine_rule; - $hard_due_date = $self->circ_matrix_matchpoint->hard_due_date; - - } else { - - $runner->load($self->circ_duration); - - my $result = $runner->run or - throw OpenSRF::EX::ERROR ("Circ Duration Script Died: $@"); - - $duration_name = $result->{durationRule}; - $recurring_name = $result->{recurringFinesRule}; - $max_fine_name = $result->{maxFine}; - $hard_due_date_name = $result->{hardDueDate}; - } - - $duration_name = $duration->name if $duration; - if( $duration_name ne OILS_UNLIMITED_CIRC_DURATION ) { - - unless($duration) { - ($duration, $evt) = $U->fetch_circ_duration_by_name($duration_name); - return $self->bail_on_events($evt) if ($evt && !$nobail); - - ($recurring, $evt) = $U->fetch_recurring_fine_by_name($recurring_name); - return $self->bail_on_events($evt) if ($evt && !$nobail); - - ($max_fine, $evt) = $U->fetch_max_fine_by_name($max_fine_name); - return $self->bail_on_events($evt) if ($evt && !$nobail); - - if($hard_due_date_name) { - ($hard_due_date, $evt) = $U->fetch_hard_due_date_by_name($hard_due_date_name); - return $self->bail_on_events($evt) if ($evt && !$nobail); - } - } - - } else { - - # The item circulates with an unlimited duration - $duration = undef; - $recurring = undef; - $max_fine = undef; - $hard_due_date = undef; - } - - $self->duration_rule($duration); - $self->recurring_fines_rule($recurring); - $self->max_fine_rule($max_fine); - $self->hard_due_date($hard_due_date); -} - - -sub build_checkout_circ_object { - my $self = shift; - - my $circ = Fieldmapper::action::circulation->new; - my $duration = $self->duration_rule; - my $max = $self->max_fine_rule; - my $recurring = $self->recurring_fines_rule; - my $hard_due_date = $self->hard_due_date; - my $copy = $self->copy; - my $patron = $self->patron; - my $duration_date_ceiling; - my $duration_date_ceiling_force; - - if( $duration ) { - - my $policy = $self->get_circ_policy($duration, $recurring, $max, $hard_due_date); - $duration_date_ceiling = $policy->{duration_date_ceiling}; - $duration_date_ceiling_force = $policy->{duration_date_ceiling_force}; - - my $dname = $duration->name; - my $mname = $max->name; - my $rname = $recurring->name; - my $hdname = ''; - if($hard_due_date) { - $hdname = $hard_due_date->name; - } - - $logger->debug("circulator: building circulation ". - "with duration=$dname, maxfine=$mname, recurring=$rname, hard due date=$hdname"); - - $circ->duration($policy->{duration}); - $circ->recurring_fine($policy->{recurring_fine}); - $circ->duration_rule($duration->name); - $circ->recurring_fine_rule($recurring->name); - $circ->max_fine_rule($max->name); - $circ->max_fine($policy->{max_fine}); - $circ->fine_interval($recurring->recurrence_interval); - $circ->renewal_remaining($duration->max_renewals); - - } else { - - $logger->info("circulator: copy found with an unlimited circ duration"); - $circ->duration_rule(OILS_UNLIMITED_CIRC_DURATION); - $circ->recurring_fine_rule(OILS_UNLIMITED_CIRC_DURATION); - $circ->max_fine_rule(OILS_UNLIMITED_CIRC_DURATION); - $circ->renewal_remaining(0); - } - - $circ->target_copy( $copy->id ); - $circ->usr( $patron->id ); - $circ->circ_lib( $self->circ_lib ); - $circ->workstation($self->editor->requestor->wsid) - if defined $self->editor->requestor->wsid; - - # renewals maintain a link to the parent circulation - $circ->parent_circ($self->parent_circ); - - if( $self->is_renewal ) { - $circ->opac_renewal('t') if $self->opac_renewal; - $circ->phone_renewal('t') if $self->phone_renewal; - $circ->desk_renewal('t') if $self->desk_renewal; - $circ->renewal_remaining($self->renewal_remaining); - $circ->circ_staff($self->editor->requestor->id); - } - - - # if the user provided an overiding checkout time, - # (e.g. the checkout really happened several hours ago), then - # we apply that here. Does this need a perm?? - $circ->xact_start(cleanse_ISO8601($self->checkout_time)) - if $self->checkout_time; - - # if a patron is renewing, 'requestor' will be the patron - $circ->circ_staff($self->editor->requestor->id); - $circ->due_date( $self->create_due_date($circ->duration, $duration_date_ceiling, $duration_date_ceiling_force) ) if $circ->duration; - - $self->circ($circ); -} - -sub do_reservation_pickup { - my $self = shift; - - $self->log_me("do_reservation_pickup()"); - - $self->reservation->pickup_time('now'); - - if ( - $self->reservation->current_resource && - $U->is_true($self->reservation->target_resource_type->catalog_item) - ) { - # We used to try to set $self->copy and $self->patron here, - # but that should already be done. - - $self->run_checkout_scripts(1); - - my $duration = $self->duration_rule; - my $max = $self->max_fine_rule; - my $recurring = $self->recurring_fines_rule; - - if ($duration && $max && $recurring) { - my $policy = $self->get_circ_policy($duration, $recurring, $max); - - my $dname = $duration->name; - my $mname = $max->name; - my $rname = $recurring->name; - - $logger->debug("circulator: updating reservation ". - "with duration=$dname, maxfine=$mname, recurring=$rname"); - - $self->reservation->fine_amount($policy->{recurring_fine}); - $self->reservation->max_fine($policy->{max_fine}); - $self->reservation->fine_interval($recurring->recurrence_interval); - } - - $self->copy->status(OILS_COPY_STATUS_CHECKED_OUT); - $self->update_copy(); - - } else { - $self->reservation->fine_amount( - $self->reservation->target_resource_type->fine_amount - ); - $self->reservation->max_fine( - $self->reservation->target_resource_type->max_fine - ); - $self->reservation->fine_interval( - $self->reservation->target_resource_type->fine_interval - ); - } - - $self->update_reservation(); -} - -sub do_reservation_return { - my $self = shift; - my $request = shift; - - $self->log_me("do_reservation_return()"); - - if (not ref $self->reservation) { - my ($reservation, $evt) = - $U->fetch_booking_reservation($self->reservation); - return $self->bail_on_events($evt) if $evt; - $self->reservation($reservation); - } - - $self->generate_fines(1); - $self->reservation->return_time('now'); - $self->update_reservation(); - $self->reshelve_copy if $self->copy; - - if ( $self->reservation->current_resource && $self->reservation->current_resource->catalog_item ) { - $self->copy( $self->reservation->current_resource->catalog_item ); - } -} - -sub booking_adjusted_due_date { - my $self = shift; - my $circ = $self->circ; - my $copy = $self->copy; - - return undef unless $self->use_booking; - - my $changed; - - if( $self->due_date ) { - - return $self->bail_on_events($self->editor->event) - unless $self->editor->allowed('CIRC_OVERRIDE_DUE_DATE', $self->circ_lib); - - $circ->due_date(cleanse_ISO8601($self->due_date)); - - } else { - - return unless $copy and $circ->due_date; - } - - my $booking_items = $self->editor->search_booking_resource( { barcode => $copy->barcode } ); - if (@$booking_items) { - my $booking_item = $booking_items->[0]; - my $resource_type = $self->editor->retrieve_booking_resource_type( $booking_item->type ); - - my $stop_circ_setting = $U->ou_ancestor_setting_value( $self->circ_lib, 'circ.booking_reservation.stop_circ', $self->editor ); - my $shorten_circ_setting = $resource_type->elbow_room || - $U->ou_ancestor_setting_value( $self->circ_lib, 'circ.booking_reservation.default_elbow_room', $self->editor ) || - '0 seconds'; - - my $booking_ses = OpenSRF::AppSession->create( 'open-ils.booking' ); - my $bookings = $booking_ses->request( - 'open-ils.booking.reservations.filtered_id_list', $self->editor->authtoken, - { resource => $booking_item->id, search_start => 'now', search_end => $circ->due_date, fields => { cancel_time => undef }} - )->gather(1); - $booking_ses->disconnect; - - my $dt_parser = DateTime::Format::ISO8601->new; - my $due_date = $dt_parser->parse_datetime( cleanse_ISO8601($circ->due_date) ); - - for my $bid (@$bookings) { - - my $booking = $self->editor->retrieve_booking_reservation( $bid ); - - my $booking_start = $dt_parser->parse_datetime( cleanse_ISO8601($booking->start_time) ); - my $booking_end = $dt_parser->parse_datetime( cleanse_ISO8601($booking->end_time) ); - - return $self->bail_on_events( OpenILS::Event->new('COPY_RESERVED') ) - if ($booking_start < DateTime->now); - - - if ($U->is_true($stop_circ_setting)) { - $self->bail_on_events( OpenILS::Event->new('COPY_RESERVED') ); - } else { - $due_date = $booking_start->subtract( seconds => interval_to_seconds($shorten_circ_setting) ); - $self->bail_on_events( OpenILS::Event->new('COPY_RESERVED') ) if ($due_date < DateTime->now); - } - - # We set the circ duration here only to affect the logic that will - # later (in a DB trigger) mangle the time part of the due date to - # 11:59pm. Having any circ duration that is not a whole number of - # days is enough to prevent the "correction." - my $new_circ_duration = $due_date->epoch - time; - $new_circ_duration++ if $new_circ_duration % 86400 == 0; - $circ->duration("$new_circ_duration seconds"); - - $circ->due_date(cleanse_ISO8601($due_date->strftime('%FT%T%z'))); - $changed = 1; - } - - return $self->bail_on_events($self->editor->event) - unless $self->editor->allowed('CIRC_OVERRIDE_DUE_DATE', $self->circ_lib); - } - - return $changed; -} - -sub apply_modified_due_date { - my $self = shift; - my $shift_earlier = shift; - my $circ = $self->circ; - my $copy = $self->copy; - - if( $self->due_date ) { - - return $self->bail_on_events($self->editor->event) - unless $self->editor->allowed('CIRC_OVERRIDE_DUE_DATE', $self->circ_lib); - - $circ->due_date(cleanse_ISO8601($self->due_date)); - - } else { - - # if the due_date lands on a day when the location is closed - return unless $copy and $circ->due_date; - - #my $org = (ref $copy->circ_lib) ? $copy->circ_lib->id : $copy->circ_lib; - - # due-date overlap should be determined by the location the item - # is checked out from, not the owning or circ lib of the item - my $org = $self->circ_lib; - - $logger->info("circulator: circ searching for closed date overlap on lib $org". - " with an item due date of ".$circ->due_date ); - - my $dateinfo = $U->storagereq( - 'open-ils.storage.actor.org_unit.closed_date.overlap', - $org, $circ->due_date ); - - if($dateinfo) { - $logger->info("circulator: $dateinfo : circ due data / close date overlap found : due_date=". - $circ->due_date." start=". $dateinfo->{start}.", end=".$dateinfo->{end}); - - # XXX make the behavior more dynamic - # for now, we just push the due date to after the close date - if ($shift_earlier) { - $circ->due_date($dateinfo->{start}); - } else { - $circ->due_date($dateinfo->{end}); - } - } - } -} - - - -sub create_due_date { - my( $self, $duration, $date_ceiling, $force_date ) = @_; - - # if there is a raw time component (e.g. from postgres), - # turn it into an interval that interval_to_seconds can parse - $duration =~ s/(\d{2}):(\d{2}):(\d{2})/$1 h $2 m $3 s/o; - - # for now, use the server timezone. TODO: use workstation org timezone - my $due_date = DateTime->now(time_zone => 'local'); - - # add the circ duration - $due_date->add(seconds => OpenSRF::Utils->interval_to_seconds($duration)); - - if($date_ceiling) { - my $cdate = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($date_ceiling)); - if ($cdate > DateTime->now and ($cdate < $due_date or $U->is_true( $force_date ))) { - $logger->info("circulator: overriding due date with date ceiling: $date_ceiling"); - $due_date = $cdate; - } - } - - # return ISO8601 time with timezone - return $due_date->strftime('%FT%T%z'); -} - - - -sub make_precat_copy { - my $self = shift; - my $copy = $self->copy; - - if($copy) { - $logger->debug("circulator: Pre-cat copy already exists in checkout: ID=" . $copy->id); - - $copy->editor($self->editor->requestor->id); - $copy->edit_date('now'); - $copy->dummy_title($self->dummy_title || $copy->dummy_title || ''); - $copy->dummy_isbn($self->dummy_isbn || $copy->dummy_isbn || ''); - $copy->dummy_author($self->dummy_author || $copy->dummy_author || ''); - $copy->circ_modifier($self->circ_modifier || $copy->circ_modifier); - $self->update_copy(); - return; - } - - $logger->info("circulator: Creating a new precataloged ". - "copy in checkout with barcode " . $self->copy_barcode); - - $copy = Fieldmapper::asset::copy->new; - $copy->circ_lib($self->circ_lib); - $copy->creator($self->editor->requestor->id); - $copy->editor($self->editor->requestor->id); - $copy->barcode($self->copy_barcode); - $copy->call_number(OILS_PRECAT_CALL_NUMBER); - $copy->loan_duration(OILS_PRECAT_COPY_LOAN_DURATION); - $copy->fine_level(OILS_PRECAT_COPY_FINE_LEVEL); - - $copy->dummy_title($self->dummy_title || ""); - $copy->dummy_author($self->dummy_author || ""); - $copy->dummy_isbn($self->dummy_isbn || ""); - $copy->circ_modifier($self->circ_modifier); - - - # See if we need to override the circ_lib for the copy with a configured circ_lib - # Setting is shortname of the org unit - my $precat_circ_lib = $U->ou_ancestor_setting_value( - $self->circ_lib, 'circ.pre_cat_copy_circ_lib', $self->editor); - - if($precat_circ_lib) { - my $org = $self->editor->search_actor_org_unit({shortname => $precat_circ_lib})->[0]; - - if(!$org) { - $self->bail_on_events($self->editor->event); - return; - } - - $copy->circ_lib($org->id); - } - - - unless( $self->copy($self->editor->create_asset_copy($copy)) ) { - $self->bail_out(1); - $self->push_events($self->editor->event); - return; - } - - # this is a little bit of a hack, but we need to - # get the copy into the script runner - $self->script_runner->insert("environment.copy", $copy, 1) if $self->script_runner; -} - - -sub checkout_noncat { - my $self = shift; - - my $circ; - my $evt; - - my $lib = $self->noncat_circ_lib || $self->circ_lib; - my $count = $self->noncat_count || 1; - my $cotime = cleanse_ISO8601($self->checkout_time) || ""; - - $logger->info("circulator: circ creating $count noncat circs with checkout time $cotime"); - - for(1..$count) { - - ( $circ, $evt ) = OpenILS::Application::Circ::NonCat::create_non_cat_circ( - $self->editor->requestor->id, - $self->patron->id, - $lib, - $self->noncat_type, - $cotime, - $self->editor ); - - if( $evt ) { - $self->push_events($evt); - $self->bail_out(1); - return; - } - $self->circ($circ); - } -} - - -sub do_checkin { - my $self = shift; - $self->log_me("do_checkin()"); - - return $self->bail_on_events( - OpenILS::Event->new('ASSET_COPY_NOT_FOUND')) - unless $self->copy; - - # the renew code and mk_env should have already found our circulation object - unless( $self->circ ) { - - my $circs = $self->editor->search_action_circulation( - { target_copy => $self->copy->id, checkin_time => undef }); - - $self->circ($$circs[0]); - - # for now, just warn if there are multiple open circs on a copy - $logger->warn("circulator: we have ".scalar(@$circs). - " open circs for copy " .$self->copy->id."!!") if @$circs > 1; - } - - # run the fine generator against this circ, if this circ is there - $self->generate_fines_start if $self->circ; - - - if( $self->checkin_check_holds_shelf() ) { - $self->bail_on_events(OpenILS::Event->new('NO_CHANGE')); - $self->hold($U->fetch_open_hold_by_copy($self->copy->id)); - $self->checkin_flesh_events; - return; - } - - unless( $self->is_renewal ) { - return $self->bail_on_events($self->editor->event) - unless $self->editor->allowed('COPY_CHECKIN'); - } - - $self->push_events($self->check_copy_alert()); - $self->push_events($self->check_checkin_copy_status()); - - # if the circ is marked as 'claims returned', add the event to the list - $self->push_events(OpenILS::Event->new('CIRC_CLAIMS_RETURNED')) - if ($self->circ and $self->circ->stop_fines - and $self->circ->stop_fines eq OILS_STOP_FINES_CLAIMSRETURNED); - - $self->check_circ_deposit(); - - # handle the overridable events - $self->override_events unless $self->is_renewal; - return if $self->bail_out; - - if( $self->copy ) { - $self->transit( - $self->editor->search_action_transit_copy( - { target_copy => $self->copy->id, dest_recv_time => undef } - )->[0] - ); - } - - if( $self->circ ) { - $self->checkin_handle_circ; - return if $self->bail_out; - $self->checkin_changed(1); - - } elsif( $self->transit ) { - my $hold_transit = $self->process_received_transit; - $self->checkin_changed(1); - - if( $self->bail_out ) { - $self->checkin_flesh_events; - return; - } - - if( my $e = $self->check_checkin_copy_status() ) { - # If the original copy status is special, alert the caller - my $ev = $self->events; - $self->events([$e]); - $self->override_events; - return if $self->bail_out; - $self->events($ev); - } - - if( $hold_transit or - $U->copy_status($self->copy->status)->id - == OILS_COPY_STATUS_ON_HOLDS_SHELF ) { - - my $hold; - if( $hold_transit ) { - $hold = $self->editor->retrieve_action_hold_request($hold_transit->hold); - } else { - ($hold) = $U->fetch_open_hold_by_copy($self->copy->id); - } - - $self->hold($hold); - - if( $hold and $hold->cancel_time ) { # this transited hold was cancelled mid-transit - - $logger->info("circulator: we received a transit on a cancelled hold " . $hold->id); - $self->reshelve_copy(1); - $self->cancelled_hold_transit(1); - $self->notify_hold(0); # don't notify for cancelled holds - return if $self->bail_out; - - } else { - - # hold transited to correct location - $self->checkin_flesh_events; - return; - } - } - - } elsif( $U->copy_status($self->copy->status)->id == OILS_COPY_STATUS_IN_TRANSIT ) { - - $logger->warn("circulator: we have a copy ".$self->copy->barcode. - " that is in-transit, but there is no transit.. repairing"); - $self->reshelve_copy(1); - return if $self->bail_out; - } - - if( $self->is_renewal ) { - $self->push_events(OpenILS::Event->new('SUCCESS')); - return; - } - - # ------------------------------------------------------------------------------ - # Circulations and transits are now closed where necessary. Now go on to see if - # this copy can fulfill a hold or needs to be routed to a different location - # ------------------------------------------------------------------------------ - - my $needed_for_something = 0; # formerly "needed_for_hold" - - if(!$self->noop) { # /not/ a no-op checkin, capture for hold or put item into transit - - if (!$self->remote_hold) { - if ($self->use_booking) { - my $potential_hold = $self->hold_capture_is_possible; - my $potential_reservation = $self->reservation_capture_is_possible; - - if ($potential_hold and $potential_reservation) { - $logger->info("circulator: item could fulfill either hold or reservation"); - $self->push_events(new OpenILS::Event( - "HOLD_RESERVATION_CONFLICT", - "hold" => $potential_hold, - "reservation" => $potential_reservation - )); - return if $self->bail_out; - } elsif ($potential_hold) { - $needed_for_something = - $self->attempt_checkin_hold_capture; - } elsif ($potential_reservation) { - $needed_for_something = - $self->attempt_checkin_reservation_capture; - } - } else { - $needed_for_something = $self->attempt_checkin_hold_capture; - } - } - return if $self->bail_out; - - unless($needed_for_something) { - my $circ_lib = (ref $self->copy->circ_lib) ? - $self->copy->circ_lib->id : $self->copy->circ_lib; - - if( $self->remote_hold ) { - $circ_lib = $self->remote_hold->pickup_lib; - $logger->warn("circulator: Copy ".$self->copy->barcode. - " is on a remote hold's shelf, sending to $circ_lib"); - } - - $logger->debug("circulator: circlib=$circ_lib, workstation=".$self->circ_lib); - - if( $circ_lib == $self->circ_lib) { - # copy is where it needs to be, either for hold or reshelving - - $self->checkin_handle_precat(); - return if $self->bail_out; - - } else { - # copy needs to transit "home", or stick here if it's a floating copy - - if ($U->is_true( $self->copy->floating ) && !$self->remote_hold) { # copy is floating, stick here - $self->checkin_changed(1); - $self->copy->circ_lib( $self->circ_lib ); - $self->update_copy; - } else { - my $bc = $self->copy->barcode; - $logger->info("circulator: copy $bc at the wrong location, sending to $circ_lib"); - $self->checkin_build_copy_transit($circ_lib); - return if $self->bail_out; - $self->push_events(OpenILS::Event->new('ROUTE_ITEM', org => $circ_lib)); - } - } - } - } else { # no-op checkin - if ($U->is_true( $self->copy->floating )) { # XXX floating items still stick where they are even with no-op checkin? - $self->checkin_changed(1); - $self->copy->circ_lib( $self->circ_lib ); - $self->update_copy; - } - } - - if($self->claims_never_checked_out and - $U->ou_ancestor_setting_value($self->circ->circ_lib, 'circ.claim_never_checked_out.mark_missing')) { - - # the item was not supposed to be checked out to the user and should now be marked as missing - $self->copy->status(OILS_COPY_STATUS_MISSING); - $self->update_copy; - - } else { - $self->reshelve_copy unless $needed_for_something; - } - - return if $self->bail_out; - - unless($self->checkin_changed) { - - $self->push_events(OpenILS::Event->new('NO_CHANGE')); - my $stat = $U->copy_status($self->copy->status)->id; - - $self->hold($U->fetch_open_hold_by_copy($self->copy->id)) - if( $stat == OILS_COPY_STATUS_ON_HOLDS_SHELF ); - $self->bail_out(1); # no need to commit anything - - } else { - - $self->push_events(OpenILS::Event->new('SUCCESS')) - unless @{$self->events}; - } - - # gather any updates to the circ after fine generation, if there was a circ - $self->generate_fines_finish if ($self->circ); - - OpenILS::Utils::Penalty->calculate_penalties( - $self->editor, $self->patron->id, $self->circ_lib) if $self->patron; - - $self->checkin_flesh_events; - return; -} - -# if a deposit was payed for this item, push the event -sub check_circ_deposit { - my $self = shift; - return unless $self->circ; - my $deposit = $self->editor->search_money_billing( - { btype => 5, - xact => $self->circ->id, - voided => 'f' - }, {idlist => 1})->[0]; - - $self->push_events(OpenILS::Event->new( - 'ITEM_DEPOSIT_PAID', payload => $deposit)) if $deposit; -} - -sub reshelve_copy { - my $self = shift; - my $force = $self->force || shift; - my $copy = $self->copy; - - my $stat = $U->copy_status($copy->status)->id; - - if($force || ( - $stat != OILS_COPY_STATUS_ON_HOLDS_SHELF and - $stat != OILS_COPY_STATUS_CATALOGING and - $stat != OILS_COPY_STATUS_IN_TRANSIT and - $stat != OILS_COPY_STATUS_RESHELVING )) { - - $copy->status( OILS_COPY_STATUS_RESHELVING ); - $self->update_copy; - $self->checkin_changed(1); - } -} - - -# Returns true if the item is at the current location -# because it was transited there for a hold and the -# hold has not been fulfilled -sub checkin_check_holds_shelf { - my $self = shift; - return 0 unless $self->copy; - - return 0 unless - $U->copy_status($self->copy->status)->id == - OILS_COPY_STATUS_ON_HOLDS_SHELF; - - # find the hold that put us on the holds shelf - my $holds = $self->editor->search_action_hold_request( - { - current_copy => $self->copy->id, - capture_time => { '!=' => undef }, - fulfillment_time => undef, - cancel_time => undef, - } - ); - - unless(@$holds) { - $logger->warn("circulator: copy is on-holds-shelf, but there is no hold - reshelving"); - $self->reshelve_copy(1); - return 0; - } - - my $hold = $$holds[0]; - - $logger->info("circulator: we found a captured, un-fulfilled hold [". - $hold->id. "] for copy ".$self->copy->barcode); - - if( $hold->pickup_lib == $self->circ_lib ) { - $logger->info("circulator: hold is for here .. we're done: ".$self->copy->barcode); - return 1; - } - - $logger->info("circulator: hold is not for here.."); - $self->remote_hold($hold); - return 0; -} - - -sub checkin_handle_precat { - my $self = shift; - my $copy = $self->copy; - - if( $self->is_precat and ($copy->status != OILS_COPY_STATUS_CATALOGING) ) { - $copy->status(OILS_COPY_STATUS_CATALOGING); - $self->update_copy(); - $self->checkin_changed(1); - $self->push_events(OpenILS::Event->new('ITEM_NOT_CATALOGED')); - } -} - - -sub checkin_build_copy_transit { - my $self = shift; - my $dest = shift; - my $copy = $self->copy; - my $transit = Fieldmapper::action::transit_copy->new; - - #$dest ||= (ref($copy->circ_lib)) ? $copy->circ_lib->id : $copy->circ_lib; - $logger->info("circulator: transiting copy to $dest"); - - $transit->source($self->circ_lib); - $transit->dest($dest); - $transit->target_copy($copy->id); - $transit->source_send_time('now'); - $transit->copy_status( $U->copy_status($copy->status)->id ); - - $logger->debug("circulator: setting copy status on transit: ".$transit->copy_status); - - return $self->bail_on_events($self->editor->event) - unless $self->editor->create_action_transit_copy($transit); - - $copy->status(OILS_COPY_STATUS_IN_TRANSIT); - $self->update_copy; - $self->checkin_changed(1); -} - - -sub hold_capture_is_possible { - my $self = shift; - my $copy = $self->copy; - - # we've been explicitly told not to capture any holds - return 0 if $self->capture eq 'nocapture'; - - # See if this copy can fulfill any holds - my $hold = $holdcode->find_nearest_permitted_hold( - $self->editor, $copy, $self->editor->requestor, 1 # check_only - ); - return undef if ref $hold eq "HASH" and - $hold->{"textcode"} eq "ACTION_HOLD_REQUEST_NOT_FOUND"; - return $hold; -} - -sub reservation_capture_is_possible { - my $self = shift; - my $copy = $self->copy; - - # we've been explicitly told not to capture any holds - return 0 if $self->capture eq 'nocapture'; - - my $booking_ses = OpenSRF::AppSession->connect("open-ils.booking"); - my $resv = $booking_ses->request( - "open-ils.booking.reservations.could_capture", - $self->editor->authtoken, $copy->barcode - )->gather(1); - $booking_ses->disconnect; - if (ref($resv) eq "HASH" and exists $resv->{"textcode"}) { - $self->push_events($resv); - } else { - return $resv; - } -} - -# returns true if the item was used (or may potentially be used -# in subsequent calls) to capture a hold. -sub attempt_checkin_hold_capture { - my $self = shift; - my $copy = $self->copy; - - # we've been explicitly told not to capture any holds - return 0 if $self->capture eq 'nocapture'; - - # See if this copy can fulfill any holds - my ($hold, undef, $retarget) = $holdcode->find_nearest_permitted_hold( - $self->editor, $copy, $self->editor->requestor ); - - if(!$hold) { - $logger->debug("circulator: no potential permitted". - "holds found for copy ".$copy->barcode); - return 0; - } - - if($self->capture ne 'capture') { - # see if this item is in a hold-capture-delay location - my $location = $self->editor->retrieve_asset_copy_location($self->copy->location); - if($U->is_true($location->hold_verify)) { - $self->bail_on_events( - OpenILS::Event->new('HOLD_CAPTURE_DELAYED', copy_location => $location)); - return 1; - } - } - - $self->retarget($retarget); - - $logger->info("circulator: found permitted hold ".$hold->id." for copy, capturing..."); - - $hold->current_copy($copy->id); - $hold->capture_time('now'); - $self->put_hold_on_shelf($hold) - if $hold->pickup_lib == $self->circ_lib; - - # prevent DB errors caused by fetching - # holds from storage, and updating through cstore - $hold->clear_fulfillment_time; - $hold->clear_fulfillment_staff; - $hold->clear_fulfillment_lib; - $hold->clear_expire_time; - $hold->clear_cancel_time; - $hold->clear_prev_check_time unless $hold->prev_check_time; - - $self->bail_on_events($self->editor->event) - unless $self->editor->update_action_hold_request($hold); - $self->hold($hold); - $self->checkin_changed(1); - - return 0 if $self->bail_out; - - if( $hold->pickup_lib == $self->circ_lib ) { - - # This hold was captured in the correct location - $copy->status(OILS_COPY_STATUS_ON_HOLDS_SHELF); - $self->push_events(OpenILS::Event->new('SUCCESS')); - - #$self->do_hold_notify($hold->id); - $self->notify_hold($hold->id); - - } else { - - # Hold needs to be picked up elsewhere. Build a hold - # transit and route the item. - $self->checkin_build_hold_transit(); - $copy->status(OILS_COPY_STATUS_IN_TRANSIT); - return 0 if $self->bail_out; - $self->push_events(OpenILS::Event->new('ROUTE_ITEM', org => $hold->pickup_lib)); - } - - # make sure we save the copy status - $self->update_copy; - return 1; -} - -sub attempt_checkin_reservation_capture { - my $self = shift; - my $copy = $self->copy; - - # we've been explicitly told not to capture any holds - return 0 if $self->capture eq 'nocapture'; - - my $booking_ses = OpenSRF::AppSession->connect("open-ils.booking"); - my $evt = $booking_ses->request( - "open-ils.booking.resources.capture_for_reservation", - $self->editor->authtoken, - $copy->barcode, - 1 # don't update copy - we probably have it locked - )->gather(1); - $booking_ses->disconnect; - - if (ref($evt) ne "HASH" or not exists $evt->{"textcode"}) { - $logger->warn( - "open-ils.booking.resources.capture_for_reservation " . - "didn't return an event!" - ); - } else { - if ( - $evt->{"textcode"} eq "RESERVATION_NOT_FOUND" and - $evt->{"payload"}->{"fail_cause"} eq "not-transferable" - ) { - # not-transferable is an error event we'll pass on the user - $logger->warn("reservation capture attempted against non-transferable item"); - $self->push_events($evt); - return 0; - } elsif ($evt->{"textcode"} eq "SUCCESS") { - # Re-retrieve copy as reservation capture may have changed - # its status and whatnot. - $logger->info( - "circulator: booking capture win on copy " . $self->copy->id - ); - if (my $new_copy_status = $evt->{"payload"}->{"new_copy_status"}) { - $logger->info( - "circulator: changing copy " . $self->copy->id . - "'s status from " . $self->copy->status . " to " . - $new_copy_status - ); - $self->copy->status($new_copy_status); - $self->update_copy; - } - $self->reservation($evt->{"payload"}->{"reservation"}); - - if (exists $evt->{"payload"}->{"transit"}) { - $self->push_events( - new OpenILS::Event( - "ROUTE_ITEM", - "org" => $evt->{"payload"}->{"transit"}->dest - ) - ); - } - $self->checkin_changed(1); - return 1; - } - } - # other results are treated as "nothing to capture" - return 0; -} - -sub do_hold_notify { - my( $self, $holdid ) = @_; - - my $e = new_editor(xact => 1); - my $hold = $e->retrieve_action_hold_request($holdid) or return $e->die_event; - $e->rollback; - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - $ses->request('open-ils.trigger.event.autocreate', 'hold.available', $hold, $hold->pickup_lib); - - $logger->info("circulator: running delayed hold notify process"); - -# my $notifier = OpenILS::Application::Circ::HoldNotify->new( -# hold_id => $holdid, editor => new_editor(requestor=>$self->editor->requestor)); - - my $notifier = OpenILS::Application::Circ::HoldNotify->new( - hold_id => $holdid, requestor => $self->editor->requestor); - - $logger->debug("circulator: built hold notifier"); - - if(!$notifier->event) { - - $logger->info("circulator: attempt at sending hold notification for hold $holdid"); - - my $stat = $notifier->send_email_notify; - if( $stat == '1' ) { - $logger->info("circulator: hold notify succeeded for hold $holdid"); - return; - } - - $logger->debug("circulator: * hold notify cancelled or failed for hold $holdid"); - - } else { - $logger->info("circulator: Not sending hold notification since the patron has no email address"); - } -} - -sub retarget_holds { - my $self = shift; - $logger->info("circulator: retargeting holds @{$self->retarget} after opportunistic capture"); - my $ses = OpenSRF::AppSession->create('open-ils.storage'); - $ses->request('open-ils.storage.action.hold_request.copy_targeter', undef, $self->retarget); - # no reason to wait for the return value - return; -} - -sub checkin_build_hold_transit { - my $self = shift; - - my $copy = $self->copy; - my $hold = $self->hold; - my $trans = Fieldmapper::action::hold_transit_copy->new; - - $logger->debug("circulator: building hold transit for ".$copy->barcode); - - $trans->hold($hold->id); - $trans->source($self->circ_lib); - $trans->dest($hold->pickup_lib); - $trans->source_send_time("now"); - $trans->target_copy($copy->id); - - # when the copy gets to its destination, it will recover - # this status - put it onto the holds shelf - $trans->copy_status(OILS_COPY_STATUS_ON_HOLDS_SHELF); - - return $self->bail_on_events($self->editor->event) - unless $self->editor->create_action_hold_transit_copy($trans); -} - - - -sub process_received_transit { - my $self = shift; - my $copy = $self->copy; - my $copyid = $self->copy->id; - - my $status_name = $U->copy_status($copy->status)->name; - $logger->debug("circulator: attempting transit receive on ". - "copy $copyid. Copy status is $status_name"); - - my $transit = $self->transit; - - if( $transit->dest != $self->circ_lib ) { - # - this item is in-transit to a different location - - my $tid = $transit->id; - my $loc = $self->circ_lib; - my $dest = $transit->dest; - - $logger->info("circulator: Fowarding transit on copy which is destined ". - "for a different location. transit=$tid, copy=$copyid, current ". - "location=$loc, destination location=$dest"); - - my $evt = OpenILS::Event->new('ROUTE_ITEM', org => $dest, payload => {}); - - # grab the associated hold object if available - my $ht = $self->editor->retrieve_action_hold_transit_copy($tid); - $self->hold($self->editor->retrieve_action_hold_request($ht->hold)) if $ht; - - return $self->bail_on_events($evt); - } - - # The transit is received, set the receive time - $transit->dest_recv_time('now'); - $self->bail_on_events($self->editor->event) - unless $self->editor->update_action_transit_copy($transit); - - my $hold_transit = $self->editor->retrieve_action_hold_transit_copy($transit->id); - - $logger->info("circulator: Recovering original copy status in transit: ".$transit->copy_status); - $copy->status( $transit->copy_status ); - $self->update_copy(); - return if $self->bail_out; - - my $ishold = 0; - if($hold_transit) { - my $hold = $self->editor->retrieve_action_hold_request($hold_transit->hold); - - # hold has arrived at destination, set shelf time - $self->put_hold_on_shelf($hold); - $self->bail_on_events($self->editor->event) - unless $self->editor->update_action_hold_request($hold); - return if $self->bail_out; - - $self->notify_hold($hold_transit->hold); - $ishold = 1; - } - - $self->push_events( - OpenILS::Event->new( - 'SUCCESS', - ishold => $ishold, - payload => { transit => $transit, holdtransit => $hold_transit } )); - - return $hold_transit; -} - - -# ------------------------------------------------------------------ -# Sets the shelf_time and shelf_expire_time for a newly shelved hold -# ------------------------------------------------------------------ -sub put_hold_on_shelf { - my($self, $hold) = @_; - - $hold->shelf_time('now'); - - my $shelf_expire = $U->ou_ancestor_setting_value( - $self->circ_lib, 'circ.holds.default_shelf_expire_interval', $self->editor); - - if($shelf_expire) { - my $seconds = OpenSRF::Utils->interval_to_seconds($shelf_expire); - my $expire_time = DateTime->now->add(seconds => $seconds); - $hold->shelf_expire_time($expire_time->strftime('%FT%T%z')); - } - - return undef; -} - - - -sub generate_fines { - my $self = shift; - my $reservation = shift; - - $self->generate_fines_start($reservation); - $self->generate_fines_finish($reservation); - - return undef; -} - -sub generate_fines_start { - my $self = shift; - my $reservation = shift; - - my $id = $reservation ? $self->reservation->id : $self->circ->id; - - if (!exists($self->{_gen_fines_req})) { - $self->{_gen_fines_req} = OpenSRF::AppSession->create('open-ils.storage') - ->request( - 'open-ils.storage.action.circulation.overdue.generate_fines', - undef, - $id - ); - } - - return undef; -} - -sub generate_fines_finish { - my $self = shift; - my $reservation = shift; - - my $id = $reservation ? $self->reservation->id : $self->circ->id; - - $self->{_gen_fines_req}->wait_complete; - delete($self->{_gen_fines_req}); - - # refresh the circ in case the fine generator set the stop_fines field - $self->reservation($self->editor->retrieve_booking_reservation($id)) if $reservation; - $self->circ($self->editor->retrieve_action_circulation($id)) if !$reservation; - - return undef; -} - -sub checkin_handle_circ { - my $self = shift; - my $circ = $self->circ; - my $copy = $self->copy; - my $evt; - my $obt; - - $self->backdate($circ->xact_start) if $self->claims_never_checked_out; - - # backdate the circ if necessary - if($self->backdate) { - my $evt = $self->checkin_handle_backdate; - return $self->bail_on_events($evt) if $evt; - } - - if($self->void_overdues) { - my $evt = OpenILS::Application::Circ::CircCommon->void_overdues( - $self->editor, $circ, undef, 'System: Amnesty Checkin'); # TODO i18n for system-generated notes - return $self->bail_on_events($evt) if $evt; - } - - if(!$circ->stop_fines) { - $circ->stop_fines(OILS_STOP_FINES_CHECKIN); - $circ->stop_fines(OILS_STOP_FINES_RENEW) if $self->is_renewal; - $circ->stop_fines(OILS_STOP_FINES_CLAIMS_NEVERCHECKEDOUT) if $self->claims_never_checked_out; - $circ->stop_fines_time('now'); - $circ->stop_fines_time($self->backdate) if $self->backdate; - } - - # Set the checkin vars since we have the item - $circ->checkin_time( ($self->backdate) ? $self->backdate : 'now' ); - - # capture the true scan time for back-dated checkins - $circ->checkin_scan_time('now'); - - $circ->checkin_staff($self->editor->requestor->id); - $circ->checkin_lib($self->circ_lib); - $circ->checkin_workstation($self->editor->requestor->wsid); - - my $circ_lib = (ref $self->copy->circ_lib) ? - $self->copy->circ_lib->id : $self->copy->circ_lib; - my $stat = $U->copy_status($self->copy->status)->id; - - # immediately available keeps items lost or missing items from going home before being handled - my $lost_immediately_available = $U->ou_ancestor_setting_value( - $circ_lib, OILS_SETTING_LOST_IMMEDIATELY_AVAILABLE, $self->editor) || 0; - - - if ( (!$lost_immediately_available) && ($circ_lib != $self->circ_lib) ) { - - if( ($stat == OILS_COPY_STATUS_LOST or $stat == OILS_COPY_STATUS_MISSING) ) { - $logger->info("circulator: not updating copy status on checkin because copy is lost/missing"); - } else { - $self->copy->status($U->copy_status(OILS_COPY_STATUS_RESHELVING)); - $self->update_copy; - } - - } elsif ($stat == OILS_COPY_STATUS_LOST) { - - $self->checkin_handle_lost($circ_lib); - - } else { - - $self->copy->status($U->copy_status(OILS_COPY_STATUS_RESHELVING)); - $self->update_copy; - } - - - # see if there are any fines owed on this circ. if not, close it - ($obt) = $U->fetch_mbts($circ->id, $self->editor); - $circ->xact_finish('now') if( $obt and $obt->balance_owed == 0 ); - - $logger->debug("circulator: ".$obt->balance_owed." is owed on this circulation"); - - return $self->bail_on_events($self->editor->event) - unless $self->editor->update_action_circulation($circ); - - # make sure the circ isn't closed if we just voided some fines - $evt = OpenILS::Application::Circ::CircCommon->reopen_xact($self->editor, $circ->id); - return $self->bail_on_events($evt) if $evt; - - return undef; -} - - -# ------------------------------------------------------------------ -# See if we need to void billings for lost checkin -# ------------------------------------------------------------------ -sub checkin_handle_lost { - my $self = shift; - my $circ_lib = shift; - my $circ = $self->circ; - - my $max_return = $U->ou_ancestor_setting_value( - $circ_lib, OILS_SETTING_MAX_ACCEPT_RETURN_OF_LOST, $self->editor) || 0; - - if ($max_return) { - - my $today = time(); - my @tm = reverse($circ->due_date =~ /([\d\.]+)/og); - $tm[5] -= 1 if $tm[5] > 0; - my $due = timelocal(int($tm[1]), int($tm[2]), int($tm[3]), int($tm[4]), int($tm[5]), int($tm[6])); - - my $last_chance = OpenSRF::Utils->interval_to_seconds($max_return) + int($due); - $logger->info("MAX OD: ".$max_return." DUEDATE: ".$circ->due_date." TODAY: ".$today." DUE: ".$due." LAST: ".$last_chance); - - $max_return = 0 if $today < $last_chance; - } - - if (!$max_return){ # there's either no max time to accept returns defined or we're within that time - - my $void_lost = $U->ou_ancestor_setting_value( - $circ_lib, OILS_SETTING_VOID_LOST_ON_CHECKIN, $self->editor) || 0; - my $void_lost_fee = $U->ou_ancestor_setting_value( - $circ_lib, OILS_SETTING_VOID_LOST_PROCESS_FEE_ON_CHECKIN, $self->editor) || 0; - my $restore_od = $U->ou_ancestor_setting_value( - $circ_lib, OILS_SETTING_RESTORE_OVERDUE_ON_LOST_RETURN, $self->editor) || 0; - - $self->checkin_handle_lost_now_found(3) if $void_lost; - $self->checkin_handle_lost_now_found(4) if $void_lost_fee; - $self->checkin_handle_lost_now_found_restore_od() if $restore_od && ! $self->void_overdues; - } - - $self->copy->status($U->copy_status(OILS_COPY_STATUS_RESHELVING)); - $self->update_copy; -} - - -sub checkin_handle_backdate { - my $self = shift; - - # ------------------------------------------------------------------ - # clean up the backdate for date comparison - # XXX We are currently taking the due-time from the original due-date, - # not the input. Do we need to do this? This certainly interferes with - # backdating of hourly checkouts, but that is likely a very rare case. - # ------------------------------------------------------------------ - my $bd = cleanse_ISO8601($self->backdate); - my $original_date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($self->circ->due_date)); - my $new_date = DateTime::Format::ISO8601->new->parse_datetime($bd); - $bd = cleanse_ISO8601($new_date->ymd . 'T' . $original_date->strftime('%T%z')); - - $self->backdate($bd); - - my $evt = OpenILS::Application::Circ::CircCommon->void_overdues($self->editor, $self->circ, $bd); - return $evt if $evt; - - return undef; -} - - -sub check_checkin_copy_status { - my $self = shift; - my $copy = $self->copy; - - my $status = $U->copy_status($copy->status)->id; - - return undef - if( $status == OILS_COPY_STATUS_AVAILABLE || - $status == OILS_COPY_STATUS_CHECKED_OUT || - $status == OILS_COPY_STATUS_IN_PROCESS || - $status == OILS_COPY_STATUS_ON_HOLDS_SHELF || - $status == OILS_COPY_STATUS_IN_TRANSIT || - $status == OILS_COPY_STATUS_CATALOGING || - $status == OILS_COPY_STATUS_ON_RESV_SHELF || - $status == OILS_COPY_STATUS_RESHELVING ); - - return OpenILS::Event->new('COPY_STATUS_LOST', payload => $copy ) - if( $status == OILS_COPY_STATUS_LOST ); - - return OpenILS::Event->new('COPY_STATUS_MISSING', payload => $copy ) - if( $status == OILS_COPY_STATUS_MISSING ); - - return OpenILS::Event->new('COPY_BAD_STATUS', payload => $copy ); -} - - - -# -------------------------------------------------------------------------- -# On checkin, we need to return as many relevant objects as we can -# -------------------------------------------------------------------------- -sub checkin_flesh_events { - my $self = shift; - - if( grep { $_->{textcode} eq 'SUCCESS' } @{$self->events} - and grep { $_->{textcode} eq 'ITEM_NOT_CATALOGED' } @{$self->events} ) { - $self->events([grep { $_->{textcode} eq 'ITEM_NOT_CATALOGED' } @{$self->events}]); - } - - my $record = $U->record_to_mvr($self->title) if($self->title and !$self->is_precat); - - my $hold; - if($self->hold and !$self->hold->cancel_time) { - $hold = $self->hold; - $hold->notes($self->editor->search_action_hold_request_note({hold => $hold->id})); - } - - if($self->circ) { - # if we checked in a circulation, flesh the billing summary data - $self->circ->billable_transaction( - $self->editor->retrieve_money_billable_transaction([ - $self->circ->id, - {flesh => 1, flesh_fields => {mbt => ['summary']}} - ]) - ); - } - - if($self->patron) { - # flesh some patron fields before returning - $self->patron( - $self->editor->retrieve_actor_user([ - $self->patron->id, - { - flesh => 1, - flesh_fields => { - au => ['card', 'billing_address', 'mailing_address'] - } - } - ]) - ); - } - - for my $evt (@{$self->events}) { - - my $payload = {}; - $payload->{copy} = $U->unflesh_copy($self->copy); - $payload->{record} = $record, - $payload->{circ} = $self->circ; - $payload->{transit} = $self->transit; - $payload->{cancelled_hold_transit} = 1 if $self->cancelled_hold_transit; - $payload->{hold} = $hold; - $payload->{patron} = $self->patron; - $payload->{reservation} = $self->reservation - unless (not $self->reservation or $self->reservation->cancel_time); - - $evt->{payload} = $payload; - } -} - -sub log_me { - my( $self, $msg ) = @_; - my $bc = ($self->copy) ? $self->copy->barcode : - $self->barcode; - $bc ||= ""; - my $usr = ($self->patron) ? $self->patron->id : ""; - $logger->info("circulator: $msg requestor=".$self->editor->requestor->id. - ", recipient=$usr, copy=$bc"); -} - - -sub do_renew { - my $self = shift; - $self->log_me("do_renew()"); - - # Make sure there is an open circ to renew that is not - # marked as LOST, CLAIMSRETURNED, or LONGOVERDUE - my $usrid = $self->patron->id if $self->patron; - my $circ = $self->editor->search_action_circulation({ - target_copy => $self->copy->id, - xact_finish => undef, - ($usrid ? (usr => $usrid) : ()), - '-or' => [ - {stop_fines => undef}, - {stop_fines => OILS_STOP_FINES_MAX_FINES} - ] - })->[0]; - - return $self->bail_on_events($self->editor->event) unless $circ; - - # A user is not allowed to renew another user's items without permission - unless( $circ->usr eq $self->editor->requestor->id ) { - return $self->bail_on_events($self->editor->events) - unless $self->editor->allowed('RENEW_CIRC', $circ->circ_lib); - } - - $self->push_events(OpenILS::Event->new('MAX_RENEWALS_REACHED')) - if $circ->renewal_remaining < 1; - - # ----------------------------------------------------------------- - - $self->parent_circ($circ->id); - $self->renewal_remaining( $circ->renewal_remaining - 1 ); - $self->circ($circ); - - # Run the fine generator against the old circ - $self->generate_fines_start; - - $self->run_renew_permit; - - # Check the item in - $self->do_checkin(); - return if $self->bail_out; - - unless( $self->permit_override ) { - $self->do_permit(); - return if $self->bail_out; - $self->is_precat(1) if $self->have_event('ITEM_NOT_CATALOGED'); - $self->remove_event('ITEM_NOT_CATALOGED'); - } - - $self->override_events; - return if $self->bail_out; - - $self->events([]); - $self->do_checkout(); -} - - -sub remove_event { - my( $self, $evt ) = @_; - $evt = (ref $evt) ? $evt->{textcode} : $evt; - $logger->debug("circulator: removing event from list: $evt"); - my @events = @{$self->events}; - $self->events( [ grep { $_->{textcode} ne $evt } @events ] ); -} - - -sub have_event { - my( $self, $evt ) = @_; - $evt = (ref $evt) ? $evt->{textcode} : $evt; - return grep { $_->{textcode} eq $evt } @{$self->events}; -} - - - -sub run_renew_permit { - my $self = shift; - - if ($U->ou_ancestor_setting_value($self->circ_lib, 'circ.block_renews_for_holds')) { - my ($hold, undef, $retarget) = $holdcode->find_nearest_permitted_hold( - $self->editor, $self->copy, $self->editor->requestor, 1 - ); - $self->push_events(new OpenILS::Event("COPY_NEEDED_FOR_HOLD")) if $hold; - } - - if(!$self->legacy_script_support) { - my $results = $self->run_indb_circ_test; - $self->push_events($self->matrix_test_result_events) - unless $self->circ_test_success; - } else { - - my $runner = $self->script_runner; - - $runner->load($self->circ_permit_renew); - my $result = $runner->run or - throw OpenSRF::EX::ERROR ("Circ Permit Renew Script Died: $@"); - if ($result->{"events"}) { - $self->push_events( - map { new OpenILS::Event($_) } @{$result->{"events"}} - ); - $logger->activity( - "circulator: circ_permit_renew for user " . - $self->patron->id . " returned " . - scalar(@{$result->{"events"}}) . " event(s)" - ); - } - - $self->mk_script_runner; - } - - $logger->debug("circulator: re-creating script runner to be safe"); -} - - -# XXX: The primary mechanism for storing circ history is now handled -# by tracking real circulation objects instead of bibs in a bucket. -# However, this code is disabled by default and could be useful -# some day, so may as well leave it for now. -sub append_reading_list { - my $self = shift; - - return undef unless - $self->is_checkout and - $self->patron and - $self->copy and - !$self->is_noncat; - - - # verify history is globally enabled and uses the bucket mechanism - my $htype = OpenSRF::Utils::SettingsClient->new->config_value( - apps => 'open-ils.circ' => app_settings => 'checkout_history_mechanism'); - - return undef unless $htype and $htype eq 'bucket'; - - my $e = new_editor(xact => 1, requestor => $self->editor->requestor); - - # verify the patron wants to retain the hisory - my $setting = $e->search_actor_user_setting( - {usr => $self->patron->id, name => 'circ.keep_checkout_history'})->[0]; - - unless($setting and $setting->value) { - $e->rollback; - return undef; - } - - my $bkt = $e->search_container_copy_bucket( - {owner => $self->patron->id, btype => 'circ_history'})->[0]; - - my $pos = 1; - - if($bkt) { - # find the next item position - my $last_item = $e->search_container_copy_bucket_item( - {bucket => $bkt->id}, {order_by => {ccbi => 'pos desc'}, limit => 1})->[0]; - $pos = $last_item->pos + 1 if $last_item; - - } else { - # create the history bucket if necessary - $bkt = Fieldmapper::container::copy_bucket->new; - $bkt->owner($self->patron->id); - $bkt->name(''); - $bkt->btype('circ_history'); - $bkt->pub('f'); - $e->create_container_copy_bucket($bkt) or return $e->die_event; - } - - my $item = Fieldmapper::container::copy_bucket_item->new; - - $item->bucket($bkt->id); - $item->target_copy($self->copy->id); - $item->pos($pos); - - $e->create_container_copy_bucket_item($item) or return $e->die_event; - $e->commit; - - return undef; -} - - -sub make_trigger_events { - my $self = shift; - return unless $self->circ; - $U->create_events_for_hook('checkout', $self->circ, $self->circ_lib) if $self->is_checkout; - $U->create_events_for_hook('checkin', $self->circ, $self->circ_lib) if $self->is_checkin; - $U->create_events_for_hook('renewal', $self->circ, $self->circ_lib) if $self->is_renewal; -} - - - -sub checkin_handle_lost_now_found { - my ($self, $bill_type) = @_; - - # ------------------------------------------------------------------ - # remove charge from patron's account if lost item is returned - # ------------------------------------------------------------------ - - my $bills = $self->editor->search_money_billing( - { - xact => $self->circ->id, - btype => $bill_type - } - ); - - $logger->debug("voiding lost item charge of ".scalar(@$bills)); - for my $bill (@$bills) { - if( !$U->is_true($bill->voided) ) { - $logger->info("lost item returned - voiding bill ".$bill->id); - $bill->voided('t'); - $bill->void_time('now'); - $bill->voider($self->editor->requestor->id); - my $note = ($bill->note) ? $bill->note . "\n" : ''; - $bill->note("${note}System: VOIDED FOR LOST ITEM RETURNED"); - - $self->bail_on_events($self->editor->event) - unless $self->editor->update_money_billing($bill); - } - } -} - -sub checkin_handle_lost_now_found_restore_od { - my $self = shift; - - # ------------------------------------------------------------------ - # restore those overdue charges voided when item was set to lost - # ------------------------------------------------------------------ - - my $ods = $self->editor->search_money_billing( - { - xact => $self->circ->id, - btype => 1 - } - ); - - $logger->debug("returning overdue charges pre-lost ".scalar(@$ods)); - for my $bill (@$ods) { - if( $U->is_true($bill->voided) ) { - $logger->info("lost item returned - restoring overdue ".$bill->id); - $bill->voided('f'); - $bill->clear_void_time; - $bill->voider($self->editor->requestor->id); - my $note = ($bill->note) ? $bill->note . "\n" : ''; - $bill->note("${note}System: LOST RETURNED - OVERDUES REINSTATED"); - - $self->bail_on_events($self->editor->event) - unless $self->editor->update_money_billing($bill); - } - } -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ/CopyLocations.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ/CopyLocations.pm deleted file mode 100644 index d7f0773293..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ/CopyLocations.pm +++ /dev/null @@ -1,220 +0,0 @@ -package OpenILS::Application::Circ::CopyLocations; -use base 'OpenILS::Application'; -use strict; use warnings; -use Data::Dumper; -$Data::Dumper::Indent = 0; -use OpenSRF::EX qw(:try); -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Application::AppUtils; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::CStoreEditor qw/:funcs/; -my $U = "OpenILS::Application::AppUtils"; - - -__PACKAGE__->register_method( - api_name => "open-ils.circ.copy_location.retrieve.all", - method => 'cl_retrieve_all', - argc => 2, - signature => q/ - Retrieves the ranged set of copy locations for the requested org. - If no org is provided, all copy locations are returned - @param orgId The org location id - @param noi18n No i18n in result - @param flesh_owning_lib Flesh owning lib in results - @return An array of copy location objects - /); - -sub cl_retrieve_all { - my ($self, $client, $org_id, $no_i18n, $flesh_owning_lib) = @_; - - if(!$org_id) { - my $otree = $U->get_org_tree(); - $org_id = $otree->id; - } - - my $second_cstore_arg = {"no_i18n" => scalar($no_i18n)}; - if ($flesh_owning_lib) { - $second_cstore_arg->{"flesh"} = 1; - $second_cstore_arg->{"flesh_fields"} = {"acpl" => ["owning_lib"]}; - } - - return new_editor()->search_asset_copy_location([{ - owning_lib => $U->get_org_full_path($org_id) - }, $second_cstore_arg]); -} - -__PACKAGE__->register_method( - "api_name" => "open-ils.circ.copy_location.retrieve.distinct", - "method" => "cl_retrieve_distinct", - "stream" => 1, - "argc" => 0, - "signature" => q/Retrieve copy locations with distinct names globally/ -); - -sub cl_retrieve_distinct { - my ($self, $client) = @_; - - my $e = new_editor(); - my $names = $e->json_query({ - "select" => { - "acpl" => [{"transform" => "distinct", "column" => "name"}] - }, - "from" => {"acpl" => {}} - }) or return $e->die_event; - $e->disconnect; - - $client->respond($_->{"name"}) for @$names; - undef; -} - -__PACKAGE__->register_method( - api_name => 'open-ils.circ.copy_location.create', - method => 'cl_create', - argc => 2, - signature => q/ - Creates a new copy location. Requestor must have the CREATE_COPY_LOCATION - permission at the location specified on the new location object - @param authtoken The login session key - @param copyLoc The new copy location object - @return The if of the new location object on success, event on error - /); - - -sub cl_create { - my( $self, $conn, $auth, $location ) = @_; - - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless - $e->allowed('CREATE_COPY_LOCATION', $location->owning_lib); - - # make sure there is no copy_location with the same name in the same place - my $existing = $e->search_asset_copy_location( - {owning_lib => $location->owning_lib, name => $location->name}, {idlist=>1}); - return OpenILS::Event->new('COPY_LOCATION_EXISTS') if @$existing; - - $e->create_asset_copy_location($location) or return $e->die_event; - $e->commit; - return $location->id; -} - - - -__PACKAGE__->register_method ( - api_name => 'open-ils.circ.copy_location.delete', - method => 'cl_delete', - argc => 2, - signature => q/ - Deletes a copy location. Requestor must have the - DELETE_COPY_LOCATION permission. - @param authtoken The login session key - @param id The copy location object id - @return 1 on success, event on error - /); - - -sub cl_delete { - my( $self, $conn, $auth, $id ) = @_; - - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - - my $cloc = $e->retrieve_asset_copy_location($id) - or return $e->die_event; - return $e->die_event unless - $e->allowed('DELETE_COPY_LOCATION', $cloc->owning_lib); - - $e->delete_asset_copy_location($cloc) or return $e->die_event; - $e->commit; - return 1; -} - - -__PACKAGE__->register_method ( - api_name => 'open-ils.circ.copy_location.update', - method => 'cl_update', - argc => 2, - signature => q/ - Updates a copy location object. Requestor must have - the UPDATE_COPY_LOCATION permission - @param authtoken The login session key - @param copyLoc The copy location object - @return 1 on success, event on error - /); - - -sub cl_update { - my( $self, $conn, $auth, $location ) = @_; - - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - - # check permissions against the original copy location - my $orig_loc = $e->retrieve_asset_copy_location($location->id) - or return $e->die_event; - - return $e->die_event unless - $e->allowed('UPDATE_COPY_LOCATION', $orig_loc->owning_lib); - - # disallow hijacking of the location - $location->owning_lib($orig_loc->owning_lib); - - $e->update_asset_copy_location($location) - or return $e->die_event; - - $e->commit; - return 1; -} - - - -__PACKAGE__->register_method( - method => 'fetch_loc', - authoritative => 1, - api_name => 'open-ils.circ.copy_location.retrieve', -); - -sub fetch_loc { - my( $self, $con, $id ) = @_; - my $e = new_editor(); - my $cl = $e->retrieve_asset_copy_location($id) - or return $e->event; - return $cl; -} - -__PACKAGE__->register_method( - api_name => "open-ils.circ.copy_location_order.update", - method => 'update_clo', - argc => 2, -); - -sub update_clo { - my($self, $client, $auth, $orders) = @_; - return [] unless $orders and @$orders; - - my $e = new_editor(authtoken => $auth, xact =>1); - return $e->die_event unless $e->checkauth; - - my $org = $$orders[0]->org; - return $e->die_event unless $e->allowed('ADMIN_COPY_LOCATION_ORDER', $org); - - # clear out the previous order entries - my $existing = $e->search_asset_copy_location_order({org => $org}); - $e->delete_asset_copy_location_order($_) or return $e->die_event for @$existing; - - # create the new order entries - my $progress = 0; - for my $order (@$orders) { - return $e->die_event(OpenILS::Event->new('BAD_PARAMS')) unless $order->org == $org; - $e->create_asset_copy_location_order($order) or return $e->die_event; - $client->respond({maximum => scalar(@$orders), progress => $progress}) unless ($progress++ % 10); - } - - # fetch the new entries - $orders = $e->search_asset_copy_location_order({org => $org}); - $e->commit; - return {orders => $orders}; -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ/CreditCard.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ/CreditCard.pm deleted file mode 100644 index 647cc26f47..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ/CreditCard.pm +++ /dev/null @@ -1,297 +0,0 @@ -# -------------------------------------------------------------------- -# Copyright (C) 2008 Niles Ingalls -# Niles Ingalls -# Bill Erickson -# Joe Atzberger -# Lebbeous Fogle-Weekley -# -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -------------------------------------------------------------------- -package OpenILS::Application::Circ::CreditCard; -use base qw/OpenSRF::Application/; -use strict; use warnings; - -use Business::CreditCard; -use Business::OnlinePayment; -use UUID::Tiny qw/:std/; -use Locale::Country; - -use OpenILS::Event; -use OpenSRF::Utils::Logger qw/:logger/; -use OpenILS::Utils::CStoreEditor qw/:funcs/; -use OpenILS::Application::AppUtils; -my $U = "OpenILS::Application::AppUtils"; - -use constant CREDIT_NS => "credit"; - -# Given the argshash from process_payment(), this helper function just finds -# a function in the current namespace named "bop_args_{processor}" and calls -# it with $argshash as an argument, returning the result, or returning an -# empty hash if it can't find such a function. -sub get_bop_args_filler { - no strict 'refs'; - - my $argshash = shift; - my $funcname = "bop_args_" . $argshash->{processor}; - return &{$funcname}($argshash) if defined &{$funcname}; - return (); -} - -# Provide default arguments for calls using the AuthorizeNet processor -sub bop_args_AuthorizeNet { - my $argshash = shift; - if ($argshash->{server}) { - return ( - # One might provide "test.authorize.net" here. - Server => $argshash->{server}, - ); - } - else { - return (); - } -} - -# Provide default arguments for calls using the PayPal processor -sub bop_args_PayPal { - my $argshash = shift; - return ( - Username => $argshash->{login}, - Password => $argshash->{password}, - Signature => $argshash->{signature} - ); -} - -# Provide default arguments for calls using the PayflowPro processor -sub bop_args_PayflowPro { - my $argshash = shift; - return ( - "vendor" => $argshash->{vendor}, - "partner" => $argshash->{partner} || "PayPal" # reasonable default? - ); -} - -sub get_processor_settings { - my $org_unit = shift; - my $processor = lc shift; - - # XXX TODO: make this one single cstore request instead of many - +{ map { ($_ => - $U->ou_ancestor_setting_value( - $org_unit, CREDIT_NS . ".processor.${processor}.${_}" - )) } qw/enabled login password signature server testmode vendor partner/ - }; -} - -# argshash (Hash of arguments with these keys): -# patron_id: Not a barcode, but a patron's internal ID -# ou: Org unit where transaction happens -# processor: Payment processor to use -# (AuthorizeNet/PayPal/PayflowPro) -# cc: credit card number -# cvv2: 3 or 4 digits from back of card -# amount: transaction value -# action: optional (default: Normal Authorization) -# first_name: optional (default: patron's first_given_name field) -# last_name: optional (default: patron's family_name field) -# address: optional (default: patron's street1 field + street2) -# city: optional (default: patron's city field) -# state: optional (default: patron's state field) -# zip: optional (default: patron's zip field) -# country: optional (some processor APIs: 2 letter code.) -# description: optional - -sub process_payment { - my ($argshash) = @_; - - # Confirm some required arguments. - return OpenILS::Event->new('BAD_PARAMS') - unless $argshash - and $argshash->{cc} - and $argshash->{amount} - and $argshash->{expiration} - and $argshash->{ou}; - - if (!$argshash->{processor}) { - if (!($argshash->{processor} = - $U->ou_ancestor_setting_value( - $argshash->{ou}, CREDIT_NS . '.processor.default'))) { - return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_SPECIFIED'); - } - } - # Basic sanity check on processor name. - if ($argshash->{processor} !~ /^[a-z0-9_\-]+$/i) { - return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_ALLOWED'); - } - - # Get org unit settings related to our processor - my $psettings = get_processor_settings( - $argshash->{ou}, $argshash->{processor} - ); - - if (!$psettings->{enabled}) { - return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_ENABLED'); - } - - # Add the org unit settings for the chosen processor to our argshash. - $argshash = +{ %{$argshash}, %{$psettings} }; - - # At least the following (derived from org unit settings) are required. - return OpenILS::Event->new('CREDIT_PROCESSOR_BAD_PARAMS') - unless $argshash->{login} - and $argshash->{password}; - - # A valid patron_id is also required. - my $e = new_editor(); - my $patron = $e->retrieve_actor_user( - [ - $argshash->{patron_id}, - { - flesh => 1, - flesh_fields => { au => ["mailing_address"] } - } - ] - ) or return $e->event; - - return dispatch($argshash, $patron); -} - -sub prepare_bop_content { - my ($argshash, $patron, $cardtype) = @_; - - my %content; - foreach (qw/ - login - password - description - first_name - last_name - amount - expiration - cvv2 - address - city - state - zip - country/) { - if (exists $argshash->{$_}) { - $content{$_} = $argshash->{$_}; - } - } - - $content{action} = $argshash->{action} || "Normal Authorization"; - $content{type} = $cardtype; #'American Express', 'VISA', 'MasterCard' - $content{card_number} = $argshash->{cc}; - $content{customer_id} = $patron->id; - - $content{first_name} ||= $patron->first_given_name; - $content{last_name} ||= $patron->family_name; - - $content{FirstName} = $content{first_name}; # kludge mcugly for PP - $content{LastName} = $content{last_name}; - - - # Especially for the following fields, do we need to support different - # mapping of fields for different payment processors, particularly ones - # in other countries? - $content{address} ||= $patron->mailing_address->street1; - $content{address} .= ", " . $patron->mailing_address->street2 - if $patron->mailing_address->street2; - - $content{city} ||= $patron->mailing_address->city; - $content{state} ||= $patron->mailing_address->state; - $content{zip} ||= $patron->mailing_address->post_code; - $content{country} ||= $patron->mailing_address->country; - - # Yet another fantastic kludge. country2code() comes from Locale::Country. - # PayPal must have 2 letter country field (ISO 3166) that's uppercase. - if (length($content{country}) > 2 && $argshash->{processor} eq 'PayPal') { - $content{country} = uc country2code($content{country}); - } elsif($argshash->{processor} eq "PayflowPro") { - ($content{request_id} = create_uuid_as_string(UUID_V4)) =~ s/-//; - } - - %content; -} - -sub dispatch { - my ($argshash, $patron) = @_; - - # The validate() sub is exported by Business::CreditCard. - if (!validate($argshash->{cc})) { - # Although it might help a troubleshooter, it's probably not a good - # idea to put the credit card number in the log file. - $logger->info("Credit card number invalid"); - - return new OpenILS::Event("CREDIT_PROCESSOR_INVALID_CC_NUMBER"); - } - - # cardtype() also comes from Business::CreditCard. It is not certain that - # a) the card type returned by this method will be suitable input for - # a payment processor, nor that - # b) it is even necessary to supply this argument to processors in all - # cases. Testing this with several processors would be a good idea. - (my $cardtype = cardtype($argshash->{cc})) =~ s/ card//i; - - if (lc($cardtype) eq "unknown") { - $logger->info("Credit card number passed validate(), " . - "yet cardtype() returned $cardtype"); - return new OpenILS::Event( - "CREDIT_PROCESSOR_INVALID_CC_NUMBER", "note" => "cardtype $cardtype" - ); - } - - $logger->debug( - "applying payment via processor '" . $argshash->{processor} . "'" - ); - - # Find B:OP constructor arguments specific to our payment processor. - my %bop_args = get_bop_args_filler($argshash); - - # We're assuming that all B:OP processors accept this argument to the - # constructor. - $bop_args{test_transaction} = $argshash->{testmode}; - - my $transaction = new Business::OnlinePayment( - $argshash->{processor}, %bop_args - ); - - my %content = prepare_bop_content($argshash, $patron, $cardtype); - $transaction->content(%content); - - # submit() does not return a value, although crashing is possible here - # with some bad input depending on the payment processor. - $transaction->submit; - - my $payload = { - "processor" => $argshash->{"processor"}, "card_type" => $cardtype - }; - - # Put the values of any of these fields into the event payload, if present. - foreach (qw/authorization correlationid avs_code request_id - server_response cvv2_response cvv2_code error_message order_number/) { - $payload->{$_} = $transaction->$_ if $transaction->can($_); - } - - my $event_name; - - if ($transaction->is_success) { - $logger->info($argshash->{processor} . " payment succeeded"); - $event_name = "SUCCESS"; - } else { - $logger->info($argshash->{processor} . " payment failed"); - $event_name = "CREDIT_PROCESSOR_DECLINED_TRANSACTION"; - } - - return new OpenILS::Event($event_name, "payload" => $payload); -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ/HoldNotify.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ/HoldNotify.pm deleted file mode 100644 index 674131695d..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ/HoldNotify.pm +++ /dev/null @@ -1,382 +0,0 @@ -# --------------------------------------------------------------- -# Copyright (C) 2005 Georgia Public Library Service -# Bill Erickson - -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# --------------------------------------------------------------- - - -package OpenILS::Application::Circ::HoldNotify; -use base qw/OpenILS::Application/; -use strict; use warnings; -use OpenSRF::EX qw(:try); -use vars q/$AUTOLOAD/; -use OpenILS::Event; -use OpenSRF::Utils::JSON; -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Application::AppUtils; -use OpenILS::Const qw/:const/; -use OpenILS::Utils::Fieldmapper; -use Email::Send; -use Data::Dumper; -use OpenSRF::EX qw/:try/; -my $U = 'OpenILS::Application::AppUtils'; - -use open ':utf8'; - - -__PACKAGE__->register_method( - method => 'send_email_notify_pub', - api_name => 'open-ils.circ.send_hold_notify.email', -); - - -sub send_email_notify_pub { - my( $self, $conn, $auth, $hold_id ) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('CREATE_HOLD_NOTIFICATION'); - my $notifier = __PACKAGE__->new(requestor => $e->requestor, hold_id => $hold_id); - return $notifier->event if $notifier->event; - my $stat = $notifier->send_email_notify; -# $e->commit if $stat == '1'; - return $stat; -} - - - - - -# --------------------------------------------------------------- -# Define the notifier object -# --------------------------------------------------------------- - -my @AUTOLOAD_FIELDS = qw/ - hold - copy - volume - title - editor - patron - event - pickup_lib - smtp_server - settings_client -/; - -sub AUTOLOAD { - my $self = shift; - my $type = ref($self) or die "$self is not an object"; - my $data = shift; - my $name = $AUTOLOAD; - $name =~ s/.*://o; - - unless (grep { $_ eq $name } @AUTOLOAD_FIELDS) { - $logger->error("hold_notify: $type: invalid autoload field: $name"); - die "$type: invalid autoload field: $name\n" - } - - { - no strict 'refs'; - *{"${type}::${name}"} = sub { - my $s = shift; - my $v = shift; - $s->{$name} = $v if defined $v; - return $s->{$name}; - } - } - return $self->$name($data); -} - - -sub new { - my( $class, %args ) = @_; - $class = ref($class) || $class; - my $self = bless( {}, $class ); - $self->editor( new_editor( xact => 1, requestor => $args{requestor} )); - $logger->debug("circulator: creating new hold-notifier with requestor ". - $self->editor->requestor->id); - $self->fetch_data($args{hold_id}); - return $self; -} - -sub send_email_notify { - my $self = shift; - - my $sc = OpenSRF::Utils::SettingsClient->new; - my $setting = $sc->config_value( - qw/ apps open-ils.circ app_settings notify_hold email / ); - - $logger->debug("hold_notify: email enabled setting = $setting"); - - if( !$setting or $setting ne 'true' ) { - $self->editor->rollback; - $logger->info("hold_notify: not sending hold notify - email notifications disabled"); - return 0; - } - - unless ($U->is_true($self->hold->email_notify)) { - $self->editor->rollback; - $logger->info("hold_notify: not sending hold notification because email_notify is false"); - return 0; - } - - unless( $self->patron->email and $self->patron->email =~ /.+\@.+/ ) { # see if it's remotely email-esque - $self->editor->rollback; - return OpenILS::Event->new('PATRON_NO_EMAIL_ADDRESS'); - } - - $logger->info("hold_notify: attempting email notify on hold ".$self->hold->id); - - my $sclient = OpenSRF::Utils::SettingsClient->new; - $self->settings_client($sclient); - my $template = $sclient->config_value('email_notify', 'template'); - my $str = $self->flesh_template($self->load_template($template)); - - unless( $str ) { - $self->editor->rollback; - $logger->error("hold_notify: No email notify template found - cannot notify"); - return 0; - } - - my $reqr = $self->editor->requestor; - $self->editor->rollback; # we're done with this transaction - - return 0 unless $self->send_email($str); - - # ------------------------------------------------------------------ - # If the hold email takes too long to send, the existing editor - # transaction may have timed out. Create a one-off editor to write - # the notification to the DB. - # ------------------------------------------------------------------ - my $we = new_editor(xact=>1, requestor=>$reqr); - - my $notify = Fieldmapper::action::hold_notification->new; - $notify->hold($self->hold->id); - $notify->notify_staff($we->requestor->id); - $notify->notify_time('now'); - $notify->method('email'); - - $we->create_action_hold_notification($notify) - or return $we->die_event; - $we->commit; - - return 1; -} - -sub send_email { - my( $self, $text ) = @_; - - # !!! $self->editor xact has been rolled back before we get here - - my $smtp = $self->settings_client->config_value('email_notify', 'smtp_server'); - - $logger->info("hold_notify: sending email notice to ". - $self->patron->email." with SMTP server $smtp"); - - my $sender = Email::Send->new({mailer => 'SMTP'}); - $sender->mailer_args([Host => $smtp]); - - my $stat; - my $err; - - try { - $stat = $sender->send($text); - } catch Error with { - $err = $stat = shift; - $logger->error("hold_notify: Email notify failed with error: $err"); - }; - - if( !$err and $stat and $stat->type eq 'success' ) { - $logger->info("hold_notify: successfully sent hold notification"); - return 1; - } else { - $logger->warn("hold_notify: unable to send hold notification: ".Dumper($stat)); - return 0; - } - - return undef; -} - - -# ------------------------------------------------------------------------- -# Fetches all of the hold-related data -# ------------------------------------------------------------------------- -sub fetch_data { - my $self = shift; - my $holdid = shift; - my $e = $self->editor; - - $logger->debug("circulator: fetching hold notify data"); - - $self->hold($e->retrieve_action_hold_request($holdid)) or return $self->event($e->event); - $self->copy($e->retrieve_asset_copy($self->hold->current_copy)) or return $self->event($e->event); - $self->volume($e->retrieve_asset_call_number($self->copy->call_number)) or return $self->event($e->event); - $self->title($e->retrieve_biblio_record_entry($self->volume->record)) or return $self->event($e->event); - $self->patron($e->retrieve_actor_user($self->hold->usr)) or return $self->event($e->event); - $self->pickup_lib($e->retrieve_actor_org_unit($self->hold->pickup_lib)) or return $self->event($e->event); -} - - -sub extract_data { - my $self = shift; - my $e = $self->editor; - - my $patron = $self->patron; - my $o_name = $self->pickup_lib->name; - my $p_name = $patron->first_given_name .' '.$patron->family_name; - - # try to find a suitable address for the patron - my $p_addr; - my $p_addrs; - unless( $p_addr = - $e->retrieve_actor_user_address($patron->billing_address)) { - unless( $p_addr = - $e->retrieve_actor_user_address($patron->mailing_address)) { - $logger->warn("hold_notify: No address for user ".$patron->id); - $p_addrs = ""; - } - } - - unless( defined $p_addrs ) { - $p_addrs = - $p_addr->street1." ". - $p_addr->street2." ". - $p_addr->city." ". - $p_addr->state." ". - $p_addr->post_code; - } - - my $l_addr = $e->retrieve_actor_org_address($self->pickup_lib->holds_address); - my $l_addrs = (!$l_addr) ? "" : - $l_addr->street1." ". - $l_addr->street2." ". - $l_addr->city." ". - $l_addr->state." ". - $l_addr->post_code; - - my $title; - my $author; - - if( $self->title->id == OILS_PRECAT_RECORD ) { - $title = ($self->copy->dummy_title) ? - $self->copy->dummy_title : ""; - $author = ($self->copy->dummy_author) ? - $self->copy->dummy_author : ""; - } else { - my $mods = $U->record_to_mvr($self->title); - $title = ($mods->title) ? $mods->title : ""; - $author = ($mods->author) ? $mods->author : ""; - } - - - return { - patron_email => $self->patron->email, - pickup_lib_name => $o_name, - pickup_lib_addr => $l_addrs, - patron_name => $p_name, - patron_addr => $p_addrs, - title => $title, - author => $author, - call_number => $self->volume->label, - copy_barcode => $self->copy->barcode, - copy_number => $self->copy->copy_number, - }; -} - - - -sub load_template { - my $self = shift; - my $template = shift; - - unless( open(F, $template) ) { - $logger->error("hold_notify: Unable to open hold notification template file: $template"); - return undef; - } - - # load the template, strip comments - my @lines = ; - close(F); - - my $str = ''; - for(@lines) { - chomp $_; - next if $_ =~ /^\s*\#/o; - $_ =~ s/\#.*//og; - $str .= "$_\n"; - } - - return $str; -} - -sub flesh_template { - my( $self, $str ) = @_; - return undef unless $str; - - my @time = CORE::localtime(); - my $day = $time[3]; - my $month = $time[4] + 1; - my $year = $time[5] + 1900; - - my $data = $self->extract_data; - - my $email = $$data{patron_email}; - my $p_name = $$data{patron_name}; - my $p_addr = $$data{patron_addr}; - my $o_name = $$data{pickup_lib_name}; - my $o_addr = $$data{pickup_lib_addr}; - my $title = $$data{title}; - my $author = $$data{author}; - my $cn = $$data{call_number}; - my $barcode = $$data{copy_barcode}; - my $copy_number = $$data{copy_number}; - - my $sender = $self->settings_client->config_value('email_notify', 'sender_address'); - my $reply_to = $self->pickup_lib->email; - $reply_to ||= $sender; - - # if they have an org setting for bounced emails, use that as the sender address - if( my $set = $self->editor->search_actor_org_unit_setting( - { name => OILS_SETTING_ORG_BOUNCED_EMAIL, - org_unit => $self->pickup_lib->id } )->[0] ) { - - my $bemail = OpenSRF::Utils::JSON->JSON2perl($set->value); - $sender = $bemail if $bemail; - } - - $str =~ s/\${EMAIL_SENDER}/$sender/; - $str =~ s/\${EMAIL_RECIPIENT}/$email/; - $str =~ s/\${EMAIL_REPLY_TO}/$reply_to/; - $str =~ s/\${EMAIL_HEADERS}//; - - $str =~ s/\${DATE}/$year-$month-$day/; - $str =~ s/\${LIBRARY}/$o_name/; - $str =~ s/\${LIBRARY_ADDRESS}/$o_addr/; - $str =~ s/\${PATRON_NAME}/$p_name/; - $str =~ s/\${PATRON_ADDRESS}/$p_addr/; - - $str =~ s/\${TITLE}/$title/; - $str =~ s/\${AUTHOR}/$author/; - $str =~ s/\${CALL_NUMBER}/$cn/; - $str =~ s/\${COPY_BARCODE}/$barcode/; - $str =~ s/\${COPY_NUMBER}/$copy_number/; - - return $str; -} - - - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ/Holds.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ/Holds.pm deleted file mode 100644 index c95bafe6f2..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ/Holds.pm +++ /dev/null @@ -1,3356 +0,0 @@ -# --------------------------------------------------------------- -# Copyright (C) 2005 Georgia Public Library Service -# Bill Erickson - -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# --------------------------------------------------------------- - - -package OpenILS::Application::Circ::Holds; -use base qw/OpenILS::Application/; -use strict; use warnings; -use OpenILS::Application::AppUtils; -use DateTime; -use Data::Dumper; -use OpenSRF::EX qw(:try); -use OpenILS::Perm; -use OpenILS::Event; -use OpenSRF::Utils; -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Utils::PermitHold; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Const qw/:const/; -use OpenILS::Application::Circ::Transit; -use OpenILS::Application::Actor::Friends; -use DateTime; -use DateTime::Format::ISO8601; -use OpenSRF::Utils qw/:datetime/; -use Digest::MD5 qw(md5_hex); -use OpenSRF::Utils::Cache; -my $apputils = "OpenILS::Application::AppUtils"; -my $U = $apputils; - - -__PACKAGE__->register_method( - method => "create_hold_batch", - api_name => "open-ils.circ.holds.create.batch", - stream => 1, - signature => { - desc => q/@see open-ils.circ.holds.create.batch/, - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'Array of hold objects', type => 'array' } - ], - return => { - desc => 'Array of hold ID on success, -1 on missing arg, event (or ref to array of events) on error(s)', - }, - } -); - -__PACKAGE__->register_method( - method => "create_hold_batch", - api_name => "open-ils.circ.holds.create.override.batch", - stream => 1, - signature => { - desc => '@see open-ils.circ.holds.create.batch', - } -); - - -sub create_hold_batch { - my( $self, $conn, $auth, $hold_list ) = @_; - (my $method = $self->api_name) =~ s/\.batch//og; - foreach (@$hold_list) { - my ($res) = $self->method_lookup($method)->run($auth, $_); - $conn->respond($res); - } - return undef; -} - - -__PACKAGE__->register_method( - method => "create_hold", - api_name => "open-ils.circ.holds.create", - signature => { - desc => "Create a new hold for an item. From a permissions perspective, " . - "the login session is used as the 'requestor' of the hold. " . - "The hold recipient is determined by the 'usr' setting within the hold object. " . - 'First we verify the requestor has holds request permissions. ' . - 'Then we verify that the recipient is allowed to make the given hold. ' . - 'If not, we see if the requestor has "override" capabilities. If not, ' . - 'a permission exception is returned. If permissions allow, we cycle ' . - 'through the set of holds objects and create. ' . - 'If the recipient does not have permission to place multiple holds ' . - 'on a single title and said operation is attempted, a permission ' . - 'exception is returned', - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'Hold object for hold to be created', - type => 'object', class => 'ahr' } - ], - return => { - desc => 'New ahr ID on success, -1 on missing arg, event (or ref to array of events) on error(s)', - }, - } -); - -__PACKAGE__->register_method( - method => "create_hold", - api_name => "open-ils.circ.holds.create.override", - notes => '@see open-ils.circ.holds.create', - signature => { - desc => "If the recipient is not allowed to receive the requested hold, " . - "call this method to attempt the override", - params => [ - { desc => 'Authentication token', type => 'string' }, - { - desc => 'Hold object for hold to be created', - type => 'object', class => 'ahr' - } - ], - return => { - desc => 'New hold (ahr) ID on success, -1 on missing arg, event (or ref to array of events) on error(s)', - }, - } -); - -sub create_hold { - my( $self, $conn, $auth, $hold ) = @_; - return -1 unless $hold; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - - my $override = 1 if $self->api_name =~ /override/; - - my @events; - - my $requestor = $e->requestor; - my $recipient = $requestor; - - if( $requestor->id ne $hold->usr ) { - # Make sure the requestor is allowed to place holds for - # the recipient if they are not the same people - $recipient = $e->retrieve_actor_user($hold->usr) or return $e->die_event; - $e->allowed('REQUEST_HOLDS', $recipient->home_ou) or return $e->die_event; - } - - # If the related org setting tells us to, block if patron privs have expired - my $expire_setting = $U->ou_ancestor_setting_value($recipient->home_ou, OILS_SETTING_BLOCK_HOLD_FOR_EXPIRED_PATRON); - if ($expire_setting) { - my $expire = DateTime::Format::ISO8601->new->parse_datetime( - cleanse_ISO8601($recipient->expire_date)); - - push( @events, OpenILS::Event->new( - 'PATRON_ACCOUNT_EXPIRED', - "payload" => {"fail_part" => "actor.usr.privs_expired"} - )) if( CORE::time > $expire->epoch ) ; - } - - # Now make sure the recipient is allowed to receive the specified hold - my $porg = $recipient->home_ou; - my $rid = $e->requestor->id; - my $t = $hold->hold_type; - - # See if a duplicate hold already exists - my $sargs = { - usr => $recipient->id, - hold_type => $t, - fulfillment_time => undef, - target => $hold->target, - cancel_time => undef, - }; - - $sargs->{holdable_formats} = $hold->holdable_formats if $t eq 'M'; - - my $existing = $e->search_action_hold_request($sargs); - push( @events, OpenILS::Event->new('HOLD_EXISTS')) if @$existing; - - my $checked_out = hold_item_is_checked_out($e, $recipient->id, $hold->hold_type, $hold->target); - push( @events, OpenILS::Event->new('HOLD_ITEM_CHECKED_OUT')) if $checked_out; - - if ( $t eq OILS_HOLD_TYPE_METARECORD ) { - return $e->die_event unless $e->allowed('MR_HOLDS', $porg); - } elsif ( $t eq OILS_HOLD_TYPE_TITLE ) { - return $e->die_event unless $e->allowed('TITLE_HOLDS', $porg); - } elsif ( $t eq OILS_HOLD_TYPE_VOLUME ) { - return $e->die_event unless $e->allowed('VOLUME_HOLDS', $porg); - } elsif ( $t eq OILS_HOLD_TYPE_ISSUANCE ) { - return $e->die_event unless $e->allowed('ISSUANCE_HOLDS', $porg); - } elsif ( $t eq OILS_HOLD_TYPE_COPY ) { - return $e->die_event unless $e->allowed('COPY_HOLDS', $porg); - } elsif ( $t eq OILS_HOLD_TYPE_FORCE ) { - return $e->die_event unless $e->allowed('COPY_HOLDS', $porg); - } elsif ( $t eq OILS_HOLD_TYPE_RECALL ) { - return $e->die_event unless $e->allowed('COPY_HOLDS', $porg); - } - - if( @events ) { - if (!$override) { - $e->rollback; - return \@events; - } - for my $evt (@events) { - next unless $evt; - my $name = $evt->{textcode}; - return $e->die_event unless $e->allowed("$name.override", $porg); - } - } - - # set the configured expire time - unless($hold->expire_time) { - my $interval = $U->ou_ancestor_setting_value($recipient->home_ou, OILS_SETTING_HOLD_EXPIRE); - if($interval) { - my $date = DateTime->now->add(seconds => OpenSRF::Utils::interval_to_seconds($interval)); - $hold->expire_time($U->epoch2ISO8601($date->epoch)); - } - } - - $hold->requestor($e->requestor->id); - $hold->request_lib($e->requestor->ws_ou); - $hold->selection_ou($hold->pickup_lib) unless $hold->selection_ou; - $hold = $e->create_action_hold_request($hold) or return $e->die_event; - - $e->commit; - - $conn->respond_complete($hold->id); - - $U->storagereq( - 'open-ils.storage.action.hold_request.copy_targeter', - undef, $hold->id ) unless $U->is_true($hold->frozen); - - return undef; -} - -# makes sure that a user has permission to place the type of requested hold -# returns the Perm exception if not allowed, returns undef if all is well -sub _check_holds_perm { - my($type, $user_id, $org_id) = @_; - - my $evt; - if ($type eq "M") { - $evt = $apputils->check_perms($user_id, $org_id, "MR_HOLDS" ); - } elsif ($type eq "T") { - $evt = $apputils->check_perms($user_id, $org_id, "TITLE_HOLDS" ); - } elsif($type eq "V") { - $evt = $apputils->check_perms($user_id, $org_id, "VOLUME_HOLDS"); - } elsif($type eq "C") { - $evt = $apputils->check_perms($user_id, $org_id, "COPY_HOLDS" ); - } - - return $evt if $evt; - return undef; -} - -# tests if the given user is allowed to place holds on another's behalf -sub _check_request_holds_perm { - my $user_id = shift; - my $org_id = shift; - if (my $evt = $apputils->check_perms( - $user_id, $org_id, "REQUEST_HOLDS")) { - return $evt; - } -} - -my $ses_is_req_note = 'The login session is the requestor. If the requestor is different from the user, ' . - 'then the requestor must have VIEW_HOLD permissions'; - -__PACKAGE__->register_method( - method => "retrieve_holds_by_id", - api_name => "open-ils.circ.holds.retrieve_by_id", - signature => { - desc => "Retrieve the hold, with hold transits attached, for the specified ID. $ses_is_req_note", - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'Hold ID', type => 'number' } - ], - return => { - desc => 'Hold object with transits attached, event on error', - } - } -); - - -sub retrieve_holds_by_id { - my($self, $client, $auth, $hold_id) = @_; - my $e = new_editor(authtoken=>$auth); - $e->checkauth or return $e->event; - $e->allowed('VIEW_HOLD') or return $e->event; - - my $holds = $e->search_action_hold_request( - [ - { id => $hold_id , fulfillment_time => undef }, - { - order_by => { ahr => "request_time" }, - flesh => 1, - flesh_fields => {ahr => ['notes']} - } - ] - ); - - flesh_hold_transits($holds); - flesh_hold_notices($holds, $e); - return $holds; -} - - -__PACKAGE__->register_method( - method => "retrieve_holds", - api_name => "open-ils.circ.holds.retrieve", - signature => { - desc => "Retrieves all the holds, with hold transits attached, for the specified user. $ses_is_req_note", - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'User ID', type => 'integer' } - ], - return => { - desc => 'list of holds, event on error', - } - } -); - -__PACKAGE__->register_method( - method => "retrieve_holds", - api_name => "open-ils.circ.holds.id_list.retrieve", - authoritative => 1, - signature => { - desc => "Retrieves all the hold IDs, for the specified user. $ses_is_req_note", - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'User ID', type => 'integer' } - ], - return => { - desc => 'list of holds, event on error', - } - } -); - -__PACKAGE__->register_method( - method => "retrieve_holds", - api_name => "open-ils.circ.holds.canceled.retrieve", - authoritative => 1, - signature => { - desc => "Retrieves all the cancelled holds for the specified user. $ses_is_req_note", - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'User ID', type => 'integer' } - ], - return => { - desc => 'list of holds, event on error', - } - } -); - -__PACKAGE__->register_method( - method => "retrieve_holds", - api_name => "open-ils.circ.holds.canceled.id_list.retrieve", - authoritative => 1, - signature => { - desc => "Retrieves list of cancelled hold IDs for the specified user. $ses_is_req_note", - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'User ID', type => 'integer' } - ], - return => { - desc => 'list of hold IDs, event on error', - } - } -); - - -sub retrieve_holds { - my ($self, $client, $auth, $user_id) = @_; - - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - $user_id = $e->requestor->id unless defined $user_id; - - my $notes_filter = {staff => 'f'}; - my $user = $e->retrieve_actor_user($user_id) or return $e->event; - unless($user_id == $e->requestor->id) { - if($e->allowed('VIEW_HOLD', $user->home_ou)) { - $notes_filter = {staff => 't'} - } else { - my $allowed = OpenILS::Application::Actor::Friends->friend_perm_allowed( - $e, $user_id, $e->requestor->id, 'hold.view'); - return $e->event unless $allowed; - } - } else { - # staff member looking at his/her own holds can see staff and non-staff notes - $notes_filter = {} if $e->allowed('VIEW_HOLD', $user->home_ou); - } - - my $holds_query = { - select => {ahr => ['id']}, - from => 'ahr', - where => {usr => $user_id, fulfillment_time => undef} - }; - - if($self->api_name =~ /canceled/) { - - # Fetch the canceled holds - # order cancelled holds by cancel time, most recent first - - $holds_query->{order_by} = [{class => 'ahr', field => 'cancel_time', direction => 'desc'}]; - - my $cancel_age; - my $cancel_count = $U->ou_ancestor_setting_value( - $e->requestor->ws_ou, 'circ.holds.canceled.display_count', $e); - - unless($cancel_count) { - $cancel_age = $U->ou_ancestor_setting_value( - $e->requestor->ws_ou, 'circ.holds.canceled.display_age', $e); - - # if no settings are defined, default to last 10 cancelled holds - $cancel_count = 10 unless $cancel_age; - } - - if($cancel_count) { # limit by count - - $holds_query->{where}->{cancel_time} = {'!=' => undef}; - $holds_query->{limit} = $cancel_count; - - } elsif($cancel_age) { # limit by age - - # find all of the canceled holds that were canceled within the configured time frame - my $date = DateTime->now->subtract(seconds => OpenSRF::Utils::interval_to_seconds($cancel_age)); - $date = $U->epoch2ISO8601($date->epoch); - $holds_query->{where}->{cancel_time} = {'>=' => $date}; - } - - } else { - - # order non-cancelled holds by ready-for-pickup, then active, followed by suspended - $holds_query->{order_by} = {ahr => ['shelf_time', 'frozen', 'request_time']}; - $holds_query->{where}->{cancel_time} = undef; - } - - my $hold_ids = $e->json_query($holds_query); - $hold_ids = [ map { $_->{id} } @$hold_ids ]; - - return $hold_ids if $self->api_name =~ /id_list/; - - my @holds; - for my $hold_id ( @$hold_ids ) { - - my $hold = $e->retrieve_action_hold_request($hold_id); - $hold->notes($e->search_action_hold_request_note({hold => $hold_id, %$notes_filter})); - - $hold->transit( - $e->search_action_hold_transit_copy([ - {hold => $hold->id}, - {order_by => {ahtc => 'source_send_time desc'}, limit => 1}])->[0] - ); - - push(@holds, $hold); - } - - return \@holds; -} - - -__PACKAGE__->register_method( - method => 'user_hold_count', - api_name => 'open-ils.circ.hold.user.count' -); - -sub user_hold_count { - my ( $self, $conn, $auth, $userid ) = @_; - my $e = new_editor( authtoken => $auth ); - return $e->event unless $e->checkauth; - my $patron = $e->retrieve_actor_user($userid) - or return $e->event; - return $e->event unless $e->allowed( 'VIEW_HOLD', $patron->home_ou ); - return __user_hold_count( $self, $e, $userid ); -} - -sub __user_hold_count { - my ( $self, $e, $userid ) = @_; - my $holds = $e->search_action_hold_request( - { - usr => $userid, - fulfillment_time => undef, - cancel_time => undef, - }, - { idlist => 1 } - ); - - return scalar(@$holds); -} - - -__PACKAGE__->register_method( - method => "retrieve_holds_by_pickup_lib", - api_name => "open-ils.circ.holds.retrieve_by_pickup_lib", - notes => - "Retrieves all the holds, with hold transits attached, for the specified pickup_ou id." -); - -__PACKAGE__->register_method( - method => "retrieve_holds_by_pickup_lib", - api_name => "open-ils.circ.holds.id_list.retrieve_by_pickup_lib", - notes => "Retrieves all the hold ids for the specified pickup_ou id. " -); - -sub retrieve_holds_by_pickup_lib { - my ($self, $client, $login_session, $ou_id) = @_; - - #FIXME -- put an appropriate permission check here - #my( $user, $target, $evt ) = $apputils->checkses_requestor( - # $login_session, $user_id, 'VIEW_HOLD' ); - #return $evt if $evt; - - my $holds = $apputils->simplereq( - 'open-ils.cstore', - "open-ils.cstore.direct.action.hold_request.search.atomic", - { - pickup_lib => $ou_id , - fulfillment_time => undef, - cancel_time => undef - }, - { order_by => { ahr => "request_time" } } - ); - - if ( ! $self->api_name =~ /id_list/ ) { - flesh_hold_transits($holds); - return $holds; - } - # else id_list - return [ map { $_->id } @$holds ]; -} - - -__PACKAGE__->register_method( - method => "uncancel_hold", - api_name => "open-ils.circ.hold.uncancel" -); - -sub uncancel_hold { - my($self, $client, $auth, $hold_id) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - - my $hold = $e->retrieve_action_hold_request($hold_id) - or return $e->die_event; - return $e->die_event unless $e->allowed('CANCEL_HOLDS', $hold->request_lib); - - if ($hold->fulfillment_time) { - $e->rollback; - return 0; - } - unless ($hold->cancel_time) { - $e->rollback; - return 1; - } - - # if configured to reset the request time, also reset the expire time - if($U->ou_ancestor_setting_value( - $hold->request_lib, 'circ.holds.uncancel.reset_request_time', $e)) { - - $hold->request_time('now'); - my $interval = $U->ou_ancestor_setting_value($hold->request_lib, OILS_SETTING_HOLD_EXPIRE); - if($interval) { - my $date = DateTime->now->add(seconds => OpenSRF::Utils::interval_to_seconds($interval)); - $hold->expire_time($U->epoch2ISO8601($date->epoch)); - } - } - - $hold->clear_cancel_time; - $hold->clear_cancel_cause; - $hold->clear_cancel_note; - $e->update_action_hold_request($hold) or return $e->die_event; - $e->commit; - - $U->storagereq('open-ils.storage.action.hold_request.copy_targeter', undef, $hold_id); - - return 1; -} - - -__PACKAGE__->register_method( - method => "cancel_hold", - api_name => "open-ils.circ.hold.cancel", - signature => { - desc => 'Cancels the specified hold. The login session is the requestor. If the requestor is different from the usr field ' . - 'on the hold, the requestor must have CANCEL_HOLDS permissions. The hold may be either the hold object or the hold id', - param => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Hold ID', type => 'number'}, - {desc => 'Cause of Cancellation', type => 'string'}, - {desc => 'Note', type => 'string'} - ], - return => { - desc => '1 on success, event on error' - } - } -); - -sub cancel_hold { - my($self, $client, $auth, $holdid, $cause, $note) = @_; - - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - - my $hold = $e->retrieve_action_hold_request($holdid) - or return $e->die_event; - - if( $e->requestor->id ne $hold->usr ) { - return $e->die_event unless $e->allowed('CANCEL_HOLDS'); - } - - if ($hold->cancel_time) { - $e->rollback; - return 1; - } - - # If the hold is captured, reset the copy status - if( $hold->capture_time and $hold->current_copy ) { - - my $copy = $e->retrieve_asset_copy($hold->current_copy) - or return $e->die_event; - - if( $copy->status == OILS_COPY_STATUS_ON_HOLDS_SHELF ) { - $logger->info("canceling hold $holdid whose item is on the holds shelf"); -# $logger->info("setting copy to status 'reshelving' on hold cancel"); -# $copy->status(OILS_COPY_STATUS_RESHELVING); -# $copy->editor($e->requestor->id); -# $copy->edit_date('now'); -# $e->update_asset_copy($copy) or return $e->event; - - } elsif( $copy->status == OILS_COPY_STATUS_IN_TRANSIT ) { - - my $hid = $hold->id; - $logger->warn("! canceling hold [$hid] that is in transit"); - my $transid = $e->search_action_hold_transit_copy({hold=>$hold->id},{idlist=>1})->[0]; - - if( $transid ) { - my $trans = $e->retrieve_action_transit_copy($transid); - # Leave the transit alive, but set the copy status to - # reshelving so it will be properly reshelved when it gets back home - if( $trans ) { - $trans->copy_status( OILS_COPY_STATUS_RESHELVING ); - $e->update_action_transit_copy($trans) or return $e->die_event; - } - } - } - } - - $hold->cancel_time('now'); - $hold->cancel_cause($cause); - $hold->cancel_note($note); - $e->update_action_hold_request($hold) - or return $e->die_event; - - delete_hold_copy_maps($self, $e, $hold->id); - - $e->commit; - - $U->create_events_for_hook('hold_request.cancel.staff', $hold, $hold->pickup_lib) - if $e->requestor->id != $hold->usr; - - return 1; -} - -sub delete_hold_copy_maps { - my $class = shift; - my $editor = shift; - my $holdid = shift; - - my $maps = $editor->search_action_hold_copy_map({hold=>$holdid}); - for(@$maps) { - $editor->delete_action_hold_copy_map($_) - or return $editor->event; - } - return undef; -} - - -my $update_hold_desc = 'The login session is the requestor. ' . - 'If the requestor is different from the usr field on the hold, ' . - 'the requestor must have UPDATE_HOLDS permissions. ' . - 'If supplying a hash of hold data, "id" must be included. ' . - 'The hash is ignored if a hold object is supplied, ' . - 'so you should supply only one kind of hold data argument.' ; - -__PACKAGE__->register_method( - method => "update_hold", - api_name => "open-ils.circ.hold.update", - signature => { - desc => "Updates the specified hold. $update_hold_desc", - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Hold Object', type => 'object'}, - {desc => 'Hash of values to be applied', type => 'object'} - ], - return => { - desc => 'Hold ID on success, event on error', - # type => 'number' - } - } -); - -__PACKAGE__->register_method( - method => "batch_update_hold", - api_name => "open-ils.circ.hold.update.batch", - stream => 1, - signature => { - desc => "Updates the specified hold(s). $update_hold_desc", - params => [ - {desc => 'Authentication token', type => 'string'}, - {desc => 'Array of hold obejcts', type => 'array' }, - {desc => 'Array of hashes of values to be applied', type => 'array' } - ], - return => { - desc => 'Hold ID per success, event per error', - } - } -); - -sub update_hold { - my($self, $client, $auth, $hold, $values) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - my $resp = update_hold_impl($self, $e, $hold, $values); - if ($U->event_code($resp)) { - $e->rollback; - return $resp; - } - $e->commit; # FIXME: update_hold_impl already does $e->commit ?? - return $resp; -} - -sub batch_update_hold { - my($self, $client, $auth, $hold_list, $values_list) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->die_event unless $e->checkauth; - - my $count = ($hold_list) ? scalar(@$hold_list) : scalar(@$values_list); # FIXME: we don't know for sure that we got $values_list. we could have neither list. - $hold_list ||= []; - $values_list ||= []; # FIXME: either move this above $count declaration, or send an event if both lists undef. Probably the latter. - -# FIXME: Failing over to [] guarantees warnings for "Use of unitialized value" in update_hold_impl call. -# FIXME: We should be sure we only call update_hold_impl with hold object OR hash, not both. - - for my $idx (0..$count-1) { - $e->xact_begin; - my $resp = update_hold_impl($self, $e, $hold_list->[$idx], $values_list->[$idx]); - $e->xact_commit unless $U->event_code($resp); - $client->respond($resp); - } - - $e->disconnect; - return undef; # not in the register return type, assuming we should always have at least one list populated -} - -sub update_hold_impl { - my($self, $e, $hold, $values) = @_; - - unless($hold) { - $hold = $e->retrieve_action_hold_request($values->{id}) - or return $e->die_event; - for my $k (keys %$values) { - if (defined $values->{$k}) { - $hold->$k($values->{$k}); - } else { - my $f = "clear_$k"; $hold->$f(); - } - } - } - - my $orig_hold = $e->retrieve_action_hold_request($hold->id) - or return $e->die_event; - - # don't allow the user to be changed - return OpenILS::Event->new('BAD_PARAMS') if $hold->usr != $orig_hold->usr; - - if($hold->usr ne $e->requestor->id) { - # if the hold is for a different user, make sure the - # requestor has the appropriate permissions - my $usr = $e->retrieve_actor_user($hold->usr) - or return $e->die_event; - return $e->die_event unless $e->allowed('UPDATE_HOLD', $usr->home_ou); - } - - - # -------------------------------------------------------------- - # Changing the request time is like playing God - # -------------------------------------------------------------- - if($hold->request_time ne $orig_hold->request_time) { - return OpenILS::Event->new('BAD_PARAMS') if $hold->fulfillment_time; - return $e->die_event unless $e->allowed('UPDATE_HOLD_REQUEST_TIME', $hold->pickup_lib); - } - - # -------------------------------------------------------------- - # if the hold is on the holds shelf or in transit and the pickup - # lib changes we need to create a new transit. - # -------------------------------------------------------------- - if($orig_hold->pickup_lib ne $hold->pickup_lib) { - - my $status = _hold_status($e, $hold); - - if($status == 3) { # in transit - - return $e->die_event unless $e->allowed('UPDATE_PICKUP_LIB_FROM_TRANSIT', $orig_hold->pickup_lib); - return $e->die_event unless $e->allowed('UPDATE_PICKUP_LIB_FROM_TRANSIT', $hold->pickup_lib); - - $logger->info("updating pickup lib for hold ".$hold->id." while already in transit"); - - # update the transit to reflect the new pickup location - my $transit = $e->search_action_hold_transit_copy( - {hold=>$hold->id, dest_recv_time => undef})->[0] - or return $e->die_event; - - $transit->prev_dest($transit->dest); # mark the previous destination on the transit - $transit->dest($hold->pickup_lib); - $e->update_action_hold_transit_copy($transit) or return $e->die_event; - - } elsif($status == 4) { # on holds shelf - - return $e->die_event unless $e->allowed('UPDATE_PICKUP_LIB_FROM_HOLDS_SHELF', $orig_hold->pickup_lib); - return $e->die_event unless $e->allowed('UPDATE_PICKUP_LIB_FROM_HOLDS_SHELF', $hold->pickup_lib); - - $logger->info("updating pickup lib for hold ".$hold->id." while on holds shelf"); - - # create the new transit - my $evt = transit_hold($e, $orig_hold, $hold, $e->retrieve_asset_copy($hold->current_copy)); - return $evt if $evt; - } - } - - update_hold_if_frozen($self, $e, $hold, $orig_hold); - $e->update_action_hold_request($hold) or return $e->die_event; - $e->commit; - - # a change to mint-condition changes the set of potential copies, so retarget the hold; - if($U->is_true($hold->mint_condition) and !$U->is_true($orig_hold->mint_condition)) { - _reset_hold($self, $e->requestor, $hold) - } - - return $hold->id; -} - -sub transit_hold { - my($e, $orig_hold, $hold, $copy) = @_; - my $src = $orig_hold->pickup_lib; - my $dest = $hold->pickup_lib; - - $logger->info("putting hold into transit on pickup_lib update"); - - my $transit = Fieldmapper::action::hold_transit_copy->new; - $transit->hold($hold->id); - $transit->source($src); - $transit->dest($dest); - $transit->target_copy($copy->id); - $transit->source_send_time('now'); - $transit->copy_status(OILS_COPY_STATUS_ON_HOLDS_SHELF); - - $copy->status(OILS_COPY_STATUS_IN_TRANSIT); - $copy->editor($e->requestor->id); - $copy->edit_date('now'); - - $e->create_action_hold_transit_copy($transit) or return $e->die_event; - $e->update_asset_copy($copy) or return $e->die_event; - return undef; -} - -# if the hold is frozen, this method ensures that the hold is not "targeted", -# that is, it clears the current_copy and prev_check_time to essentiallly -# reset the hold. If it is being activated, it runs the targeter in the background -sub update_hold_if_frozen { - my($self, $e, $hold, $orig_hold) = @_; - return if $hold->capture_time; - - if($U->is_true($hold->frozen)) { - $logger->info("clearing current_copy and check_time for frozen hold ".$hold->id); - $hold->clear_current_copy; - $hold->clear_prev_check_time; - - } else { - if($U->is_true($orig_hold->frozen)) { - $logger->info("Running targeter on activated hold ".$hold->id); - $U->storagereq( 'open-ils.storage.action.hold_request.copy_targeter', undef, $hold->id ); - } - } -} - -__PACKAGE__->register_method( - method => "hold_note_CUD", - api_name => "open-ils.circ.hold_request.note.cud", - signature => { - desc => 'Create, update or delete a hold request note. If the operator (from Auth. token) ' - . 'is not the owner of the hold, the UPDATE_HOLD permission is required', - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'Hold note object', type => 'object' } - ], - return => { - desc => 'Returns the note ID, event on error' - }, - } -); - -sub hold_note_CUD { - my($self, $conn, $auth, $note) = @_; - - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - - my $hold = $e->retrieve_action_hold_request($note->hold) - or return $e->die_event; - - if($hold->usr ne $e->requestor->id) { - my $usr = $e->retrieve_actor_user($hold->usr); - return $e->die_event unless $e->allowed('UPDATE_HOLD', $usr->home_ou); - $note->staff('t') if $note->isnew; - } - - if($note->isnew) { - $e->create_action_hold_request_note($note) or return $e->die_event; - } elsif($note->ischanged) { - $e->update_action_hold_request_note($note) or return $e->die_event; - } elsif($note->isdeleted) { - $e->delete_action_hold_request_note($note) or return $e->die_event; - } - - $e->commit; - return $note->id; -} - - -__PACKAGE__->register_method( - method => "retrieve_hold_status", - api_name => "open-ils.circ.hold.status.retrieve", - signature => { - desc => 'Calculates the current status of the hold. The requestor must have ' . - 'VIEW_HOLD permissions if the hold is for a user other than the requestor' , - param => [ - { desc => 'Hold ID', type => 'number' } - ], - return => { - # type => 'number', # event sometimes - desc => <<'END_OF_DESC' -Returns event on error or: --1 on error (for now), - 1 for 'waiting for copy to become available', - 2 for 'waiting for copy capture', - 3 for 'in transit', - 4 for 'arrived', - 5 for 'hold-shelf-delay' - 6 for 'canceled' -END_OF_DESC - } - } -); - -sub retrieve_hold_status { - my($self, $client, $auth, $hold_id) = @_; - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - my $hold = $e->retrieve_action_hold_request($hold_id) - or return $e->event; - - if( $e->requestor->id != $hold->usr ) { - return $e->event unless $e->allowed('VIEW_HOLD'); - } - - return _hold_status($e, $hold); - -} - -sub _hold_status { - my($e, $hold) = @_; - if ($hold->cancel_time) { - return 6; - } - return 1 unless $hold->current_copy; - return 2 unless $hold->capture_time; - - my $copy = $hold->current_copy; - unless( ref $copy ) { - $copy = $e->retrieve_asset_copy($hold->current_copy) - or return $e->event; - } - - return 3 if $copy->status == OILS_COPY_STATUS_IN_TRANSIT; - - if($copy->status == OILS_COPY_STATUS_ON_HOLDS_SHELF) { - - my $hs_wait_interval = $U->ou_ancestor_setting_value($hold->pickup_lib, 'circ.hold_shelf_status_delay'); - return 4 unless $hs_wait_interval; - - # if a hold_shelf_status_delay interval is defined and start_time plus - # the interval is greater than now, consider the hold to be in the virtual - # "on its way to the holds shelf" status. Return 5. - - my $transit = $e->search_action_hold_transit_copy({hold => $hold->id})->[0]; - my $start_time = ($transit) ? $transit->dest_recv_time : $hold->capture_time; - $start_time = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($start_time)); - my $end_time = $start_time->add(seconds => OpenSRF::Utils::interval_to_seconds($hs_wait_interval)); - - return 5 if $end_time > DateTime->now; - return 4; - } - - return -1; # error -} - - - -__PACKAGE__->register_method( - method => "retrieve_hold_queue_stats", - api_name => "open-ils.circ.hold.queue_stats.retrieve", - signature => { - desc => 'Returns summary data about the state of a hold', - params => [ - { desc => 'Authentication token', type => 'string'}, - { desc => 'Hold ID', type => 'number'}, - ], - return => { - desc => q/Summary object with keys: - total_holds : total holds in queue - queue_position : current queue position - potential_copies : number of potential copies for this hold - estimated_wait : estimated wait time in days - status : hold status - -1 => error or unexpected state, - 1 => 'waiting for copy to become available', - 2 => 'waiting for copy capture', - 3 => 'in transit', - 4 => 'arrived', - 5 => 'hold-shelf-delay' - /, - type => 'object' - } - } -); - -sub retrieve_hold_queue_stats { - my($self, $conn, $auth, $hold_id) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - my $hold = $e->retrieve_action_hold_request($hold_id) or return $e->event; - if($e->requestor->id != $hold->usr) { - return $e->event unless $e->allowed('VIEW_HOLD'); - } - return retrieve_hold_queue_status_impl($e, $hold); -} - -sub retrieve_hold_queue_status_impl { - my $e = shift; - my $hold = shift; - - # The holds queue is defined as the distinct set of holds that share at - # least one potential copy with the context hold, plus any holds that - # share the same hold type and target. The latter part exists to - # accomodate holds that currently have no potential copies - my $q_holds = $e->json_query({ - - # fetch cut_in_line and request_time since they're in the order_by - # and we're asking for distinct values - select => {ahr => ['id', 'cut_in_line', 'request_time']}, - from => { ahr => 'ahcm' }, - order_by => [ - { - "class" => "ahr", - "field" => "cut_in_line", - "transform" => "coalesce", - "params" => [ 0 ], - "direction" => "desc" - }, - { "class" => "ahr", "field" => "request_time" } - ], - distinct => 1, - where => { - '+ahcm' => { - target_copy => { - in => { - select => {ahcm => ['target_copy']}, - from => 'ahcm', - where => {hold => $hold->id} - } - } - } - } - }); - - if (!@$q_holds) { # none? maybe we don't have a map ... - $q_holds = $e->json_query({ - select => {ahr => ['id', 'cut_in_line', 'request_time']}, - from => 'ahr', - order_by => [ - { - "class" => "ahr", - "field" => "cut_in_line", - "transform" => "coalesce", - "params" => [ 0 ], - "direction" => "desc" - }, - { "class" => "ahr", "field" => "request_time" } - ], - where => { - hold_type => $hold->hold_type, - target => $hold->target - } - }); - } - - - my $qpos = 1; - for my $h (@$q_holds) { - last if $h->{id} == $hold->id; - $qpos++; - } - - my $hold_data = $e->json_query({ - select => { - acp => [ {column => 'id', transform => 'count', aggregate => 1, alias => 'count'} ], - ccm => [ {column =>'avg_wait_time'} ] - }, - from => { - ahcm => { - acp => { - join => { - ccm => {type => 'left'} - } - } - } - }, - where => {'+ahcm' => {hold => $hold->id} } - }); - - my $user_org = $e->json_query({select => {au => ['home_ou']}, from => 'au', where => {id => $hold->usr}})->[0]->{home_ou}; - - my $default_wait = $U->ou_ancestor_setting_value($user_org, OILS_SETTING_HOLD_ESIMATE_WAIT_INTERVAL); - my $min_wait = $U->ou_ancestor_setting_value($user_org, 'circ.holds.min_estimated_wait_interval'); - $min_wait = OpenSRF::Utils::interval_to_seconds($min_wait || '0 seconds'); - $default_wait ||= '0 seconds'; - - # Estimated wait time is the average wait time across the set - # of potential copies, divided by the number of potential copies - # times the queue position. - - my $combined_secs = 0; - my $num_potentials = 0; - - for my $wait_data (@$hold_data) { - my $count += $wait_data->{count}; - $combined_secs += $count * - OpenSRF::Utils::interval_to_seconds($wait_data->{avg_wait_time} || $default_wait); - $num_potentials += $count; - } - - my $estimated_wait = -1; - - if($num_potentials) { - my $avg_wait = $combined_secs / $num_potentials; - $estimated_wait = $qpos * ($avg_wait / $num_potentials); - $estimated_wait = $min_wait if $estimated_wait < $min_wait and $estimated_wait != -1; - } - - return { - total_holds => scalar(@$q_holds), - queue_position => $qpos, - potential_copies => $num_potentials, - status => _hold_status( $e, $hold ), - estimated_wait => int($estimated_wait) - }; -} - - -sub fetch_open_hold_by_current_copy { - my $class = shift; - my $copyid = shift; - my $hold = $apputils->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.action.hold_request.search.atomic', - { current_copy => $copyid , cancel_time => undef, fulfillment_time => undef }); - return $hold->[0] if ref($hold); - return undef; -} - -sub fetch_related_holds { - my $class = shift; - my $copyid = shift; - return $apputils->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.action.hold_request.search.atomic', - { current_copy => $copyid , cancel_time => undef, fulfillment_time => undef }); -} - - -__PACKAGE__->register_method( - method => "hold_pull_list", - api_name => "open-ils.circ.hold_pull_list.retrieve", - signature => { - desc => 'Returns (reference to) a list of holds that need to be "pulled" by a given location. ' . - 'The location is determined by the login session.', - params => [ - { desc => 'Limit (optional)', type => 'number'}, - { desc => 'Offset (optional)', type => 'number'}, - ], - return => { - desc => 'reference to a list of holds, or event on failure', - } - } -); - -__PACKAGE__->register_method( - method => "hold_pull_list", - api_name => "open-ils.circ.hold_pull_list.id_list.retrieve", - signature => { - desc => 'Returns (reference to) a list of holds IDs that need to be "pulled" by a given location. ' . - 'The location is determined by the login session.', - params => [ - { desc => 'Limit (optional)', type => 'number'}, - { desc => 'Offset (optional)', type => 'number'}, - ], - return => { - desc => 'reference to a list of holds, or event on failure', - } - } -); - -__PACKAGE__->register_method( - method => "hold_pull_list", - api_name => "open-ils.circ.hold_pull_list.retrieve.count", - signature => { - desc => 'Returns a count of holds that need to be "pulled" by a given location. ' . - 'The location is determined by the login session.', - params => [ - { desc => 'Limit (optional)', type => 'number'}, - { desc => 'Offset (optional)', type => 'number'}, - ], - return => { - desc => 'Holds count (integer), or event on failure', - # type => 'number' - } - } -); - - -sub hold_pull_list { - my( $self, $conn, $authtoken, $limit, $offset ) = @_; - my( $reqr, $evt ) = $U->checkses($authtoken); - return $evt if $evt; - - my $org = $reqr->ws_ou || $reqr->home_ou; - # the perm locaiton shouldn't really matter here since holds - # will exist all over and VIEW_HOLDS should be universal - $evt = $U->check_perms($reqr->id, $org, 'VIEW_HOLD'); - return $evt if $evt; - - if($self->api_name =~ /count/) { - - my $count = $U->storagereq( - 'open-ils.storage.direct.action.hold_request.pull_list.current_copy_circ_lib.status_filtered.count', - $org, $limit, $offset ); - - $logger->info("Grabbing pull list for org unit $org with $count items"); - return $count; - - } elsif( $self->api_name =~ /id_list/ ) { - return $U->storagereq( - 'open-ils.storage.direct.action.hold_request.pull_list.id_list.current_copy_circ_lib.status_filtered.atomic', - $org, $limit, $offset ); - - } else { - return $U->storagereq( - 'open-ils.storage.direct.action.hold_request.pull_list.search.current_copy_circ_lib.status_filtered.atomic', - $org, $limit, $offset ); - } -} - -__PACKAGE__->register_method( - method => "print_hold_pull_list", - api_name => "open-ils.circ.hold_pull_list.print", - signature => { - desc => 'Returns an HTML-formatted holds pull list', - params => [ - { desc => 'Authtoken', type => 'string'}, - { desc => 'Org unit ID. Optional, defaults to workstation org unit', type => 'number'}, - ], - return => { - desc => 'HTML string', - type => 'string' - } - } -); - -sub print_hold_pull_list { - my($self, $client, $auth, $org_id) = @_; - - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - - $org_id = (defined $org_id) ? $org_id : $e->requestor->ws_ou; - return $e->event unless $e->allowed('VIEW_HOLD', $org_id); - - my $hold_ids = $U->storagereq( - 'open-ils.storage.direct.action.hold_request.pull_list.id_list.current_copy_circ_lib.status_filtered.atomic', - $org_id, 10000); - - return undef unless @$hold_ids; - - $client->status(new OpenSRF::DomainObject::oilsContinueStatus); - - # Holds will /NOT/ be in order after this ... - my $holds = $e->search_action_hold_request({id => $hold_ids}, {substream => 1}); - $client->status(new OpenSRF::DomainObject::oilsContinueStatus); - - # ... so we must resort. - my $hold_map = +{map { $_->id => $_ } @$holds}; - my $sorted_holds = []; - push @$sorted_holds, $hold_map->{$_} foreach @$hold_ids; - - return $U->fire_object_event( - undef, "ahr.format.pull_list", $sorted_holds, - $org_id, undef, undef, $client - ); - -} - -__PACKAGE__->register_method( - method => "print_hold_pull_list_stream", - stream => 1, - api_name => "open-ils.circ.hold_pull_list.print.stream", - signature => { - desc => 'Returns a stream of fleshed holds', - params => [ - { desc => 'Authtoken', type => 'string'}, - { desc => 'Hash of optional param: Org unit ID (defaults to workstation org unit), limit, offset, sort (array of: acplo.position, call_number, request_time)', - type => 'object' - }, - ], - return => { - desc => 'A stream of fleshed holds', - type => 'object' - } - } -); - -sub print_hold_pull_list_stream { - my($self, $client, $auth, $params) = @_; - - my $e = new_editor(authtoken=>$auth); - return $e->die_event unless $e->checkauth; - - delete($$params{org_id}) unless (int($$params{org_id})); - delete($$params{limit}) unless (int($$params{limit})); - delete($$params{offset}) unless (int($$params{offset})); - delete($$params{chunk_size}) unless (int($$params{chunk_size})); - delete($$params{chunk_size}) if ($$params{chunk_size} && $$params{chunk_size} > 50); # keep the size reasonable - $$params{chunk_size} ||= 10; - - $$params{org_id} = (defined $$params{org_id}) ? $$params{org_id}: $e->requestor->ws_ou; - return $e->die_event unless $e->allowed('VIEW_HOLD', $$params{org_id }); - - my $sort = []; - if ($$params{sort} && @{ $$params{sort} }) { - for my $s (@{ $$params{sort} }) { - if ($s eq 'acplo.position') { - push @$sort, { - "class" => "acplo", "field" => "position", - "transform" => "coalesce", "params" => [999] - }; - } elsif ($s eq 'call_number') { - push @$sort, {"class" => "acn", "field" => "label"}; - } elsif ($s eq 'request_time') { - push @$sort, {"class" => "ahr", "field" => "request_time"}; - } - } - } else { - push @$sort, {"class" => "ahr", "field" => "request_time"}; - } - - my $holds_ids = $e->json_query( - { - "select" => {"ahr" => ["id"]}, - "from" => { - "ahr" => { - "acp" => { - "field" => "id", - "fkey" => "current_copy", - "filter" => { - "circ_lib" => $$params{org_id}, "status" => [0,7] - }, - "join" => { - "acn" => { - "field" => "id", - "fkey" => "call_number" - }, - "acplo" => { - "field" => "org", - "fkey" => "circ_lib", - "type" => "left", - "filter" => { - "location" => {"=" => {"+acp" => "location"}} - } - } - } - } - } - }, - "where" => { - "+ahr" => { - "capture_time" => undef, - "cancel_time" => undef, - "-or" => [ - {"expire_time" => undef }, - {"expire_time" => {">" => "now"}} - ] - } - }, - (@$sort ? (order_by => $sort) : ()), - ($$params{limit} ? (limit => $$params{limit}) : ()), - ($$params{offset} ? (offset => $$params{offset}) : ()) - }, {"substream" => 1} - ) or return $e->die_event; - - $logger->info("about to stream back " . scalar(@$holds_ids) . " holds"); - - my @chunk; - for my $hid (@$holds_ids) { - push @chunk, $e->retrieve_action_hold_request([ - $hid->{"id"}, { - "flesh" => 3, - "flesh_fields" => { - "ahr" => ["usr", "current_copy"], - "au" => ["card"], - "acp" => ["location", "call_number"], - "acn" => ["record"] - } - } - ]); - - if (@chunk >= $$params{chunk_size}) { - $client->respond( \@chunk ); - @chunk = (); - } - } - $client->respond_complete( \@chunk ) if (@chunk); - $e->disconnect; - return undef; -} - - - -__PACKAGE__->register_method( - method => 'fetch_hold_notify', - api_name => 'open-ils.circ.hold_notification.retrieve_by_hold', - authoritative => 1, - signature => q/ -Returns a list of hold notification objects based on hold id. -@param authtoken The loggin session key -@param holdid The id of the hold whose notifications we want to retrieve -@return An array of hold notification objects, event on error. -/ -); - -sub fetch_hold_notify { - my( $self, $conn, $authtoken, $holdid ) = @_; - my( $requestor, $evt ) = $U->checkses($authtoken); - return $evt if $evt; - my ($hold, $patron); - ($hold, $evt) = $U->fetch_hold($holdid); - return $evt if $evt; - ($patron, $evt) = $U->fetch_user($hold->usr); - return $evt if $evt; - - $evt = $U->check_perms($requestor->id, $patron->home_ou, 'VIEW_HOLD_NOTIFICATION'); - return $evt if $evt; - - $logger->info("User ".$requestor->id." fetching hold notifications for hold $holdid"); - return $U->cstorereq( - 'open-ils.cstore.direct.action.hold_notification.search.atomic', {hold => $holdid} ); -} - - -__PACKAGE__->register_method( - method => 'create_hold_notify', - api_name => 'open-ils.circ.hold_notification.create', - signature => q/ -Creates a new hold notification object -@param authtoken The login session key -@param notification The hold notification object to create -@return ID of the new object on success, Event on error -/ -); - -sub create_hold_notify { - my( $self, $conn, $auth, $note ) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - - my $hold = $e->retrieve_action_hold_request($note->hold) - or return $e->die_event; - my $patron = $e->retrieve_actor_user($hold->usr) - or return $e->die_event; - - return $e->die_event unless - $e->allowed('CREATE_HOLD_NOTIFICATION', $patron->home_ou); - - $note->notify_staff($e->requestor->id); - $e->create_action_hold_notification($note) or return $e->die_event; - $e->commit; - return $note->id; -} - -__PACKAGE__->register_method( - method => 'create_hold_note', - api_name => 'open-ils.circ.hold_note.create', - signature => q/ - Creates a new hold request note object - @param authtoken The login session key - @param note The hold note object to create - @return ID of the new object on success, Event on error - / -); - -sub create_hold_note { - my( $self, $conn, $auth, $note ) = @_; - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - - my $hold = $e->retrieve_action_hold_request($note->hold) - or return $e->die_event; - my $patron = $e->retrieve_actor_user($hold->usr) - or return $e->die_event; - - return $e->die_event unless - $e->allowed('UPDATE_HOLD', $patron->home_ou); # FIXME: Using permcrud perm listed in fm_IDL.xml for ahrn. Probably want something more specific - - $e->create_action_hold_request_note($note) or return $e->die_event; - $e->commit; - return $note->id; -} - -__PACKAGE__->register_method( - method => 'reset_hold', - api_name => 'open-ils.circ.hold.reset', - signature => q/ - Un-captures and un-targets a hold, essentially returning - it to the state it was in directly after it was placed, - then attempts to re-target the hold - @param authtoken The login session key - @param holdid The id of the hold - / -); - - -sub reset_hold { - my( $self, $conn, $auth, $holdid ) = @_; - my $reqr; - my ($hold, $evt) = $U->fetch_hold($holdid); - return $evt if $evt; - ($reqr, $evt) = $U->checksesperm($auth, 'UPDATE_HOLD'); - return $evt if $evt; - $evt = _reset_hold($self, $reqr, $hold); - return $evt if $evt; - return 1; -} - - -__PACKAGE__->register_method( - method => 'reset_hold_batch', - api_name => 'open-ils.circ.hold.reset.batch' -); - -sub reset_hold_batch { - my($self, $conn, $auth, $hold_ids) = @_; - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - for my $hold_id ($hold_ids) { - - my $hold = $e->retrieve_action_hold_request( - [$hold_id, {flesh => 1, flesh_fields => {ahr => ['usr']}}]) - or return $e->event; - - next unless $e->allowed('UPDATE_HOLD', $hold->usr->home_ou); - _reset_hold($self, $e->requestor, $hold); - } - - return 1; -} - - -sub _reset_hold { - my ($self, $reqr, $hold) = @_; - - my $e = new_editor(xact =>1, requestor => $reqr); - - $logger->info("reseting hold ".$hold->id); - - my $hid = $hold->id; - - if( $hold->capture_time and $hold->current_copy ) { - - my $copy = $e->retrieve_asset_copy($hold->current_copy) - or return $e->die_event; - - if( $copy->status == OILS_COPY_STATUS_ON_HOLDS_SHELF ) { - $logger->info("setting copy to status 'reshelving' on hold retarget"); - $copy->status(OILS_COPY_STATUS_RESHELVING); - $copy->editor($e->requestor->id); - $copy->edit_date('now'); - $e->update_asset_copy($copy) or return $e->die_event; - - } elsif( $copy->status == OILS_COPY_STATUS_IN_TRANSIT ) { - - # We don't want the copy to remain "in transit" - $copy->status(OILS_COPY_STATUS_RESHELVING); - $logger->warn("! reseting hold [$hid] that is in transit"); - my $transid = $e->search_action_hold_transit_copy({hold=>$hold->id},{idlist=>1})->[0]; - - if( $transid ) { - my $trans = $e->retrieve_action_transit_copy($transid); - if( $trans ) { - $logger->info("Aborting transit [$transid] on hold [$hid] reset..."); - my $evt = OpenILS::Application::Circ::Transit::__abort_transit($e, $trans, $copy, 1); - $logger->info("Transit abort completed with result $evt"); - unless ("$evt" eq 1) { - $e->rollback; - return $evt; - } - } - } - } - } - - $hold->clear_capture_time; - $hold->clear_current_copy; - $hold->clear_shelf_time; - $hold->clear_shelf_expire_time; - - $e->update_action_hold_request($hold) or return $e->die_event; - $e->commit; - - $U->storagereq( - 'open-ils.storage.action.hold_request.copy_targeter', undef, $hold->id ); - - return undef; -} - - -__PACKAGE__->register_method( - method => 'fetch_open_title_holds', - api_name => 'open-ils.circ.open_holds.retrieve', - signature => q/ - Returns a list ids of un-fulfilled holds for a given title id - @param authtoken The login session key - @param id the id of the item whose holds we want to retrieve - @param type The hold type - M, T, I, V, C, F, R - / -); - -sub fetch_open_title_holds { - my( $self, $conn, $auth, $id, $type, $org ) = @_; - my $e = new_editor( authtoken => $auth ); - return $e->event unless $e->checkauth; - - $type ||= "T"; - $org ||= $e->requestor->ws_ou; - -# return $e->search_action_hold_request( -# { target => $id, hold_type => $type, fulfillment_time => undef }, {idlist=>1}); - - # XXX make me return IDs in the future ^-- - my $holds = $e->search_action_hold_request( - { - target => $id, - cancel_time => undef, - hold_type => $type, - fulfillment_time => undef - } - ); - - flesh_hold_transits($holds); - return $holds; -} - - -sub flesh_hold_transits { - my $holds = shift; - for my $hold ( @$holds ) { - $hold->transit( - $apputils->simplereq( - 'open-ils.cstore', - "open-ils.cstore.direct.action.hold_transit_copy.search.atomic", - { hold => $hold->id }, - { order_by => { ahtc => 'id desc' }, limit => 1 } - )->[0] - ); - } -} - -sub flesh_hold_notices { - my( $holds, $e ) = @_; - $e ||= new_editor(); - - for my $hold (@$holds) { - my $notices = $e->search_action_hold_notification( - [ - { hold => $hold->id }, - { order_by => { anh => 'notify_time desc' } }, - ], - {idlist=>1} - ); - - $hold->notify_count(scalar(@$notices)); - if( @$notices ) { - my $n = $e->retrieve_action_hold_notification($$notices[0]) - or return $e->event; - $hold->notify_time($n->notify_time); - } - } -} - - -__PACKAGE__->register_method( - method => 'fetch_captured_holds', - api_name => 'open-ils.circ.captured_holds.on_shelf.retrieve', - stream => 1, - signature => q/ - Returns a list of un-fulfilled holds (on the Holds Shelf) for a given title id - @param authtoken The login session key - @param org The org id of the location in question - / -); - -__PACKAGE__->register_method( - method => 'fetch_captured_holds', - api_name => 'open-ils.circ.captured_holds.id_list.on_shelf.retrieve', - stream => 1, - signature => q/ - Returns list ids of un-fulfilled holds (on the Holds Shelf) for a given title id - @param authtoken The login session key - @param org The org id of the location in question - / -); - -__PACKAGE__->register_method( - method => 'fetch_captured_holds', - api_name => 'open-ils.circ.captured_holds.id_list.expired_on_shelf.retrieve', - stream => 1, - signature => q/ - Returns list ids of shelf-expired un-fulfilled holds for a given title id - @param authtoken The login session key - @param org The org id of the location in question - / -); - - -sub fetch_captured_holds { - my( $self, $conn, $auth, $org ) = @_; - - my $e = new_editor(authtoken => $auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('VIEW_HOLD'); # XXX rely on editor perm - - $org ||= $e->requestor->ws_ou; - - my $query = { - select => { ahr => ['id'] }, - from => { - ahr => { - acp => { - field => 'id', - fkey => 'current_copy' - }, - } - }, - where => { - '+acp' => { status => OILS_COPY_STATUS_ON_HOLDS_SHELF }, - '+ahr' => { - capture_time => { "!=" => undef }, - current_copy => { "!=" => undef }, - fulfillment_time => undef, - pickup_lib => $org, - cancel_time => undef, - } - } - }; - if($self->api_name =~ /expired/) { - $query->{'where'}->{'+ahr'}->{'shelf_expire_time'} = {'<' => 'now'}; - $query->{'where'}->{'+ahr'}->{'shelf_time'} = {'!=' => undef}; - } - my $hold_ids = $e->json_query( $query ); - - for my $hold_id (@$hold_ids) { - if($self->api_name =~ /id_list/) { - $conn->respond($hold_id->{id}); - next; - } else { - $conn->respond( - $e->retrieve_action_hold_request([ - $hold_id->{id}, - { - flesh => 1, - flesh_fields => {ahr => ['notifications', 'transit', 'notes']}, - order_by => {anh => 'notify_time desc'} - } - ]) - ); - } - } - - return undef; -} - -__PACKAGE__->register_method( - method => "print_expired_holds_stream", - api_name => "open-ils.circ.captured_holds.expired.print.stream", - stream => 1 -); - -sub print_expired_holds_stream { - my ($self, $client, $auth, $params) = @_; - - # No need to check specific permissions: we're going to call another method - # that will do that. - my $e = new_editor("authtoken" => $auth); - return $e->die_event unless $e->checkauth; - - delete($$params{org_id}) unless (int($$params{org_id})); - delete($$params{limit}) unless (int($$params{limit})); - delete($$params{offset}) unless (int($$params{offset})); - delete($$params{chunk_size}) unless (int($$params{chunk_size})); - delete($$params{chunk_size}) if ($$params{chunk_size} && $$params{chunk_size} > 50); # keep the size reasonable - $$params{chunk_size} ||= 10; - - $$params{org_id} = (defined $$params{org_id}) ? $$params{org_id}: $e->requestor->ws_ou; - - my @hold_ids = $self->method_lookup( - "open-ils.circ.captured_holds.id_list.expired_on_shelf.retrieve" - )->run($auth, $params->{"org_id"}); - - if (!@hold_ids) { - $e->disconnect; - return; - } elsif (defined $U->event_code($hold_ids[0])) { - $e->disconnect; - return $hold_ids[0]; - } - - $logger->info("about to stream back up to " . scalar(@hold_ids) . " expired holds"); - - while (@hold_ids) { - my @hid_chunk = splice @hold_ids, 0, $params->{"chunk_size"}; - - my $result_chunk = $e->json_query({ - "select" => { - "acp" => ["barcode"], - "au" => [qw/ - first_given_name second_given_name family_name alias - /], - "acn" => ["label"], - "bre" => ["marc"], - "acpl" => ["name"] - }, - "from" => { - "ahr" => { - "acp" => { - "field" => "id", "fkey" => "current_copy", - "join" => { - "acn" => { - "field" => "id", "fkey" => "call_number", - "join" => { - "bre" => { - "field" => "id", "fkey" => "record" - } - } - }, - "acpl" => {"field" => "id", "fkey" => "location"} - } - }, - "au" => {"field" => "id", "fkey" => "usr"} - } - }, - "where" => {"+ahr" => {"id" => \@hid_chunk}} - }) or return $e->die_event; - $client->respond($result_chunk); - } - - $e->disconnect; - undef; -} - -__PACKAGE__->register_method( - method => "check_title_hold_batch", - api_name => "open-ils.circ.title_hold.is_possible.batch", - stream => 1, - signature => { - desc => '@see open-ils.circ.title_hold.is_possible.batch', - params => [ - { desc => 'Authentication token', type => 'string'}, - { desc => 'Array of Hash of named parameters', type => 'array'}, - ], - return => { - desc => 'Array of response objects', - type => 'array' - } - } -); - -sub check_title_hold_batch { - my($self, $client, $authtoken, $param_list) = @_; - foreach (@$param_list) { - my ($res) = $self->method_lookup('open-ils.circ.title_hold.is_possible')->run($authtoken, $_); - $client->respond($res); - } - return undef; -} - - -__PACKAGE__->register_method( - method => "check_title_hold", - api_name => "open-ils.circ.title_hold.is_possible", - signature => { - desc => 'Determines if a hold were to be placed by a given user, ' . - 'whether or not said hold would have any potential copies to fulfill it.' . - 'The named paramaters of the second argument include: ' . - 'patronid, titleid, volume_id, copy_id, mrid, depth, pickup_lib, hold_type, selection_ou. ' . - 'See perldoc ' . __PACKAGE__ . ' for more info on these fields.' , - params => [ - { desc => 'Authentication token', type => 'string'}, - { desc => 'Hash of named parameters', type => 'object'}, - ], - return => { - desc => 'List of new message IDs (empty if none)', - type => 'array' - } - } -); - -=head3 check_title_hold (token, hash) - -The named fields in the hash are: - - patronid - ID of the hold recipient (required) - depth - hold range depth (default 0) - pickup_lib - destination for hold, fallback value for selection_ou - selection_ou - ID of org_unit establishing hard and soft hold boundary settings - issuanceid - ID of the issuance to be held, required for Issuance level hold - titleid - ID (BRN) of the title to be held, required for Title level hold - volume_id - required for Volume level hold - copy_id - required for Copy level hold - mrid - required for Meta-record level hold - hold_type - T, C (or R or F), I, V or M for Title, Copy, Issuance, Volume or Meta-record (default "T") - -All key/value pairs are passed on to do_possibility_checks. - -=cut - -# FIXME: better params checking. what other params are required, if any? -# FIXME: 3 copies of values confusing: $x, $params->{x} and $params{x} -# FIXME: for example, $depth gets a default value, but then $$params{depth} is still -# used in conditionals, where it may be undefined, causing a warning. -# FIXME: specify proper usage/interaction of selection_ou and pickup_lib - -sub check_title_hold { - my( $self, $client, $authtoken, $params ) = @_; - my $e = new_editor(authtoken=>$authtoken); - return $e->event unless $e->checkauth; - - my %params = %$params; - my $depth = $params{depth} || 0; - my $selection_ou = $params{selection_ou} || $params{pickup_lib}; - - my $patron = $e->retrieve_actor_user($params{patronid}) - or return $e->event; - - if( $e->requestor->id ne $patron->id ) { - return $e->event unless - $e->allowed('VIEW_HOLD_PERMIT', $patron->home_ou); - } - - return OpenILS::Event->new('PATRON_BARRED') if $U->is_true($patron->barred); - - my $request_lib = $e->retrieve_actor_org_unit($e->requestor->ws_ou) - or return $e->event; - - my $soft_boundary = $U->ou_ancestor_setting_value($selection_ou, OILS_SETTING_HOLD_SOFT_BOUNDARY); - my $hard_boundary = $U->ou_ancestor_setting_value($selection_ou, OILS_SETTING_HOLD_HARD_BOUNDARY); - - my @status = (); - my $return_depth = $hard_boundary; # default depth to return on success - if(defined $soft_boundary and $depth < $soft_boundary) { - # work up the tree and as soon as we find a potential copy, use that depth - # also, make sure we don't go past the hard boundary if it exists - - # our min boundary is the greater of user-specified boundary or hard boundary - my $min_depth = (defined $hard_boundary and $hard_boundary > $depth) ? - $hard_boundary : $depth; - - my $depth = $soft_boundary; - while($depth >= $min_depth) { - $logger->info("performing hold possibility check with soft boundary $depth"); - @status = do_possibility_checks($e, $patron, $request_lib, $depth, %params); - if ($status[0]) { - $return_depth = $depth; - last; - } - $depth--; - } - } elsif(defined $hard_boundary and $depth < $hard_boundary) { - # there is no soft boundary, enforce the hard boundary if it exists - $logger->info("performing hold possibility check with hard boundary $hard_boundary"); - @status = do_possibility_checks($e, $patron, $request_lib, $hard_boundary, %params); - } else { - # no boundaries defined, fall back to user specifed boundary or no boundary - $logger->info("performing hold possibility check with no boundary"); - @status = do_possibility_checks($e, $patron, $request_lib, $params{depth}, %params); - } - - if ($status[0]) { - return { - "success" => 1, - "depth" => $return_depth, - "local_avail" => $status[1] - }; - } elsif ($status[2]) { - my $n = scalar @{$status[2]}; - return {"success" => 0, "last_event" => $status[2]->[$n - 1]}; - } else { - return {"success" => 0}; - } -} - - - -sub do_possibility_checks { - my($e, $patron, $request_lib, $depth, %params) = @_; - - my $issuanceid = $params{issuanceid} || ""; - my $titleid = $params{titleid} || ""; - my $volid = $params{volume_id}; - my $copyid = $params{copy_id}; - my $mrid = $params{mrid} || ""; - my $pickup_lib = $params{pickup_lib}; - my $hold_type = $params{hold_type} || 'T'; - my $selection_ou = $params{selection_ou} || $pickup_lib; - - - my $copy; - my $volume; - my $title; - - if( $hold_type eq OILS_HOLD_TYPE_FORCE || $hold_type eq OILS_HOLD_TYPE_RECALL || $hold_type eq OILS_HOLD_TYPE_COPY ) { - - return $e->event unless $copy = $e->retrieve_asset_copy($copyid); - return $e->event unless $volume = $e->retrieve_asset_call_number($copy->call_number); - return $e->event unless $title = $e->retrieve_biblio_record_entry($volume->record); - - return verify_copy_for_hold( - $patron, $e->requestor, $title, $copy, $pickup_lib, $request_lib - ); - - } elsif( $hold_type eq OILS_HOLD_TYPE_VOLUME ) { - - return $e->event unless $volume = $e->retrieve_asset_call_number($volid); - return $e->event unless $title = $e->retrieve_biblio_record_entry($volume->record); - - return _check_volume_hold_is_possible( - $volume, $title, $depth, $request_lib, $patron, $e->requestor, $pickup_lib, $selection_ou - ); - - } elsif( $hold_type eq OILS_HOLD_TYPE_TITLE ) { - - return _check_title_hold_is_possible( - $titleid, $depth, $request_lib, $patron, $e->requestor, $pickup_lib, $selection_ou - ); - - } elsif( $hold_type eq OILS_HOLD_TYPE_ISSUANCE ) { - - return _check_issuance_hold_is_possible( - $issuanceid, $depth, $request_lib, $patron, $e->requestor, $pickup_lib, $selection_ou - ); - - } elsif( $hold_type eq OILS_HOLD_TYPE_METARECORD ) { - - my $maps = $e->search_metabib_metarecord_source_map({metarecord=>$mrid}); - my @recs = map { $_->source } @$maps; - my @status = (); - for my $rec (@recs) { - @status = _check_title_hold_is_possible( - $rec, $depth, $request_lib, $patron, $e->requestor, $pickup_lib, $selection_ou - ); - last if $status[1]; - } - return @status; - } -# else { Unrecognized hold_type ! } # FIXME: return error? or 0? -} - -my %prox_cache; -sub create_ranged_org_filter { - my($e, $selection_ou, $depth) = @_; - - # find the orgs from which this hold may be fulfilled, - # based on the selection_ou and depth - - my $top_org = $e->search_actor_org_unit([ - {parent_ou => undef}, - {flesh=>1, flesh_fields=>{aou=>['ou_type']}}])->[0]; - my %org_filter; - - return () if $depth == $top_org->ou_type->depth; - - my $org_list = $U->storagereq('open-ils.storage.actor.org_unit.descendants.atomic', $selection_ou, $depth); - %org_filter = (circ_lib => []); - push(@{$org_filter{circ_lib}}, $_->id) for @$org_list; - - $logger->info("hold org filter at depth $depth and selection_ou ". - "$selection_ou created list of @{$org_filter{circ_lib}}"); - - return %org_filter; -} - - -sub _check_title_hold_is_possible { - my( $titleid, $depth, $request_lib, $patron, $requestor, $pickup_lib, $selection_ou ) = @_; - - my $e = new_editor(); - my %org_filter = create_ranged_org_filter($e, $selection_ou, $depth); - - # this monster will grab the id and circ_lib of all of the "holdable" copies for the given record - my $copies = $e->json_query( - { - select => { acp => ['id', 'circ_lib'] }, - from => { - acp => { - acn => { - field => 'id', - fkey => 'call_number', - 'join' => { - bre => { - field => 'id', - filter => { id => $titleid }, - fkey => 'record' - } - } - }, - acpl => { field => 'id', filter => { holdable => 't'}, fkey => 'location' }, - ccs => { field => 'id', filter => { holdable => 't'}, fkey => 'status' } - } - }, - where => { - '+acp' => { circulate => 't', deleted => 'f', holdable => 't', %org_filter } - } - } - ); - - $logger->info("title possible found ".scalar(@$copies)." potential copies"); - return ( - 0, 0, [ - new OpenILS::Event( - "HIGH_LEVEL_HOLD_HAS_NO_COPIES", - "payload" => {"fail_part" => "no_ultimate_items"} - ) - ] - ) unless @$copies; - - # ----------------------------------------------------------------------- - # sort the copies into buckets based on their circ_lib proximity to - # the patron's home_ou. - # ----------------------------------------------------------------------- - - my $home_org = $patron->home_ou; - my $req_org = $request_lib->id; - - $logger->info("prox cache $home_org " . $prox_cache{$home_org}); - - $prox_cache{$home_org} = - $e->search_actor_org_unit_proximity({from_org => $home_org}) - unless $prox_cache{$home_org}; - my $home_prox = $prox_cache{$home_org}; - - my %buckets; - my %hash = map { ($_->to_org => $_->prox) } @$home_prox; - push( @{$buckets{ $hash{$_->{circ_lib}} } }, $_->{id} ) for @$copies; - - my @keys = sort { $a <=> $b } keys %buckets; - - - if( $home_org ne $req_org ) { - # ----------------------------------------------------------------------- - # shove the copies close to the request_lib into the primary buckets - # directly before the farthest away copies. That way, they are not - # given priority, but they are checked before the farthest copies. - # ----------------------------------------------------------------------- - $prox_cache{$req_org} = - $e->search_actor_org_unit_proximity({from_org => $req_org}) - unless $prox_cache{$req_org}; - my $req_prox = $prox_cache{$req_org}; - - my %buckets2; - my %hash2 = map { ($_->to_org => $_->prox) } @$req_prox; - push( @{$buckets2{ $hash2{$_->{circ_lib}} } }, $_->{id} ) for @$copies; - - my $highest_key = $keys[@keys - 1]; # the farthest prox in the exising buckets - my $new_key = $highest_key - 0.5; # right before the farthest prox - my @keys2 = sort { $a <=> $b } keys %buckets2; - for my $key (@keys2) { - last if $key >= $highest_key; - push( @{$buckets{$new_key}}, $_ ) for @{$buckets2{$key}}; - } - } - - @keys = sort { $a <=> $b } keys %buckets; - - my $title; - my %seen; - my @status; - OUTER: for my $key (@keys) { - my @cps = @{$buckets{$key}}; - - $logger->info("looking at " . scalar(@{$buckets{$key}}). " copies in proximity bucket $key"); - - for my $copyid (@cps) { - - next if $seen{$copyid}; - $seen{$copyid} = 1; # there could be dupes given the merged buckets - my $copy = $e->retrieve_asset_copy($copyid); - $logger->debug("looking at bucket_key=$key, copy $copyid : circ_lib = " . $copy->circ_lib); - - unless($title) { # grab the title if we don't already have it - my $vol = $e->retrieve_asset_call_number( - [ $copy->call_number, { flesh => 1, flesh_fields => { bre => ['fixed_fields'], acn => ['record'] } } ] ); - $title = $vol->record; - } - - @status = verify_copy_for_hold( - $patron, $requestor, $title, $copy, $pickup_lib, $request_lib); - - last OUTER if $status[0]; - } - } - - return @status; -} - -sub _check_issuance_hold_is_possible { - my( $issuanceid, $depth, $request_lib, $patron, $requestor, $pickup_lib, $selection_ou ) = @_; - - my $e = new_editor(); - my %org_filter = create_ranged_org_filter($e, $selection_ou, $depth); - - # this monster will grab the id and circ_lib of all of the "holdable" copies for the given record - my $copies = $e->json_query( - { - select => { acp => ['id', 'circ_lib'] }, - from => { - acp => { - sitem => { - field => 'unit', - fkey => 'id', - filter => { issuance => $issuanceid } - }, - acpl => { field => 'id', filter => { holdable => 't'}, fkey => 'location' }, - ccs => { field => 'id', filter => { holdable => 't'}, fkey => 'status' } - } - }, - where => { - '+acp' => { circulate => 't', deleted => 'f', holdable => 't', %org_filter } - }, - distinct => 1 - } - ); - - $logger->info("issuance possible found ".scalar(@$copies)." potential copies"); - - my $empty_ok; - if (!@$copies) { - $empty_ok = $e->retrieve_config_global_flag('circ.holds.empty_issuance_ok'); - $empty_ok = ($empty_ok and $U->is_true($empty_ok->enabled)); - - return ( - 0, 0, [ - new OpenILS::Event( - "HIGH_LEVEL_HOLD_HAS_NO_COPIES", - "payload" => {"fail_part" => "no_ultimate_items"} - ) - ] - ) unless $empty_ok; - - return (1, 0); - } - - # ----------------------------------------------------------------------- - # sort the copies into buckets based on their circ_lib proximity to - # the patron's home_ou. - # ----------------------------------------------------------------------- - - my $home_org = $patron->home_ou; - my $req_org = $request_lib->id; - - $logger->info("prox cache $home_org " . $prox_cache{$home_org}); - - $prox_cache{$home_org} = - $e->search_actor_org_unit_proximity({from_org => $home_org}) - unless $prox_cache{$home_org}; - my $home_prox = $prox_cache{$home_org}; - - my %buckets; - my %hash = map { ($_->to_org => $_->prox) } @$home_prox; - push( @{$buckets{ $hash{$_->{circ_lib}} } }, $_->{id} ) for @$copies; - - my @keys = sort { $a <=> $b } keys %buckets; - - - if( $home_org ne $req_org ) { - # ----------------------------------------------------------------------- - # shove the copies close to the request_lib into the primary buckets - # directly before the farthest away copies. That way, they are not - # given priority, but they are checked before the farthest copies. - # ----------------------------------------------------------------------- - $prox_cache{$req_org} = - $e->search_actor_org_unit_proximity({from_org => $req_org}) - unless $prox_cache{$req_org}; - my $req_prox = $prox_cache{$req_org}; - - my %buckets2; - my %hash2 = map { ($_->to_org => $_->prox) } @$req_prox; - push( @{$buckets2{ $hash2{$_->{circ_lib}} } }, $_->{id} ) for @$copies; - - my $highest_key = $keys[@keys - 1]; # the farthest prox in the exising buckets - my $new_key = $highest_key - 0.5; # right before the farthest prox - my @keys2 = sort { $a <=> $b } keys %buckets2; - for my $key (@keys2) { - last if $key >= $highest_key; - push( @{$buckets{$new_key}}, $_ ) for @{$buckets2{$key}}; - } - } - - @keys = sort { $a <=> $b } keys %buckets; - - my $title; - my %seen; - my @status; - OUTER: for my $key (@keys) { - my @cps = @{$buckets{$key}}; - - $logger->info("looking at " . scalar(@{$buckets{$key}}). " copies in proximity bucket $key"); - - for my $copyid (@cps) { - - next if $seen{$copyid}; - $seen{$copyid} = 1; # there could be dupes given the merged buckets - my $copy = $e->retrieve_asset_copy($copyid); - $logger->debug("looking at bucket_key=$key, copy $copyid : circ_lib = " . $copy->circ_lib); - - unless($title) { # grab the title if we don't already have it - my $vol = $e->retrieve_asset_call_number( - [ $copy->call_number, { flesh => 1, flesh_fields => { bre => ['fixed_fields'], acn => ['record'] } } ] ); - $title = $vol->record; - } - - @status = verify_copy_for_hold( - $patron, $requestor, $title, $copy, $pickup_lib, $request_lib); - - last OUTER if $status[0]; - } - } - - if (!$status[0]) { - if (!defined($empty_ok)) { - $empty_ok = $e->retrieve_config_global_flag('circ.holds.empty_issuance_ok'); - $empty_ok = ($empty_ok and $U->is_true($empty_ok->enabled)); - } - - return (1,0) if ($empty_ok); - } - return @status; -} - - -sub _check_volume_hold_is_possible { - my( $vol, $title, $depth, $request_lib, $patron, $requestor, $pickup_lib, $selection_ou ) = @_; - my %org_filter = create_ranged_org_filter(new_editor(), $selection_ou, $depth); - my $copies = new_editor->search_asset_copy({call_number => $vol->id, %org_filter}); - $logger->info("checking possibility of volume hold for volume ".$vol->id); - - return ( - 0, 0, [ - new OpenILS::Event( - "HIGH_LEVEL_HOLD_HAS_NO_COPIES", - "payload" => {"fail_part" => "no_ultimate_items"} - ) - ] - ) unless @$copies; - - my @status; - for my $copy ( @$copies ) { - @status = verify_copy_for_hold( - $patron, $requestor, $title, $copy, $pickup_lib, $request_lib ); - last if $status[0]; - } - return @status; -} - - - -sub verify_copy_for_hold { - my( $patron, $requestor, $title, $copy, $pickup_lib, $request_lib ) = @_; - $logger->info("checking possibility of copy in hold request for copy ".$copy->id); - my $permitted = OpenILS::Utils::PermitHold::permit_copy_hold( - { patron => $patron, - requestor => $requestor, - copy => $copy, - title => $title, - title_descriptor => $title->fixed_fields, # this is fleshed into the title object - pickup_lib => $pickup_lib, - request_lib => $request_lib, - new_hold => 1, - show_event_list => 1 - } - ); - - return ( - (not scalar @$permitted), # true if permitted is an empty arrayref - ( - ($copy->circ_lib == $pickup_lib) and - ($copy->status == OILS_COPY_STATUS_AVAILABLE) - ), - $permitted - ); -} - - - -sub find_nearest_permitted_hold { - - my $class = shift; - my $editor = shift; # CStoreEditor object - my $copy = shift; # copy to target - my $user = shift; # staff - my $check_only = shift; # do no updates, just see if the copy could fulfill a hold - - my $evt = OpenILS::Event->new('ACTION_HOLD_REQUEST_NOT_FOUND'); - - my $bc = $copy->barcode; - - # find any existing holds that already target this copy - my $old_holds = $editor->search_action_hold_request( - { current_copy => $copy->id, - cancel_time => undef, - capture_time => undef - } - ); - - # hold->type "R" means we need this copy - for my $h (@$old_holds) { return ($h) if $h->hold_type eq 'R'; } - - - my $hold_stall_interval = $U->ou_ancestor_setting_value($user->ws_ou, OILS_SETTING_HOLD_SOFT_STALL); - - $logger->info("circulator: searching for best hold at org ".$user->ws_ou. - " and copy $bc with a hold stalling interval of ". ($hold_stall_interval || "(none)")); - - my $fifo = $U->ou_ancestor_setting_value($user->ws_ou, 'circ.holds_fifo'); - - # search for what should be the best holds for this copy to fulfill - my $best_holds = $U->storagereq( - "open-ils.storage.action.hold_request.nearest_hold.atomic", - $user->ws_ou, $copy->id, 10, $hold_stall_interval, $fifo ); - - unless(@$best_holds) { - - if( my $hold = $$old_holds[0] ) { - $logger->info("circulator: using existing pre-targeted hold ".$hold->id." in hold search"); - return ($hold); - } - - $logger->info("circulator: no suitable holds found for copy $bc"); - return (undef, $evt); - } - - - my $best_hold; - - # for each potential hold, we have to run the permit script - # to make sure the hold is actually permitted. - my %reqr_cache; - my %org_cache; - for my $holdid (@$best_holds) { - next unless $holdid; - $logger->info("circulator: checking if hold $holdid is permitted for copy $bc"); - - my $hold = $editor->retrieve_action_hold_request($holdid) or next; - my $reqr = $reqr_cache{$hold->requestor} || $editor->retrieve_actor_user($hold->requestor); - my $rlib = $org_cache{$hold->request_lib} || $editor->retrieve_actor_org_unit($hold->request_lib); - - $reqr_cache{$hold->requestor} = $reqr; - $org_cache{$hold->request_lib} = $rlib; - - # see if this hold is permitted - my $permitted = OpenILS::Utils::PermitHold::permit_copy_hold( - { patron_id => $hold->usr, - requestor => $reqr, - copy => $copy, - pickup_lib => $hold->pickup_lib, - request_lib => $rlib, - retarget => 1 - } - ); - - if( $permitted ) { - $best_hold = $hold; - last; - } - } - - - unless( $best_hold ) { # no "good" permitted holds were found - if( my $hold = $$old_holds[0] ) { # can we return a pre-targeted hold? - $logger->info("circulator: using existing pre-targeted hold ".$hold->id." in hold search"); - return ($hold); - } - - # we got nuthin - $logger->info("circulator: no suitable holds found for copy $bc"); - return (undef, $evt); - } - - $logger->info("circulator: best hold ".$best_hold->id." found for copy $bc"); - - # indicate a permitted hold was found - return $best_hold if $check_only; - - # we've found a permitted hold. we need to "grab" the copy - # to prevent re-targeted holds (next part) from re-grabbing the copy - $best_hold->current_copy($copy->id); - $editor->update_action_hold_request($best_hold) - or return (undef, $editor->event); - - - my @retarget; - - # re-target any other holds that already target this copy - for my $old_hold (@$old_holds) { - next if $old_hold->id eq $best_hold->id; # don't re-target the hold we want - $logger->info("circulator: clearing current_copy and prev_check_time on hold ". - $old_hold->id." after a better hold [".$best_hold->id."] was found"); - $old_hold->clear_current_copy; - $old_hold->clear_prev_check_time; - $editor->update_action_hold_request($old_hold) - or return (undef, $editor->event); - push(@retarget, $old_hold->id); - } - - return ($best_hold, undef, (@retarget) ? \@retarget : undef); -} - - - - - - -__PACKAGE__->register_method( - method => 'all_rec_holds', - api_name => 'open-ils.circ.holds.retrieve_all_from_title', -); - -sub all_rec_holds { - my( $self, $conn, $auth, $title_id, $args ) = @_; - - my $e = new_editor(authtoken=>$auth); - $e->checkauth or return $e->event; - $e->allowed('VIEW_HOLD') or return $e->event; - - $args ||= {}; - $args->{fulfillment_time} = undef; # we don't want to see old fulfilled holds - $args->{cancel_time} = undef; - - my $resp = { volume_holds => [], copy_holds => [], metarecord_holds => [] }; - - my $mr_map = $e->search_metabib_metarecord_source_map({source => $title_id})->[0]; - if($mr_map) { - $resp->{metarecord_holds} = $e->search_action_hold_request( - { hold_type => OILS_HOLD_TYPE_METARECORD, - target => $mr_map->metarecord, - %$args - }, {idlist => 1} - ); - } - - $resp->{title_holds} = $e->search_action_hold_request( - { - hold_type => OILS_HOLD_TYPE_TITLE, - target => $title_id, - %$args - }, {idlist=>1} ); - - my $vols = $e->search_asset_call_number( - { record => $title_id, deleted => 'f' }, {idlist=>1}); - - return $resp unless @$vols; - - $resp->{volume_holds} = $e->search_action_hold_request( - { - hold_type => OILS_HOLD_TYPE_VOLUME, - target => $vols, - %$args }, - {idlist=>1} ); - - my $copies = $e->search_asset_copy( - { call_number => $vols, deleted => 'f' }, {idlist=>1}); - - return $resp unless @$copies; - - $resp->{copy_holds} = $e->search_action_hold_request( - { - hold_type => OILS_HOLD_TYPE_COPY, - target => $copies, - %$args }, - {idlist=>1} ); - - return $resp; -} - - - - - -__PACKAGE__->register_method( - method => 'uber_hold', - authoritative => 1, - api_name => 'open-ils.circ.hold.details.retrieve' -); - -sub uber_hold { - my($self, $client, $auth, $hold_id) = @_; - my $e = new_editor(authtoken=>$auth); - $e->checkauth or return $e->event; - return uber_hold_impl($e, $hold_id); -} - -__PACKAGE__->register_method( - method => 'batch_uber_hold', - authoritative => 1, - stream => 1, - api_name => 'open-ils.circ.hold.details.batch.retrieve' -); - -sub batch_uber_hold { - my($self, $client, $auth, $hold_ids) = @_; - my $e = new_editor(authtoken=>$auth); - $e->checkauth or return $e->event; - $client->respond(uber_hold_impl($e, $_)) for @$hold_ids; - return undef; -} - -sub uber_hold_impl { - my($e, $hold_id) = @_; - - my $resp = {}; - - my $hold = $e->retrieve_action_hold_request( - [ - $hold_id, - { - flesh => 1, - flesh_fields => { ahr => [ 'current_copy', 'usr', 'notes' ] } - } - ] - ) or return $e->event; - - if($hold->usr->id ne $e->requestor->id) { - # A user is allowed to see his/her own holds - $e->allowed('VIEW_HOLD') or return $e->event; - $hold->notes( # filter out any non-staff ("private") notes - [ grep { !$U->is_true($_->staff) } @{$hold->notes} ] ); - - } else { - # caller is asking for own hold, but may not have permission to view staff notes - unless($e->allowed('VIEW_HOLD')) { - $hold->notes( # filter out any staff notes - [ grep { $U->is_true($_->staff) } @{$hold->notes} ] ); - } - } - - my $user = $hold->usr; - $hold->usr($user->id); - - my $card = $e->retrieve_actor_card($user->card) - or return $e->event; - - my( $mvr, $volume, $copy ) = find_hold_mvr($e, $hold); - - flesh_hold_notices([$hold], $e); - flesh_hold_transits([$hold]); - - my $details = retrieve_hold_queue_status_impl($e, $hold); - - return { - hold => $hold, - copy => $copy, - volume => $volume, - mvr => $mvr, - patron_first => $user->first_given_name, - patron_last => $user->family_name, - patron_barcode => $card->barcode, - patron_alias => $user->alias, - %$details - }; -} - - - -# ----------------------------------------------------- -# Returns the MVR object that represents what the -# hold is all about -# ----------------------------------------------------- -sub find_hold_mvr { - my( $e, $hold ) = @_; - - my $tid; - my $copy; - my $volume; - my $issuance; - - if( $hold->hold_type eq OILS_HOLD_TYPE_METARECORD ) { - my $mr = $e->retrieve_metabib_metarecord($hold->target) - or return $e->event; - $tid = $mr->master_record; - - } elsif( $hold->hold_type eq OILS_HOLD_TYPE_TITLE ) { - $tid = $hold->target; - - } elsif( $hold->hold_type eq OILS_HOLD_TYPE_VOLUME ) { - $volume = $e->retrieve_asset_call_number($hold->target) - or return $e->event; - $tid = $volume->record; - - } elsif( $hold->hold_type eq OILS_HOLD_TYPE_ISSUANCE ) { - $issuance = $e->retrieve_serial_issuance([ - $hold->target, - {flesh => 1, flesh_fields => {siss => [ qw/subscription/ ]}} - ]) or return $e->event; - - $tid = $issuance->subscription->record_entry; - - } elsif( $hold->hold_type eq OILS_HOLD_TYPE_COPY ) { - $copy = $e->retrieve_asset_copy([ - $hold->target, - {flesh => 1, flesh_fields => {acp => ['call_number']}} - ]) or return $e->event; - - $volume = $copy->call_number; - $tid = $volume->record; - } - - if(!$copy and ref $hold->current_copy ) { - $copy = $hold->current_copy; - $hold->current_copy($copy->id); - } - - if(!$volume and $copy) { - $volume = $e->retrieve_asset_call_number($copy->call_number); - } - - # TODO return metarcord mvr for M holds - my $title = $e->retrieve_biblio_record_entry($tid); - return ( $U->record_to_mvr($title), $volume, $copy, $issuance ); -} - -__PACKAGE__->register_method( - method => 'clear_shelf_cache', - api_name => 'open-ils.circ.hold.clear_shelf.get_cache', - stream => 1, - signature => { - desc => q/ - Returns the holds processed with the given cache key - / - } -); - -sub clear_shelf_cache { - my($self, $client, $auth, $cache_key, $chunk_size) = @_; - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth and $e->allowed('VIEW_HOLD'); - - $chunk_size ||= 25; - my $hold_data = OpenSRF::Utils::Cache->new('global')->get_cache($cache_key); - - if (!$hold_data) { - $logger->info("no hold data found in cache"); # XXX TODO return event - $e->rollback; - return undef; - } - - my $maximum = 0; - foreach (keys %$hold_data) { - $maximum += scalar(@{ $hold_data->{$_} }); - } - $client->respond({"maximum" => $maximum, "progress" => 0}); - - for my $action (sort keys %$hold_data) { - while (@{$hold_data->{$action}}) { - my @hid_chunk = splice @{$hold_data->{$action}}, 0, $chunk_size; - - my $result_chunk = $e->json_query({ - "select" => { - "acp" => ["barcode"], - "au" => [qw/ - first_given_name second_given_name family_name alias - /], - "acn" => ["label"], - "bre" => ["marc"], - "acpl" => ["name"], - "ahr" => ["id"] - }, - "from" => { - "ahr" => { - "acp" => { - "field" => "id", "fkey" => "current_copy", - "join" => { - "acn" => { - "field" => "id", "fkey" => "call_number", - "join" => { - "bre" => { - "field" => "id", "fkey" => "record" - } - } - }, - "acpl" => {"field" => "id", "fkey" => "location"} - } - }, - "au" => {"field" => "id", "fkey" => "usr"} - } - }, - "where" => {"+ahr" => {"id" => \@hid_chunk}} - }, {"substream" => 1}) or return $e->die_event; - - $client->respond([ - map { - +{"action" => $action, "hold_details" => $_} - } @$result_chunk - ]); - } - } - - $e->rollback; - return undef; -} - - -__PACKAGE__->register_method( - method => 'clear_shelf_process', - stream => 1, - api_name => 'open-ils.circ.hold.clear_shelf.process', - signature => { - desc => q/ - 1. Find all holds that have expired on the holds shelf - 2. Cancel the holds - 3. If a clear-shelf status is configured, put targeted copies into this status - 4. Divide copies into 3 groups: items to transit, items to reshelve, and items - that are needed for holds. No subsequent action is taken on the holds - or items after grouping. - / - } -); - -sub clear_shelf_process { - my($self, $client, $auth, $org_id) = @_; - - my $e = new_editor(authtoken=>$auth, xact => 1); - $e->checkauth or return $e->die_event; - my $cache = OpenSRF::Utils::Cache->new('global'); - - $org_id ||= $e->requestor->ws_ou; - $e->allowed('UPDATE_HOLD', $org_id) or return $e->die_event; - - my $copy_status = $U->ou_ancestor_setting_value($org_id, 'circ.holds.clear_shelf.copy_status'); - - # Find holds on the shelf that have been there too long - my $hold_ids = $e->search_action_hold_request( - { shelf_expire_time => {'<' => 'now'}, - pickup_lib => $org_id, - cancel_time => undef, - fulfillment_time => undef, - shelf_time => {'!=' => undef}, - capture_time => {'!=' => undef}, - current_copy => {'!=' => undef}, - }, - { idlist => 1 } - ); - - my @holds; - my $chunk_size = 25; # chunked status updates - my $counter = 0; - for my $hold_id (@$hold_ids) { - - $logger->info("Clear shelf processing hold $hold_id"); - - my $hold = $e->retrieve_action_hold_request([ - $hold_id, { - flesh => 1, - flesh_fields => {ahr => ['current_copy']} - } - ]); - - $hold->cancel_time('now'); - $hold->cancel_cause(2); # Hold Shelf expiration - $e->update_action_hold_request($hold) or return $e->die_event; - - my $copy = $hold->current_copy; - - if($copy_status or $copy_status == 0) { - # if a clear-shelf copy status is defined, update the copy - $copy->status($copy_status); - $copy->edit_date('now'); - $copy->editor($e->requestor->id); - $e->update_asset_copy($copy) or return $e->die_event; - } - - push(@holds, $hold); - $client->respond({maximum => scalar(@holds), progress => $counter}) if ( (++$counter % $chunk_size) == 0); - } - - if ($e->commit) { - - my %cache_data = ( - hold => [], - transit => [], - shelf => [] - ); - - for my $hold (@holds) { - - my $copy = $hold->current_copy; - my ($alt_hold) = __PACKAGE__->find_nearest_permitted_hold($e, $copy, $e->requestor, 1); - - if($alt_hold) { - - push(@{$cache_data{hold}}, $hold->id); # copy is needed for a hold - - } elsif($copy->circ_lib != $e->requestor->ws_ou) { - - push(@{$cache_data{transit}}, $hold->id); # copy needs to transit - - } else { - - push(@{$cache_data{shelf}}, $hold->id); # copy needs to go back to the shelf - } - } - - my $cache_key = md5_hex(time . $$ . rand()); - $logger->info("clear_shelf_cache: storing under $cache_key"); - $cache->put_cache($cache_key, \%cache_data, 7200); # TODO: 2 hours. configurable? - - # tell the client we're done - $client->respond_complete({cache_key => $cache_key}); - - # fire off the hold cancelation trigger and wait for response so don't flood the service - $U->create_events_for_hook( - 'hold_request.cancel.expire_holds_shelf', - $_, $org_id, undef, undef, 1) for @holds; - - } else { - # tell the client we're done - $client->respond_complete; - } -} - -__PACKAGE__->register_method( - method => 'usr_hold_summary', - api_name => 'open-ils.circ.holds.user_summary', - signature => q/ - Returns a summary of holds statuses for a given user - / -); - -sub usr_hold_summary { - my($self, $conn, $auth, $user_id) = @_; - - my $e = new_editor(authtoken=>$auth); - $e->checkauth or return $e->event; - $e->allowed('VIEW_HOLD') or return $e->event; - - my $holds = $e->search_action_hold_request( - { - usr => $user_id , - fulfillment_time => undef, - cancel_time => undef, - } - ); - - my %summary = (1 => 0, 2 => 0, 3 => 0, 4 => 0); - $summary{_hold_status($e, $_)} += 1 for @$holds; - return \%summary; -} - - - -__PACKAGE__->register_method( - method => 'hold_has_copy_at', - api_name => 'open-ils.circ.hold.has_copy_at', - signature => { - desc => - 'Returns the ID of the found copy and name of the shelving location if there is ' . - 'an available copy at the specified org unit. Returns empty hash otherwise. ' . - 'The anticipated use for this method is to determine whether an item is ' . - 'available at the library where the user is placing the hold (or, alternatively, '. - 'at the pickup library) to encourage bypassing the hold placement and just ' . - 'checking out the item.' , - params => { - { desc => 'Authentication Token', type => 'string' }, - { desc => 'Method Arguments. Options include: hold_type, hold_target, org_unit. ' - . 'hold_type is the hold type code (T, V, C, M, ...). ' - . 'hold_target is the identifier of the hold target object. ' - . 'org_unit is org unit ID.', - type => 'object' - }, - }, - return => { - desc => q/Result hash like { "copy" : copy_id, "location" : location_name }, empty hash on misses, event on error./, - type => 'object' - } - } -); - -sub hold_has_copy_at { - my($self, $conn, $auth, $args) = @_; - - my $e = new_editor(authtoken=>$auth); - $e->checkauth or return $e->event; - - my $hold_type = $$args{hold_type}; - my $hold_target = $$args{hold_target}; - my $org_unit = $$args{org_unit}; - - my $query = { - select => {acp => ['id'], acpl => ['name']}, - from => { - acp => { - acpl => {field => 'id', filter => { holdable => 't'}, fkey => 'location'}, - ccs => {field => 'id', filter => { holdable => 't'}, fkey => 'status' } - } - }, - where => {'+acp' => { circulate => 't', deleted => 'f', holdable => 't', circ_lib => $org_unit}}, - limit => 1 - }; - - if($hold_type eq 'C') { - - $query->{where}->{'+acp'}->{id} = $hold_target; - - } elsif($hold_type eq 'V') { - - $query->{where}->{'+acp'}->{call_number} = $hold_target; - - } elsif($hold_type eq 'T') { - - $query->{from}->{acp}->{acn} = { - field => 'id', - fkey => 'call_number', - 'join' => { - bre => { - field => 'id', - filter => {id => $hold_target}, - fkey => 'record' - } - } - }; - - } else { - - $query->{from}->{acp}->{acn} = { - field => 'id', - fkey => 'call_number', - join => { - bre => { - field => 'id', - fkey => 'record', - join => { - mmrsm => { - field => 'source', - fkey => 'id', - filter => {metarecord => $hold_target}, - } - } - } - } - }; - } - - my $res = $e->json_query($query)->[0] or return {}; - return {copy => $res->{id}, location => $res->{name}} if $res; -} - - -# returns true if the user already has an item checked out -# that could be used to fulfill the requested hold. -sub hold_item_is_checked_out { - my($e, $user_id, $hold_type, $hold_target) = @_; - - my $query = { - select => {acp => ['id']}, - from => {acp => {}}, - where => { - '+acp' => { - id => { - in => { # copies for circs the user has checked out - select => {circ => ['target_copy']}, - from => 'circ', - where => { - usr => $user_id, - checkin_time => undef, - '-or' => [ - {stop_fines => ["MAXFINES","LONGOVERDUE"]}, - {stop_fines => undef} - ], - } - } - } - } - }, - limit => 1 - }; - - if($hold_type eq 'C' || $hold_type eq 'R' || $hold_type eq 'F') { - - $query->{where}->{'+acp'}->{id}->{in}->{where}->{'target_copy'} = $hold_target; - - } elsif($hold_type eq 'V') { - - $query->{where}->{'+acp'}->{call_number} = $hold_target; - - } elsif($hold_type eq 'I') { - - $query->{from}->{acp}->{sitem} = { - field => 'unit', - fkey => 'id', - filter => {issuance => $hold_target}, - }; - - } elsif($hold_type eq 'T') { - - $query->{from}->{acp}->{acn} = { - field => 'id', - fkey => 'call_number', - 'join' => { - bre => { - field => 'id', - filter => {id => $hold_target}, - fkey => 'record' - } - } - }; - - } else { - - $query->{from}->{acp}->{acn} = { - field => 'id', - fkey => 'call_number', - join => { - bre => { - field => 'id', - fkey => 'record', - join => { - mmrsm => { - field => 'source', - fkey => 'id', - filter => {metarecord => $hold_target}, - } - } - } - } - }; - } - - return $e->json_query($query)->[0]; -} - -__PACKAGE__->register_method( - method => 'change_hold_title', - api_name => 'open-ils.circ.hold.change_title', - signature => { - desc => q/ - Updates all title level holds targeting the specified bibs to point a new bib./, - params => [ - { desc => 'Authentication Token', type => 'string' }, - { desc => 'New Target Bib Id', type => 'number' }, - { desc => 'Old Target Bib Ids', type => 'array' }, - ], - return => { desc => '1 on success' } - } -); - -sub change_hold_title { - my( $self, $client, $auth, $new_bib_id, $bib_ids ) = @_; - - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - - my $holds = $e->search_action_hold_request( - [ - { - cancel_time => undef, - fulfillment_time => undef, - hold_type => 'T', - target => $bib_ids - }, - { - flesh => 1, - flesh_fields => { ahr => ['usr'] } - } - ], - { substream => 1 } - ); - - for my $hold (@$holds) { - $e->allowed('UPDATE_HOLD', $hold->usr->home_ou) or return $e->die_event; - $logger->info("Changing hold " . $hold->id . " target from " . $hold->target . " to $new_bib_id in title hold target change"); - $hold->target( $new_bib_id ); - $e->update_action_hold_request($hold) or return $e->die_event; - } - - $e->commit; - - return 1; -} - - -__PACKAGE__->register_method( - method => 'rec_hold_count', - api_name => 'open-ils.circ.bre.holds.count', - signature => { - desc => q/Returns the total number of holds that target the - selected bib record or its associated copies and call_numbers/, - params => [ - { desc => 'Bib ID', type => 'number' }, - ], - return => {desc => 'Hold count', type => 'number'} - } -); - -__PACKAGE__->register_method( - method => 'rec_hold_count', - api_name => 'open-ils.circ.mmr.holds.count', - signature => { - desc => q/Returns the total number of holds that target the - selected metarecord or its associated copies, call_numbers, and bib records/, - params => [ - { desc => 'Metarecord ID', type => 'number' }, - ], - return => {desc => 'Hold count', type => 'number'} - } -); - -sub rec_hold_count { - my($self, $conn, $target_id) = @_; - - - my $mmr_join = { - mmrsm => { - field => 'id', - fkey => 'source', - filter => {metarecord => $target_id} - } - }; - - my $bre_join = { - bre => { - field => 'id', - filter => { id => $target_id }, - fkey => 'record' - } - }; - - if($self->api_name =~ /mmr/) { - delete $bre_join->{bre}->{filter}; - $bre_join->{bre}->{join} = $mmr_join; - } - - my $cn_join = { - acn => { - field => 'id', - fkey => 'call_number', - join => $bre_join - } - }; - - my $query = { - select => {ahr => [{column => 'id', transform => 'count', alias => 'count'}]}, - from => 'ahr', - where => { - '+ahr' => { - cancel_time => undef, - fulfillment_time => undef, - '-or' => [ - { - '-and' => { - hold_type => 'C', - target => { - in => { - select => {acp => ['id']}, - from => { acp => $cn_join } - } - } - } - }, - { - '-and' => { - hold_type => 'V', - target => { - in => { - select => {acn => ['id']}, - from => {acn => $bre_join} - } - } - } - }, - { - '-and' => { - hold_type => 'T', - target => $target_id - } - } - ] - } - } - }; - - if($self->api_name =~ /mmr/) { - $query->{where}->{'+ahr'}->{'-or'}->[2] = { - '-and' => { - hold_type => 'T', - target => { - in => { - select => {bre => ['id']}, - from => {bre => $mmr_join} - } - } - } - }; - - $query->{where}->{'+ahr'}->{'-or'}->[3] = { - '-and' => { - hold_type => 'M', - target => $target_id - } - }; - } - - - return new_editor()->json_query($query)->[0]->{count}; -} - - - - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ/Money.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ/Money.pm deleted file mode 100644 index 66de1abc0d..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ/Money.pm +++ /dev/null @@ -1,1001 +0,0 @@ -# --------------------------------------------------------------- -# Copyright (C) 2005 Georgia Public Library Service -# Bill Erickson - -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# --------------------------------------------------------------- - -package OpenILS::Application::Circ::Money; -use base qw/OpenILS::Application/; -use strict; use warnings; -use OpenILS::Application::AppUtils; -my $apputils = "OpenILS::Application::AppUtils"; -my $U = "OpenILS::Application::AppUtils"; - -use OpenSRF::EX qw(:try); -use OpenILS::Perm; -use Data::Dumper; -use OpenILS::Event; -use OpenSRF::Utils::Logger qw/:logger/; -use OpenILS::Utils::CStoreEditor qw/:funcs/; -use OpenILS::Utils::Penalty; -$Data::Dumper::Indent = 0; - -__PACKAGE__->register_method( - method => "make_payments", - api_name => "open-ils.circ.money.payment", - signature => { - desc => q/Create payments for a given user and set of transactions, - login must have CREATE_PAYMENT privileges. - If any payments fail, all are reverted back./, - params => [ - {desc => 'Authtoken', type => 'string'}, - {desc => q/Arguments Hash, supporting the following params: - { - payment_type - userid - patron_credit - note - cc_args: { - where_process 1 to use processor, !1 for out-of-band - approval_code (for out-of-band payment) - type (for out-of-band payment) - number (for call to payment processor) - expire_month (for call to payment processor) - expire_year (for call to payment processor) - billing_first (for out-of-band payments and for call to payment processor) - billing_last (for out-of-band payments and for call to payment processor) - billing_address (for call to payment processor) - billing_city (for call to payment processor) - billing_state (for call to payment processor) - billing_zip (for call to payment processor) - note (if payments->{note} is blank, use this) - }, - check_number - payments: [ - [trans_id, amt], - [...] - ], - }/, type => 'hash' - }, - { - desc => q/Last user transaction ID. This is the actor.usr.last_xact_id value/, - type => 'string' - } - ], - "return" => { - "desc" => - q{Array of payment IDs on success, event on failure. Event possibilities include: - BAD_PARAMS - Bad parameters were given to this API method itself. - See note field. - INVALID_USER_XACT_ID - The last user transaction ID does not match the ID in the database. This means - the user object has been updated since the last retrieval. The client should - be instructed to reload the user object and related transactions before attempting - another payment - REFUND_EXCEEDS_BALANCE - REFUND_EXCEEDS_DESK_PAYMENTS - CREDIT_PROCESSOR_NOT_SPECIFIED - Evergreen has not been set up to process CC payments. - CREDIT_PROCESSOR_NOT_ALLOWED - Evergreen has been incorrectly setup for CC payments. - CREDIT_PROCESSOR_NOT_ENABLED - Evergreen has been set up for CC payments, but an admin - has not explicitly enabled them. - CREDIT_PROCESSOR_BAD_PARAMS - Evergreen has been incorrectly setup for CC payments; - specifically, the login and/or password for the CC - processor weren't provided. - CREDIT_PROCESSOR_INVALID_CC_NUMBER - You have supplied a credit card number that Evergreen - has judged to be invalid even before attempting to contact - the payment processor. - CREDIT_PROCESSOR_DECLINED_TRANSACTION - We contacted the CC processor to attempt the charge, but - they declined it. - The error_message field of the event payload will - contain the payment processor's response. This - typically includes a message in plain English intended - for human consumption. In PayPal's case, the message - is preceded by an integer, a colon, and a space, so - a caller might take the 2nd match from /^(\d+: )?(.+)$/ - to present to the user. - The payload also contains other fields from the payment - processor, but these are generally not user-friendly - strings. - CREDIT_PROCESSOR_SUCCESS_WO_RECORD - A payment was processed successfully, but couldn't be - recorded in Evergreen. This is _bad bad bad_, as it means - somebody made a payment but isn't getting credit for it. - See errors in the system log if this happens. Info from - the credit card transaction will also be available in the - event payload, although this probably won't be suitable for - staff client/OPAC display. -}, - "type" => "number" - } - } -); -sub make_payments { - my($self, $client, $auth, $payments, $last_xact_id) = @_; - - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - - my $type = $payments->{payment_type}; - my $user_id = $payments->{userid}; - my $credit = $payments->{patron_credit} || 0; - my $drawer = $e->requestor->wsid; - my $note = $payments->{note}; - my $cc_args = $payments->{cc_args}; - my $check_number = $payments->{check_number}; - my $total_paid = 0; - my $this_ou = $e->requestor->ws_ou; - my %orgs; - - # unless/until determined by payment processor API - my ($approval_code, $cc_processor, $cc_type) = (undef,undef,undef); - - my $patron = $e->retrieve_actor_user($user_id) or return $e->die_event; - - if($patron->last_xact_id ne $last_xact_id) { - $e->rollback; - return OpenILS::Event->new('INVALID_USER_XACT_ID'); - } - - # A user is allowed to make credit card payments on his/her own behalf - # All other scenarious require permission - unless($type eq 'credit_card_payment' and $user_id == $e->requestor->id) { - return $e->die_event unless $e->allowed('CREATE_PAYMENT', $patron->home_ou); - } - - # first collect the transactions and make sure the transaction - # user matches the requested user - my %xacts; - for my $pay (@{$payments->{payments}}) { - my $xact_id = $pay->[0]; - my $xact = $e->retrieve_money_billable_transaction_summary($xact_id) - or return $e->die_event; - - if($xact->usr != $user_id) { - $e->rollback; - return OpenILS::Event->new('BAD_PARAMS', note => q/user does not match transaction/); - } - - $xacts{$xact_id} = $xact; - } - - my @payment_objs; - - for my $pay (@{$payments->{payments}}) { - my $transid = $pay->[0]; - my $amount = $pay->[1]; - $amount =~ s/\$//og; # just to be safe - my $trans = $xacts{$transid}; - - $total_paid += $amount; - - $orgs{$U->xact_org($transid, $e)} = 1; - - # A negative payment is a refund. - if( $amount < 0 ) { - - # Negative credit card payments are not allowed - if($type eq 'credit_card_payment') { - $e->rollback; - return OpenILS::Event->new( - 'BAD_PARAMS', - note => q/Negative credit card payments not allowed/ - ); - } - - # If the refund causes the transaction balance to exceed 0 dollars, - # we are in effect loaning the patron money. This is not allowed. - if( ($trans->balance_owed - $amount) > 0 ) { - $e->rollback; - return OpenILS::Event->new('REFUND_EXCEEDS_BALANCE'); - } - - # Otherwise, make sure the refund does not exceed desk payments - # This is also not allowed - my $desk_total = 0; - my $desk_payments = $e->search_money_desk_payment({xact => $transid, voided => 'f'}); - $desk_total += $_->amount for @$desk_payments; - - if( (-$amount) > $desk_total ) { - $e->rollback; - return OpenILS::Event->new( - 'REFUND_EXCEEDS_DESK_PAYMENTS', - payload => { allowed_refund => $desk_total, submitted_refund => -$amount } ); - } - } - - my $payobj = "Fieldmapper::money::$type"; - $payobj = $payobj->new; - - $payobj->amount($amount); - $payobj->amount_collected($amount); - $payobj->xact($transid); - $payobj->note($note); - if ((not $payobj->note) and ($type eq 'credit_card_payment')) { - $payobj->note($cc_args->{note}); - } - - if ($payobj->has_field('accepting_usr')) { $payobj->accepting_usr($e->requestor->id); } - if ($payobj->has_field('cash_drawer')) { $payobj->cash_drawer($drawer); } - if ($payobj->has_field('cc_type')) { $payobj->cc_type($cc_args->{type}); } - if ($payobj->has_field('check_number')) { $payobj->check_number($check_number); } - - # Store the last 4 digits of the CC number - if ($payobj->has_field('cc_number')) { - $payobj->cc_number(substr($cc_args->{number}, -4)); - } - if ($payobj->has_field('expire_month')) { $payobj->expire_month($cc_args->{expire_month}); } - if ($payobj->has_field('expire_year')) { $payobj->expire_year($cc_args->{expire_year}); } - - # Note: It is important not to set approval_code - # on the fieldmapper object yet. - - push(@payment_objs, $payobj); - - } # all payment objects have been created and inserted. - - #### NO WRITES TO THE DB ABOVE THIS LINE -- THEY'LL ONLY BE DISCARDED ### - $e->rollback; - - # After we try to externally process a credit card (if desired), we'll - # open a new transaction. We cannot leave one open while credit card - # processing might be happening, as it can easily time out the database - # transaction. - - my $cc_payload; - - if($type eq 'credit_card_payment') { - $approval_code = $cc_args->{approval_code}; - # If an approval code was not given, we'll need - # to call to the payment processor ourselves. - if ($cc_args->{where_process} == 1) { - return OpenILS::Event->new('BAD_PARAMS', note => 'Need CC number') - if not $cc_args->{number}; - my $response = - OpenILS::Application::Circ::CreditCard::process_payment({ - "desc" => $cc_args->{note}, - "amount" => $total_paid, - "patron_id" => $user_id, - "cc" => $cc_args->{number}, - "expiration" => sprintf( - "%02d-%04d", - $cc_args->{expire_month}, - $cc_args->{expire_year} - ), - "ou" => $this_ou, - "first_name" => $cc_args->{billing_first}, - "last_name" => $cc_args->{billing_last}, - "address" => $cc_args->{billing_address}, - "city" => $cc_args->{billing_city}, - "state" => $cc_args->{billing_state}, - "zip" => $cc_args->{billing_zip}, - }); - - if ($U->event_code($response)) { # non-success - $logger->info( - "Credit card payment for user $user_id failed: " . - $response->{"textcode"} . " " . - $response->{"payload"}->{"error_message"} - ); - - return $response; - } else { - # We need to save this for later in case there's a failure on - # the EG side to store the processor's result. - $cc_payload = $response->{"payload"}; - - $approval_code = $cc_payload->{"authorization"}; - $cc_type = $cc_payload->{"card_type"}; - $cc_processor = $cc_payload->{"processor"}; - $logger->info("Credit card payment for user $user_id succeeded"); - } - } else { - return OpenILS::Event->new( - 'BAD_PARAMS', note => 'Need approval code' - ) if not $cc_args->{approval_code}; - } - } - - ### RE-OPEN TRANSACTION HERE ### - $e->xact_begin; - my @payment_ids; - - # create payment records - my $create_money_method = "create_money_" . $type; - for my $payment (@payment_objs) { - # update the transaction if it's done - my $amount = $payment->amount; - my $transid = $payment->xact; - my $trans = $xacts{$transid}; - if( (my $cred = ($trans->balance_owed - $amount)) <= 0 ) { - # Any overpay on this transaction goes directly into patron - # credit making payment with existing patron credit. - $credit -= $amount if $type eq 'credit_payment'; - - $cred = -$cred; - $credit += $cred; - my $circ = $e->retrieve_action_circulation($transid); - - if(!$circ || $circ->stop_fines) { - # If this is a circulation, we can't close the transaction - # unless stop_fines is set. - $trans = $e->retrieve_money_billable_transaction($transid); - $trans->xact_finish("now"); - if (!$e->update_money_billable_transaction($trans)) { - return _recording_failure( - $e, "update_money_billable_transaction() failed", - $payment, $cc_payload - ) - } - } - } - - $payment->approval_code($approval_code) if $approval_code; - $payment->cc_type($cc_type) if $cc_type; - $payment->cc_processor($cc_processor) if $cc_processor; - $payment->cc_first_name($cc_args->{'billing_first'}) if $cc_args->{'billing_first'}; - $payment->cc_last_name($cc_args->{'billing_last'}) if $cc_args->{'billing_last'}; - if (!$e->$create_money_method($payment)) { - return _recording_failure( - $e, "$create_money_method failed", $payment, $cc_payload - ); - } - - push(@payment_ids, $payment->id); - } - - my $evt = _update_patron_credit($e, $patron, $credit); - if ($evt) { - return _recording_failure( - $e, "_update_patron_credit() failed", undef, $cc_payload - ); - } - - for my $org_id (keys %orgs) { - # calculate penalties for each of the affected orgs - $evt = OpenILS::Utils::Penalty->calculate_penalties( - $e, $user_id, $org_id - ); - if ($evt) { - return _recording_failure( - $e, "calculate_penalties() failed", undef, $cc_payload - ); - } - } - - # update the user to create a new last_xact_id - $e->update_actor_user($patron) or return $e->die_event; - $patron = $e->retrieve_actor_user($patron) or return $e->die_event; - $e->commit; - - # update the cached user object if a user is making a payment toward - # his/her own account - $U->simplereq('open-ils.auth', 'open-ils.auth.session.reset_timeout', $auth, 1) - if $user_id == $e->requestor->id; - - return {last_xact_id => $patron->last_xact_id, payments => \@payment_ids}; -} - -sub _recording_failure { - my ($e, $msg, $payment, $payload) = @_; - - if ($payload) { # If the payment processor already accepted a payment: - $logger->error($msg); - $logger->error("Payment processor payload: " . Dumper($payload)); - # payment shouldn't contain CC number - $logger->error("Payment: " . Dumper($payment)) if $payment; - - $e->rollback; - - return new OpenILS::Event( - "CREDIT_PROCESSOR_SUCCESS_WO_RECORD", - "payload" => $payload - ); - } else { # Otherwise, the problem is somewhat less severe: - $logger->warn($msg); - $logger->warn("Payment: " . Dumper($payment)) if $payment; - return $e->die_event; - } -} - -sub _update_patron_credit { - my($e, $patron, $credit) = @_; - return undef if $credit == 0; - $patron->credit_forward_balance($patron->credit_forward_balance + $credit); - return OpenILS::Event->new('NEGATIVE_PATRON_BALANCE') if $patron->credit_forward_balance < 0; - $e->update_actor_user($patron) or return $e->die_event; - return undef; -} - - -__PACKAGE__->register_method( - method => "retrieve_payments", - api_name => "open-ils.circ.money.payment.retrieve.all_", - notes => "Returns a list of payments attached to a given transaction" - ); -sub retrieve_payments { - my( $self, $client, $login, $transid ) = @_; - - my( $staff, $evt ) = - $apputils->checksesperm($login, 'VIEW_TRANSACTION'); - return $evt if $evt; - - # XXX the logic here is wrong.. we need to check the owner of the transaction - # to make sure the requestor has access - - # XXX grab the view, for each object in the view, grab the real object - - return $apputils->simplereq( - 'open-ils.cstore', - 'open-ils.cstore.direct.money.payment.search.atomic', { xact => $transid } ); -} - - -__PACKAGE__->register_method( - method => "retrieve_payments2", - authoritative => 1, - api_name => "open-ils.circ.money.payment.retrieve.all", - notes => "Returns a list of payments attached to a given transaction" - ); - -sub retrieve_payments2 { - my( $self, $client, $login, $transid ) = @_; - - my $e = new_editor(authtoken=>$login); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_TRANSACTION'); - - my @payments; - my $pmnts = $e->search_money_payment({ xact => $transid }); - for( @$pmnts ) { - my $type = $_->payment_type; - my $meth = "retrieve_money_$type"; - my $p = $e->$meth($_->id) or return $e->event; - $p->payment_type($type); - $p->cash_drawer($e->retrieve_actor_workstation($p->cash_drawer)) - if $p->has_field('cash_drawer'); - push( @payments, $p ); - } - - return \@payments; -} - -__PACKAGE__->register_method( - method => "format_payment_receipt", - api_name => "open-ils.circ.money.payment_receipt.print", - signature => { - desc => 'Returns a printable receipt for the specified payments', - params => [ - { desc => 'Authentication token', type => 'string'}, - { desc => 'Payment ID or array of payment IDs', type => 'number' }, - ], - return => { - desc => q/An action_trigger.event object or error event./, - type => 'object', - } - } -); -__PACKAGE__->register_method( - method => "format_payment_receipt", - api_name => "open-ils.circ.money.payment_receipt.email", - signature => { - desc => 'Emails a receipt for the specified payments to the user associated with the first payment', - params => [ - { desc => 'Authentication token', type => 'string'}, - { desc => 'Payment ID or array of payment IDs', type => 'number' }, - ], - return => { - desc => q/Undefined on success, otherwise an error event./, - type => 'object', - } - } -); - -sub format_payment_receipt { - my($self, $conn, $auth, $mp_id) = @_; - - my $mp_ids; - if (ref $mp_id ne 'ARRAY') { - $mp_ids = [ $mp_id ]; - } else { - $mp_ids = $mp_id; - } - - my $for_print = ($self->api_name =~ /print/); - my $for_email = ($self->api_name =~ /email/); - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - my $payments = []; - for my $id (@$mp_ids) { - - my $payment = $e->retrieve_money_payment([ - $id, - { flesh => 2, - flesh_fields => { - mp => ['xact'], - mbt => ['usr'] - } - } - ]) or return OpenILS::Event->new('MP_NOT_FOUND'); - - return $e->event unless $e->allowed('VIEW_TRANSACTION', $payment->xact->usr->home_ou); - - push @$payments, $payment; - } - - if ($for_print) { - - return $U->fire_object_event(undef, 'money.format.payment_receipt.print', $payments, $$payments[0]->xact->usr->home_ou); - - } elsif ($for_email) { - - for my $p (@$payments) { - $U->create_events_for_hook('money.format.payment_receipt.email', $p, $p->xact->usr->home_ou, undef, undef, 1); - } - } - - return undef; -} - -__PACKAGE__->register_method( - method => "create_grocery_bill", - api_name => "open-ils.circ.money.grocery.create", - notes => <<" NOTE"); - Creates a new grocery transaction using the transaction object provided - PARAMS: (login_session, money.grocery (mg) object) - NOTE - -sub create_grocery_bill { - my( $self, $client, $login, $transaction ) = @_; - - my( $staff, $evt ) = $apputils->checkses($login); - return $evt if $evt; - $evt = $apputils->check_perms($staff->id, - $transaction->billing_location, 'CREATE_TRANSACTION' ); - return $evt if $evt; - - - $logger->activity("Creating grocery bill " . Dumper($transaction) ); - - $transaction->clear_id; - my $session = $apputils->start_db_session; - my $transid = $session->request( - 'open-ils.storage.direct.money.grocery.create', $transaction)->gather(1); - - throw OpenSRF::EX ("Error creating new money.grocery") unless defined $transid; - - $logger->debug("Created new grocery transaction $transid"); - - $apputils->commit_db_session($session); - - my $e = new_editor(xact=>1); - $evt = _check_open_xact($e, $transid); - return $evt if $evt; - $e->commit; - - return $transid; -} - - -__PACKAGE__->register_method( - method => 'fetch_reservation', - api_name => 'open-ils.circ.booking.reservation.retrieve' -); -sub fetch_reservation { - my( $self, $conn, $auth, $id ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_TRANSACTION'); # eh.. basically the same permission - my $g = $e->retrieve_booking_reservation($id) - or return $e->event; - return $g; -} - -__PACKAGE__->register_method( - method => 'fetch_grocery', - api_name => 'open-ils.circ.money.grocery.retrieve' -); -sub fetch_grocery { - my( $self, $conn, $auth, $id ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_TRANSACTION'); # eh.. basically the same permission - my $g = $e->retrieve_money_grocery($id) - or return $e->event; - return $g; -} - - -__PACKAGE__->register_method( - method => "billing_items", - api_name => "open-ils.circ.money.billing.retrieve.all", - authoritative => 1, - signature => { - desc => 'Returns a list of billing items for the given transaction ID. ' . - 'If the operator is not the owner of the transaction, the VIEW_TRANSACTION permission is required.', - params => [ - { desc => 'Authentication token', type => 'string'}, - { desc => 'Transaction ID', type => 'number'} - ], - return => { - desc => 'Transaction object, event on error' - }, - } -); - -sub billing_items { - my( $self, $client, $login, $transid ) = @_; - - my( $trans, $evt ) = $U->fetch_billable_xact($transid); - return $evt if $evt; - - my $staff; - ($staff, $evt ) = $apputils->checkses($login); - return $evt if $evt; - - if($staff->id ne $trans->usr) { - $evt = $U->check_perms($staff->id, $staff->home_ou, 'VIEW_TRANSACTION'); - return $evt if $evt; - } - - return $apputils->simplereq( 'open-ils.cstore', - 'open-ils.cstore.direct.money.billing.search.atomic', { xact => $transid } ) -} - - -__PACKAGE__->register_method( - method => "billing_items_create", - api_name => "open-ils.circ.money.billing.create", - notes => <<" NOTE"); - Creates a new billing line item - PARAMS( login, bill_object (mb) ) - NOTE - -sub billing_items_create { - my( $self, $client, $login, $billing ) = @_; - - my $e = new_editor(authtoken => $login, xact => 1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('CREATE_BILL'); - - my $xact = $e->retrieve_money_billable_transaction($billing->xact) - or return $e->die_event; - - # if the transaction was closed, re-open it - if($xact->xact_finish) { - $xact->clear_xact_finish; - $e->update_money_billable_transaction($xact) - or return $e->die_event; - } - - my $amt = $billing->amount; - $amt =~ s/\$//og; - $billing->amount($amt); - - $e->create_money_billing($billing) or return $e->die_event; - my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $xact->usr, $U->xact_org($xact->id)); - return $evt if $evt; - $e->commit; - - return $billing->id; -} - - -__PACKAGE__->register_method( - method => 'void_bill', - api_name => 'open-ils.circ.money.billing.void', - signature => q/ - Voids a bill - @param authtoken Login session key - @param billid Id for the bill to void. This parameter may be repeated to reference other bills. - @return 1 on success, Event on error - / -); -sub void_bill { - my( $s, $c, $authtoken, @billids ) = @_; - - my $e = new_editor( authtoken => $authtoken, xact => 1 ); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('VOID_BILLING'); - - my %users; - for my $billid (@billids) { - - my $bill = $e->retrieve_money_billing($billid) - or return $e->die_event; - - my $xact = $e->retrieve_money_billable_transaction($bill->xact) - or return $e->die_event; - - if($U->is_true($bill->voided)) { - $e->rollback; - return OpenILS::Event->new('BILL_ALREADY_VOIDED', payload => $bill); - } - - my $org = $U->xact_org($bill->xact, $e); - $users{$xact->usr} = {} unless $users{$xact->usr}; - $users{$xact->usr}->{$org} = 1; - - $bill->voided('t'); - $bill->voider($e->requestor->id); - $bill->void_time('now'); - - $e->update_money_billing($bill) or return $e->die_event; - my $evt = _check_open_xact($e, $bill->xact, $xact); - return $evt if $evt; - } - - # calculate penalties for all user/org combinations - for my $user_id (keys %users) { - for my $org_id (keys %{$users{$user_id}}) { - OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $org_id); - } - } - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - method => 'edit_bill_note', - api_name => 'open-ils.circ.money.billing.note.edit', - signature => q/ - Edits the note for a bill - @param authtoken Login session key - @param note The replacement note for the bills we're editing - @param billid Id for the bill to edit the note of. This parameter may be repeated to reference other bills. - @return 1 on success, Event on error - / -); -sub edit_bill_note { - my( $s, $c, $authtoken, $note, @billids ) = @_; - - my $e = new_editor( authtoken => $authtoken, xact => 1 ); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('UPDATE_BILL_NOTE'); - - for my $billid (@billids) { - - my $bill = $e->retrieve_money_billing($billid) - or return $e->die_event; - - $bill->note($note); - # FIXME: Does this get audited? Need some way so that the original creator of the bill does not get credit/blame for the new note. - - $e->update_money_billing($bill) or return $e->die_event; - } - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - method => 'edit_payment_note', - api_name => 'open-ils.circ.money.payment.note.edit', - signature => q/ - Edits the note for a payment - @param authtoken Login session key - @param note The replacement note for the payments we're editing - @param paymentid Id for the payment to edit the note of. This parameter may be repeated to reference other payments. - @return 1 on success, Event on error - / -); -sub edit_payment_note { - my( $s, $c, $authtoken, $note, @paymentids ) = @_; - - my $e = new_editor( authtoken => $authtoken, xact => 1 ); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('UPDATE_PAYMENT_NOTE'); - - for my $paymentid (@paymentids) { - - my $payment = $e->retrieve_money_payment($paymentid) - or return $e->die_event; - - $payment->note($note); - # FIXME: Does this get audited? Need some way so that the original taker of the payment does not get credit/blame for the new note. - - $e->update_money_payment($payment) or return $e->die_event; - } - - $e->commit; - return 1; -} - -sub _check_open_xact { - my( $editor, $xactid, $xact ) = @_; - - # Grab the transaction - $xact ||= $editor->retrieve_money_billable_transaction($xactid); - return $editor->event unless $xact; - $xactid ||= $xact->id; - - # grab the summary and see how much is owed on this transaction - my ($summary) = $U->fetch_mbts($xactid, $editor); - - # grab the circulation if it is a circ; - my $circ = $editor->retrieve_action_circulation($xactid); - - # If nothing is owed on the transaction but it is still open - # and this transaction is not an open circulation, close it - if( - ( $summary->balance_owed == 0 and ! $xact->xact_finish ) and - ( !$circ or $circ->stop_fines )) { - - $logger->info("closing transaction ".$xact->id. ' becauase balance_owed == 0'); - $xact->xact_finish('now'); - $editor->update_money_billable_transaction($xact) - or return $editor->event; - return undef; - } - - # If money is owed or a refund is due on the xact and xact_finish - # is set, clear it (to reopen the xact) and update - if( $summary->balance_owed != 0 and $xact->xact_finish ) { - $logger->info("re-opening transaction ".$xact->id. ' becauase balance_owed != 0'); - $xact->clear_xact_finish; - $editor->update_money_billable_transaction($xact) - or return $editor->event; - return undef; - } - return undef; -} - - -__PACKAGE__->register_method ( - method => 'fetch_mbts', - authoritative => 1, - api_name => 'open-ils.circ.money.billable_xact_summary.retrieve' -); -sub fetch_mbts { - my( $self, $conn, $auth, $id) = @_; - - my $e = new_editor(xact => 1, authtoken=>$auth); - return $e->event unless $e->checkauth; - my ($mbts) = $U->fetch_mbts($id, $e); - - my $user = $e->retrieve_actor_user($mbts->usr) - or return $e->die_event; - - return $e->die_event unless $e->allowed('VIEW_TRANSACTION', $user->home_ou); - $e->rollback; - return $mbts -} - - -__PACKAGE__->register_method( - method => 'desk_payments', - api_name => 'open-ils.circ.money.org_unit.desk_payments' -); -sub desk_payments { - my( $self, $conn, $auth, $org, $start_date, $end_date ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_TRANSACTION', $org); - my $data = $U->storagereq( - 'open-ils.storage.money.org_unit.desk_payments.atomic', - $org, $start_date, $end_date ); - - $_->workstation( $_->workstation->name ) for(@$data); - return $data; -} - - -__PACKAGE__->register_method( - method => 'user_payments', - api_name => 'open-ils.circ.money.org_unit.user_payments' -); - -sub user_payments { - my( $self, $conn, $auth, $org, $start_date, $end_date ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_TRANSACTION', $org); - my $data = $U->storagereq( - 'open-ils.storage.money.org_unit.user_payments.atomic', - $org, $start_date, $end_date ); - for(@$data) { - $_->usr->card( - $e->retrieve_actor_card($_->usr->card)->barcode); - $_->usr->home_ou( - $e->retrieve_actor_org_unit($_->usr->home_ou)->shortname); - } - return $data; -} - - -__PACKAGE__->register_method( - method => 'retrieve_credit_payable_balance', - api_name => 'open-ils.circ.credit.payable_balance.retrieve', - authoritative => 1, - signature => { - desc => q/Returns the total amount the patron can pay via credit card/, - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'User id', type => 'number' } - ], - return => { desc => 'The ID of the new provider' } - } -); - -sub retrieve_credit_payable_balance { - my ( $self, $conn, $auth, $user_id ) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - my $user = $e->retrieve_actor_user($user_id) - or return $e->event; - - if($e->requestor->id != $user_id) { - return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou) - } - - my $circ_orgs = $e->json_query({ - "select" => {circ => ["circ_lib"]}, - from => "circ", - "where" => {usr => $user_id, xact_finish => undef}, - distinct => 1 - }); - - my $groc_orgs = $e->json_query({ - "select" => {mg => ["billing_location"]}, - from => "mg", - "where" => {usr => $user_id, xact_finish => undef}, - distinct => 1 - }); - - my %hash; - for my $org ( @$circ_orgs, @$groc_orgs ) { - my $o = $org->{billing_location}; - $o = $org->{circ_lib} unless $o; - next if $hash{$o}; # was $hash{$org}, but that doesn't make sense. $org is a hashref and $o gets added in the next line. - $hash{$o} = $U->ou_ancestor_setting_value($o, 'credit.payments.allow', $e); - } - - my @credit_orgs = map { $hash{$_} ? ($_) : () } keys %hash; - $logger->debug("credit: relevant orgs that allow credit payments => @credit_orgs"); - - my $xact_summaries = - OpenILS::Application::AppUtils->simplereq('open-ils.actor', - 'open-ils.actor.user.transactions.have_charge', $auth, $user_id); - - my $sum = 0.0; - - for my $xact (@$xact_summaries) { - - # make two lists and grab them in batch XXX - if ( $xact->xact_type eq 'circulation' ) { - my $circ = $e->retrieve_action_circulation($xact->id) or return $e->event; - next unless grep { $_ == $circ->circ_lib } @credit_orgs; - - } elsif ($xact->xact_type eq 'grocery') { - my $bill = $e->retrieve_money_grocery($xact->id) or return $e->event; - next unless grep { $_ == $bill->billing_location } @credit_orgs; - } elsif ($xact->xact_type eq 'reservation') { - my $bill = $e->retrieve_booking_reservation($xact->id) or return $e->event; - next unless grep { $_ == $bill->pickup_lib } @credit_orgs; - } - $sum += $xact->balance_owed(); - } - - return $sum; -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ/NonCat.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ/NonCat.pm deleted file mode 100644 index fd35b19ed8..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ/NonCat.pm +++ /dev/null @@ -1,263 +0,0 @@ -package OpenILS::Application::Circ::NonCat; -use base 'OpenILS::Application'; -use strict; use warnings; -use OpenSRF::EX qw(:try); -use Data::Dumper; -use DateTime; -use DateTime::Format::ISO8601; -use OpenSRF::Utils qw/:datetime/; -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Application::AppUtils; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::Editor; -use OpenILS::Utils::CStoreEditor qw/:funcs/; -$Data::Dumper::Indent = 0; - -my $U = "OpenILS::Application::AppUtils"; -my $_dt_parser = DateTime::Format::ISO8601->new; - - -# returns ( $newid, $evt ). If $evt, then there was an error -sub create_non_cat_circ { - my( $staffid, $patronid, $circ_lib, $noncat_type, $circ_time, $editor ) = @_; - - my( $id, $nct, $evt ); - $circ_time ||= 'now'; - my $circ = Fieldmapper::action::non_cataloged_circulation->new; - - $logger->activity("Creating non-cataloged circulation for ". - "staff $staffid, patron $patronid, location $circ_lib, and non-cat type $noncat_type"); - - $circ->patron($patronid); - $circ->staff($staffid); - $circ->circ_lib($circ_lib); - $circ->item_type($noncat_type); - $circ->circ_time($circ_time); - - if( $editor ) { - $evt = $editor->event unless - $circ = $editor->create_action_non_cataloged_circulation( $circ ) - - - } else { - $id = $U->simplereq( - 'open-ils.storage', - 'open-ils.storage.direct.action.non_cataloged_circulation.create', $circ ); - $evt = $U->DB_UPDATE_FAILED($circ) unless $id; - $circ->id($id); - } - - if($circ) { - my $e = ($editor) ? $editor : new_editor(); - $circ = noncat_due_date($e, $circ); - } - - return( $circ, $evt ); -} - - -__PACKAGE__->register_method( - method => "create_noncat_type", - api_name => "open-ils.circ.non_cat_type.create", - notes => q/ - Creates a new non cataloged item type - @param authtoken The login session key - @param name The name of the new type - @param orgId The location where the type will live - @return The type object on success and the corresponding - event on failure - / -); - -sub create_noncat_type { - my( $self, $client, $authtoken, $name, $orgId, $interval, $inhouse ) = @_; - - my $e = new_editor(authtoken=>$authtoken, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('CREATE_NON_CAT_TYPE', $orgId); - - # grab all of "my" non-cat types and see if one with - # the requested name already exists - my $types = retrieve_noncat_types_all($self, $client, $orgId); - for(@$types) { - if( $_->name eq $name ) { - $e->rollback; - return OpenILS::Event->new('NON_CAT_TYPE_EXISTS', payload => $name); - } - } - - my $type = Fieldmapper::config::non_cataloged_type->new; - $type->name($name); - $type->owning_lib($orgId); - $type->circ_duration($interval); - $type->in_house( ($inhouse) ? 't' : 'f' ); - - $e->create_config_non_cataloged_type($type) or return $e->die_event; - $e->commit; - return $type; -} - - -__PACKAGE__->register_method( - method => "update_noncat_type", - api_name => "open-ils.circ.non_cat_type.update", - notes => q/ - Updates a non-cataloged type object - @param authtoken The login session key - @param type The updated type object - @return The result of the DB update call unless a preceeding event occurs, - in which case the event will be returned - / -); - -sub update_noncat_type { - my( $self, $client, $authtoken, $type ) = @_; - my $e = new_editor(xact=>1, authtoken=>$authtoken); - return $e->die_event unless $e->checkauth; - - my $otype = $e->retrieve_config_non_cataloged_type($type->id) - or return $e->die_event; - - return $e->die_event unless - $e->allowed('UPDATE_NON_CAT_TYPE', $otype->owning_lib); - - $type->owning_lib($otype->owning_lib); # do not allow them to "move" the object - - $e->update_config_non_cataloged_type($type) or return $e->die_event; - $e->commit; - return 1; -} - -__PACKAGE__->register_method( - method => "retrieve_noncat_types_all", - api_name => "open-ils.circ.non_cat_types.retrieve.all", - signature => { - desc => 'Retrieves the non-cat types at the requested location as well ' - . 'as those above and below it in the org tree', - params => [ - { name => 'orgId', desc => 'Org unit ID of the base location', type => 'number' }, - { name => 'depth', desc => 'Depth limit of the tree (optional)', type => 'number' } - ], - return => { - desc => 'Array of non-cat objects, event on error' - }, - } -); - -sub retrieve_noncat_types_all { - my( $self, $client, $orgId, $depth ) = @_; - my $meth = 'open-ils.storage.ranged.config.non_cataloged_type.retrieve.atomic'; - my $svc = 'open-ils.storage'; - return $U->simplereq($svc, $meth, $orgId, $depth) if defined($depth); - return $U->simplereq($svc, $meth, $orgId); -} - - -__PACKAGE__->register_method( - method => 'fetch_noncat', - api_name => 'open-ils.circ.non_cataloged_circulation.retrieve', - signature => { - desc => 'Retrieve a circulation on a non cataloged item for a given Circ ID. If the operator is not the ' - . 'patron owner of the circ, the VIEW_CIRCULATIONS permission is required', - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'Circulation ID', type => 'number' } - ], - return => { - desc => 'Circulation object, event on error', - }, - } -); - -sub fetch_noncat { - my( $self, $conn, $auth, $circid ) = @_; - my $e = new_editor( authtoken => $auth ); - return $e->event unless $e->checkauth; - my $c = $e->retrieve_action_non_cataloged_circulation($circid) - or return $e->event; - if( $c->patron ne $e->requestor->id ) { - return $e->event unless $e->allowed('VIEW_CIRCULATIONS'); # XXX rely on editor perm - } - return noncat_due_date($e, $c); -} - -sub noncat_due_date { - my($e, $circ) = @_; - - my $otype = $e->retrieve_config_non_cataloged_type($circ->item_type) - or return $e->die_event; - - my $duedate = $_dt_parser->parse_datetime( cleanse_ISO8601($circ->circ_time) ); - $duedate = $duedate - ->add( seconds => interval_to_seconds($otype->circ_duration) ) - ->strftime('%FT%T%z'); - - my $offset = $U->storagereq( - 'open-ils.storage.actor.org_unit.closed_date.overlap', - $circ->circ_lib, - $duedate - ); - - $duedate = $offset->{end} if ($offset); - $circ->duedate($duedate); - - return $circ; -} - - - -__PACKAGE__->register_method( - method => 'fetch_open_noncats', - authoritative => 1, - api_name => 'open-ils.circ.open_non_cataloged_circulation.user', - signature => { - desca => 'For a given user, returns an id-list of non-cataloged circulations that are considered open as of now. ' . - 'A circ is open if circ time + circ duration (based on type) is > than now. If trying to view the circs ' . - 'of another user, the VIEW_CIRCULATIONS permission is required', - params => [ - { desc => 'Authentication token', type => 'string' }, - { desc => 'UserID (optional: defaults to the session user)', type => 'number' } - ], - return => { - desc => 'Array of non-cataloged circ IDs, event on error' - }, - } -); - -sub fetch_open_noncats { - my( $self, $conn, $auth, $userid ) = @_; - my $e = OpenILS::Utils::Editor->new( authtoken => $auth ); - return $e->event unless $e->checkauth; - $userid ||= $e->requestor->id; - if( $e->requestor->id ne $userid ) { - return $e->event unless $e->allowed('VIEW_CIRCULATIONS'); # XXX rely on editor perm - } - return $e->request( - 'open-ils.storage.action.open_non_cataloged_circulation.user', $userid ); -} - - -__PACKAGE__->register_method( - method => 'delete_noncat', - api_name => 'open-ils.circ.non_cataloged_type.delete', -); -sub delete_noncat { - my( $self, $conn, $auth, $typeid ) = @_; - my $e = new_editor(xact=>1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - - my $nc = $e->retrieve_config_non_cataloged_type($typeid) - or return $e->die_event; - - $e->allowed('DELETE_NON_CAT_TYPE', $nc->owning_lib) # XXX rely on editor perm - or return $e->die_event; - - # XXX Add checks to see if this type is in use by a transaction - - $e->delete_config_non_cataloged_type($nc) or return $e->die_event; - $e->commit; - return 1; -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ/ScriptBuilder.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ/ScriptBuilder.pm deleted file mode 100644 index 7589cab9ef..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ/ScriptBuilder.pm +++ /dev/null @@ -1,435 +0,0 @@ -package OpenILS::Application::Circ::ScriptBuilder; -use strict; use warnings; -use OpenILS::Utils::ScriptRunner; -use OpenILS::Utils::CStoreEditor qw/:funcs/; -use OpenILS::Application::AppUtils; -use OpenSRF::Utils::Logger qw/$logger/; -use OpenILS::Application::Circ::Holds; -use DateTime::Format::ISO8601; -use OpenSRF::Utils qw/:datetime/; -use Scalar::Util qw/weaken/; -my $U = "OpenILS::Application::AppUtils"; -use Data::Dumper; - -my $holdcode = "OpenILS::Application::Circ::Holds"; - -my $evt = "environment"; -my %GROUP_SET; -my $GROUP_TREE; -my $ORG_TREE; -my @ORG_LIST; -my @OU_TYPES; - - -# ----------------------------------------------------------------------- -# Possible Args: -# copy -# copy_id -# copy_barcode -# -# patron -# patron_id -# patron_barcode -# -# fetch_patron_circ_info - load info on items out, overdues, and fines. -# -# _direct - this is a hash of key/value pairs to shove directly into the -# script runner. Use this to cover data not covered by this module -# ----------------------------------------------------------------------- -sub build { - my( $class, $args ) = @_; - - my $evt; - my @evts; - - my $rollback; - my $editor = $$args{editor}; - - unless($editor) { - $editor = new_editor(xact => 1); - $rollback = 1; - } - - $args->{_direct} = {} unless $args->{_direct}; - #$args->{editor} = $editor; - - $evt = fetch_bib_data($editor, $args); - push(@evts, $evt) if $evt; - $evt = fetch_user_data($editor, $args); - push(@evts, $evt) if $evt; - - if(@evts) { - my @e; - push( @e, $_->{textcode} ) for @evts; - $logger->info("script_builder: some events occurred: @e"); - $logger->debug("script_builder: some events occurred: " . Dumper(\@evts)); - $args->{_events} = \@evts; - } - - my $r = build_runner($editor, $args); - $editor->rollback if $rollback; - return $r; -} - - -sub build_runner { - my $editor = shift; - my $ctx = shift; - - my $runner = OpenILS::Utils::ScriptRunner->new; - - my $gt = $GROUP_TREE; - $runner->insert( "$evt.groupTree", $gt, 1); - - - $runner->insert( "$evt.patron", $ctx->{patron}, 1); - $runner->insert( "$evt.copy", $ctx->{copy}, 1); - $runner->insert( "$evt.volume", $ctx->{volume}, 1); - $runner->insert( "$evt.title", $ctx->{title}, 1); - - if( ref $ctx->{requestor} ) { - $runner->insert( "$evt.requestor", $ctx->{requestor}, 1); - if($ctx->{requestor}->ws_ou) { - $runner->insert( "$evt.location", - $editor->retrieve_actor_org_unit($ctx->{requestor}->ws_ou), 1); - } - } - - $runner->insert( "$evt.patronItemsOut", $ctx->{patronItemsOut}, 1 ); - $runner->insert( "$evt.patronOverdueCount", $ctx->{patronOverdue}, 1 ); - $runner->insert( "$evt.patronFines", $ctx->{patronFines}, 1 ); - - $runner->insert("$evt.$_", $ctx->{_direct}->{$_}, 1) for keys %{$ctx->{_direct}}; - - insert_org_methods( $editor, $runner ); - insert_copy_methods( $editor, $ctx, $runner ); - insert_user_funcs( $editor, $ctx, $runner ); - - return $runner; -} - -sub fetch_bib_data { - my $e = shift; - my $ctx = shift; - - my $flesh = { - flesh => 2, - flesh_fields => { - acp => [ 'location', 'status', 'circ_lib', 'age_protect', 'call_number' ], - acn => [ 'record' ] - } - }; - - if( $ctx->{copy} ) { - $ctx->{copy_id} = $ctx->{copy}->id - unless $ctx->{copy_id} or $ctx->{copy_barcode}; - } - - my $copy; - - if($ctx->{copy_id}) { - $copy = $e->retrieve_asset_copy( - [$ctx->{copy_id}, $flesh ]) or return $e->event; - - } elsif( $ctx->{copy_barcode} ) { - - $copy = $e->search_asset_copy( - [{barcode => $ctx->{copy_barcode}, deleted => 'f'}, $flesh ])->[0] - or return $e->event; - } - - return undef unless $copy; - - my $vol = $copy->call_number; - my $rec = $vol->record; - $ctx->{copy} = $copy; - $ctx->{volume} = $vol; - $copy->call_number($vol->id); - $ctx->{title} = $rec; - $vol->record($rec->id); - - return undef; -} - - - -sub fetch_user_data { - my( $e, $ctx ) = @_; - - my $flesh = { - flesh => 2, - flesh_fields => { - au => [ qw/ profile home_ou card / ], - aou => [ 'ou_type' ], - } - }; - - if( $ctx->{patron} ) { - $ctx->{patron_id} = $ctx->{patron}->id unless $ctx->{patron_id}; - } - - my $patron; - - if( $ctx->{patron_id} ) { - $patron = $e->retrieve_actor_user([$ctx->{patron_id}, $flesh]); - - } elsif( $ctx->{patron_barcode} ) { - - my $card = $e->search_actor_card( - { barcode => $ctx->{patron_barcode} } )->[0] or return $e->event; - - $patron = $e->search_actor_user( - [{ card => $card->id }, $flesh ] - )->[0] or return $e->event; - - } elsif( $ctx->{fetch_patron_by_circ_copy} ) { - - if( my $copy = $ctx->{copy} ) { - my $circs = $e->search_action_circulation( - { target_copy => $copy->id, checkin_time => undef }); - - if( my $circ = $circs->[0] ) { - $patron = $e->retrieve_actor_user([$circ->usr, $flesh]) - or return $e->event; - } - } - } - - return undef unless $ctx->{patron} = $patron; - - flatten_groups($e); - - $ctx->{requestor} = $ctx->{requestor} || $e->requestor; - - if( $ctx->{fetch_patron_circ_info} ) { - my $circ_counts = $U->storagereq('open-ils.storage.actor.user.checked_out.count', $patron->id); - - $ctx->{patronOverdue} = $circ_counts->{overdue} + $circ_counts->{long_overdue}; - my $out = $ctx->{patronOverdue} + $circ_counts->{out}; - - $ctx->{patronItemsOut} = $out - unless( $ctx->{patronItemsOut} and $ctx->{patronItemsOut} > $out ); - - $logger->debug("script_builder: patron overdue count is " . $ctx->{patronOverdue}); - } - - if( $ctx->{fetch_patron_money_info} ) { - $ctx->{patronFines} = $U->patron_money_owed($patron->id); - $logger->debug("script_builder: patron fines determined to be ".$ctx->{patronFines}); - } - - unless( $ctx->{ignore_user_status} ) { - return OpenILS::Event->new('PATRON_INACTIVE') - unless $U->is_true($patron->active); - - return OpenILS::Event->new('PATRON_CARD_INACTIVE') - unless $U->is_true($patron->card->active); - - my $expire = DateTime::Format::ISO8601->new->parse_datetime( - cleanse_ISO8601($patron->expire_date)); - - return OpenILS::Event->new('PATRON_ACCOUNT_EXPIRED') - if( CORE::time > $expire->epoch ) ; - } - - return undef; -} - - -sub flatten_groups { - my $e = shift; - my $tree = shift; - - if(!%GROUP_SET) { - $GROUP_TREE = $e->search_permission_grp_tree( - [ - { parent => undef }, - { - flesh => 100, - flesh_fields => { pgt => ['children'] } - } - ] - )->[0]; - $tree = $GROUP_TREE; - } - - return undef unless $tree; - $GROUP_SET{$tree->id} = $tree; - if( $tree->children ) { - flatten_groups($e, $_) for @{$tree->children}; - } -} - -sub flatten_org_tree { - my $tree = shift; - return undef unless $tree; - push( @ORG_LIST, $tree ); - if( $tree->children ) { - flatten_org_tree($_) for @{$tree->children}; - } -} - - - -sub insert_org_methods { - my ( $editor, $runner ) = @_; - - if(!$ORG_TREE) { - $ORG_TREE = $editor->search_actor_org_unit( - [ - {"parent_ou" => undef }, - { - flesh => -1, - flesh_fields => { aou => ['children'] }, - order_by => { aou => 'name'} - } - ] - )->[0]; - flatten_org_tree($ORG_TREE); - } - - my $r = $runner; - weaken($r); - - $r->insert(__OILS_FUNC_isOrgDescendent => - sub { - my( $write_key, $sname, $id ) = @_; - my ($parent) = grep { $_->shortname eq $sname } @ORG_LIST; - my ($child) = grep { $_->id == $id } @ORG_LIST; - my $val = is_org_descendent( $parent, $child ); - $logger->debug("script_builder: is_org_desc $sname:$id returned val $val, writing to $write_key"); - $r->insert($write_key, $val, 1) if $val; - return $val; - } - ); - - $r->insert(__OILS_FUNC_hasCommonAncestor => - sub { - my( $write_key, $orgid1, $orgid2, $depth ) = @_; - my $val = has_common_ancestor( $orgid1, $orgid2, $depth ); - $logger->debug("script_builder: has_common_ancestor resturned $val"); - $r->insert($write_key, $val, 1) if $val; - return $val; - } - ); -} - - -sub is_org_descendent { - my( $parent, $child ) = @_; - return 0 unless $parent and $child; - $logger->debug("script_builder: is_org_desc checking parent=".$parent->id.", child=".$child->id); - do { - return 0 unless defined $child->parent_ou; - return 1 if $parent->id == $child->id; - } while( ($child) = grep { $_->id == $child->parent_ou } @ORG_LIST ); - return 0; -} - -sub has_common_ancestor { - my( $org1, $org2, $depth ) = @_; - return 0 unless $org1 and $org2; - $logger->debug("script_builder: has_common_ancestor checking orgs $org1 : $org2"); - - return 1 if $org1 == $org2; - ($org1) = grep { $_->id == $org1 } @ORG_LIST; - ($org2) = grep { $_->id == $org2 } @ORG_LIST; - - my $p1 = find_parent_at_depth($org1, $depth); - my $p2 = find_parent_at_depth($org2, $depth); - - return 1 if $p1->id == $p2->id; - return 0; -} - - -sub find_parent_at_depth { - my $org = shift; - my $depth = shift; - return undef unless $org and $depth; - fetch_ou_types(); - do { - my ($t) = grep { $_->id == $org->ou_type } @OU_TYPES; - return $org if $t->depth == $depth; - } while( ($org) = grep { $_->id == $org->parent_ou } @ORG_LIST ); - return undef; -} - - -sub fetch_ou_types { - return if @OU_TYPES; - @OU_TYPES = @{new_editor()->retrieve_all_actor_org_unit_type()}; -} - -sub insert_copy_methods { - my( $e, $ctx, $runner ) = @_; - my $reqr = $ctx->{requestor} || $e->requestor; - if( my $copy = $ctx->{copy} ) { - $runner->insert_method( 'environment.copy', '__OILS_FUNC_fetch_best_hold', sub { - my $key = shift; - $logger->debug("script_builder: searching for permitted hold for copy ".$copy->barcode); - my ($hold) = $holdcode->find_nearest_permitted_hold( $e, $copy, $reqr, 1 ); # do we need a new editor here since the xact may be dead?? - $runner->insert( $key, $hold, 1 ); - } - ); - } -} - -sub insert_user_funcs { - my( $e, $ctx, $runner ) = @_; - - # tells how many holds a user has - $runner->insert(__OILS_FUNC_userHoldCount => - sub { - my( $write_key, $userid ) = @_; - my $val = $holdcode->__user_hold_count(new_editor(), $userid); - $logger->info("script_runner: user hold count is $val"); - $runner->insert($write_key, $val, 1) if $val; - return $val; - } - ); - - $runner->insert(__OILS_FUNC_userCircsByCircmod => - sub { - my( $write_key, $userid ) = @_; - use OpenSRF::Utils::JSON; - - # this bug ugly thing generates a count of checkouts by circ_modifier - my $query = { - "select" => { - "acp" => ["circ_modifier"], - "circ"=>[{ - "aggregate"=> OpenSRF::Utils::JSON->true, - "transform"=>"count", - "alias"=>"count", - "column"=>"id" - }], - }, - "from"=>{"acp"=>{"circ"=>{"field"=>"target_copy","fkey"=>"id"}}}, - "where"=>{ - "+circ"=>{ - "checkin_time"=>undef, - "usr"=>$userid, - "-or"=>[ - {"stop_fines"=>["MAXFINES","LONGOVERDUE"]}, - {"stop_fines"=>undef} - ] - } - } - }; - - my $mods = $e->json_query($query); - my $breakdown = {}; - $breakdown->{$_->{circ_modifier}} = $_->{count} for @$mods; - $logger->info("script_runner: Loaded checkouts by circ_modifier breakdown:". - OpenSRF::Utils::JSON->perl2JSON($breakdown)); - $runner->insert($write_key, $breakdown, 1) if (keys %$breakdown); - } - ); - -} - - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ/StatCat.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ/StatCat.pm deleted file mode 100644 index 8ca8325755..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ/StatCat.pm +++ /dev/null @@ -1,634 +0,0 @@ -# --------------------------------------------------------------- -# Copyright (C) 2006 Georgia Public Library Service -# Bill Erickson - -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# --------------------------------------------------------------- - -package OpenILS::Application::Circ::StatCat; -use base qw/OpenILS::Application/; -use strict; use warnings; - -use OpenSRF::Utils::Logger qw($logger); -use OpenSRF::EX qw/:try/; -use OpenILS::Application::AppUtils; -my $apputils = "OpenILS::Application::AppUtils"; -my $U = $apputils; - - - -__PACKAGE__->register_method( - method => "retrieve_stat_cat_list", - argc => 1, - api_name => "open-ils.circ.stat_cat.actor.retrieve.batch"); - -__PACKAGE__->register_method( - method => "retrieve_stat_cat_list", - argc => 1, - api_name => "open-ils.circ.stat_cat.asset.retrieve.batch"); - -# retrieves all of the stat cats for a given org unit -# if no orgid, user_session->home_ou is used - -sub retrieve_stat_cat_list { - my( $self, $client, $user_session, @sc ) = @_; - - if (ref($sc[0])) { - @sc = @{$sc[0]}; - } - - my $method = "open-ils.storage.fleshed.actor.stat_cat.retrieve.batch.atomic"; - if( $self->api_name =~ /asset/ ) { - $method = "open-ils.storage.fleshed.asset.stat_cat.retrieve.batch.atomic"; - } - - my($user_obj, $evt) = $apputils->checkses($user_session); - return $evt if $evt; - - my $cats = $apputils->simple_scalar_request( - "open-ils.storage", $method, @sc); - - return [ sort { $a->name cmp $b->name } @$cats ]; -} - -__PACKAGE__->register_method( - method => "retrieve_stat_cats", - api_name => "open-ils.circ.stat_cat.actor.retrieve.all"); - -__PACKAGE__->register_method( - method => "retrieve_stat_cats", - api_name => "open-ils.circ.stat_cat.asset.retrieve.all"); - -# retrieves all of the stat cats for a given org unit -# if no orgid, user_session->home_ou is used - -sub retrieve_stat_cats { - my( $self, $client, $user_session, $orgid ) = @_; - - my $method = "open-ils.storage.ranged.fleshed.actor.stat_cat.all.atomic"; - if( $self->api_name =~ /asset/ ) { - $method = "open-ils.storage.ranged.fleshed.asset.stat_cat.all.atomic"; - } - - my($user_obj, $evt) = $apputils->checkses($user_session); - return $evt if $evt; - - if(!$orgid) { $orgid = $user_obj->home_ou; } - my $cats = $apputils->simple_scalar_request( - "open-ils.storage", $method, $orgid ); - - return [ sort { $a->name cmp $b->name } @$cats ]; -} - - -__PACKAGE__->register_method( - method => "retrieve_ranged_intersect_stat_cats", - api_name => "open-ils.circ.stat_cat.asset.multirange.intersect.retrieve"); - -sub retrieve_ranged_intersect_stat_cats { - my( $self, $client, $user_session, $orglist ) = @_; - - my($user_obj, $evt) = $apputils->checkses($user_session); - return $evt if $evt; - - if(!$orglist) { $orglist = [ $user_obj->home_ou ]; } - - # uniquify, yay! - my %hash = map { ($_ => 1) } @$orglist; - $orglist = [ keys %hash ]; - - warn "range: @$orglist\n"; - - my $method = "open-ils.storage.multiranged.intersect.fleshed.asset.stat_cat.all.atomic"; - return $apputils->simple_scalar_request( - "open-ils.storage", $method, $orglist ); -} - - -__PACKAGE__->register_method( - method => "retrieve_ranged_union_stat_cats", - api_name => "open-ils.circ.stat_cat.asset.multirange.union.retrieve"); - -sub retrieve_ranged_union_stat_cats { - my( $self, $client, $user_session, $orglist ) = @_; - - my $method = "open-ils.storage.multiranged.union.fleshed.asset.stat_cat.all.atomic"; - use Data::Dumper; - warn "Retrieving stat_cats with method $method and orgs " . Dumper($orglist) . "\n"; - - my($user_obj, $evt) = $apputils->checkses($user_session); - return $evt if $evt; - - if(!$orglist) { $orglist = [ $user_obj->home_ou ]; } - - # uniquify, yay! - my %hash = map { ($_ => 1) } @$orglist; - $orglist = [ keys %hash ]; - - warn "range: @$orglist\n"; - - return $apputils->simple_scalar_request( - "open-ils.storage", $method, $orglist ); -} - - - -__PACKAGE__->register_method( - method => "stat_cat_create", - api_name => "open-ils.circ.stat_cat.asset.create"); - -__PACKAGE__->register_method( - method => "stat_cat_create", - api_name => "open-ils.circ.stat_cat.actor.create"); - -sub stat_cat_create { - my( $self, $client, $user_session, $stat_cat ) = @_; - - my $method = "open-ils.storage.direct.actor.stat_cat.create"; - my $entry_create = "open-ils.storage.direct.actor.stat_cat_entry.create"; - my $perm = 'CREATE_PATRON_STAT_CAT'; - my $eperm = 'CREATE_PATRON_STAT_CAT_ENTRY'; - - if($self->api_name =~ /asset/) { - $method = "open-ils.storage.direct.asset.stat_cat.create"; - $entry_create = "open-ils.storage.direct.asset.stat_cat_entry.create"; - $perm = 'CREATE_COPY_STAT_CAT_ENTRY'; - } - - #my $user_obj = $apputils->check_user_session($user_session); - #my $orgid = $user_obj->home_ou(); - my( $user_obj, $evt ) = $apputils->checkses($user_session); - return $evt if $evt; - $evt = $apputils->check_perms($user_obj->id, $stat_cat->owner, $perm); - return $evt if $evt; - - if($stat_cat->entries) { - $evt = $apputils->check_perms($user_obj->id, $stat_cat->owner, $eperm); - return $evt if $evt; - } - - - my $session = $apputils->start_db_session(); - my $newid = _create_stat_cat($session, $stat_cat, $method); - - if( ref($stat_cat->entries) ) { - for my $entry (@{$stat_cat->entries}) { - $entry->stat_cat($newid); - _create_stat_entry($session, $entry, $entry_create); - } - } - - $apputils->commit_db_session($session); - - $logger->debug("Stat cat creation successful with id $newid"); - - my $orgid = $user_obj->home_ou; - if( $self->api_name =~ /asset/ ) { - return _flesh_asset_cat($newid, $orgid); - } else { - return _flesh_user_cat($newid, $orgid); - } -} - - -sub _flesh_user_cat { - my $id = shift; - my $orgid = shift; - - my $session = OpenSRF::AppSession->create("open-ils.storage"); - my $cat = $session->request( - "open-ils.storage.direct.actor.stat_cat.retrieve", - $id )->gather(1); - - $cat->entries( - $session->request( - "open-ils.storage.ranged.actor.stat_cat_entry.search.stat_cat.atomic", - $orgid, $id )->gather(1) ); - - return $cat; -} - - -sub _flesh_asset_cat { - my $id = shift; - my $orgid = shift; - - my $session = OpenSRF::AppSession->create("open-ils.storage"); - my $cat = $session->request( - "open-ils.storage.direct.asset.stat_cat.retrieve", - $id )->gather(1); - - $cat->entries( - $session->request( - "open-ils.storage.ranged.asset.stat_cat_entry.search.stat_cat.atomic", - $orgid, $id )->gather(1) ); - - return $cat; - -} - - -sub _create_stat_cat { - my( $session, $stat_cat, $method) = @_; - warn "Creating new stat cat with name " . $stat_cat->name . "\n"; - $stat_cat->clear_id(); - my $req = $session->request( $method, $stat_cat ); - my $id = $req->gather(1); - if(!$id) { - throw OpenSRF::EX::ERROR - ("Error creating new statistical category"); } - - warn "Stat cat create returned id $id\n"; - return $id; -} - - -sub _create_stat_entry { - my( $session, $stat_entry, $method) = @_; - - warn "Creating new stat entry with value " . $stat_entry->value . "\n"; - $stat_entry->clear_id(); - - my $req = $session->request($method, $stat_entry); - my $id = $req->gather(1); - - warn "Stat entry " . Dumper($stat_entry) . "\n"; - - if(!$id) { - throw OpenSRF::EX::ERROR - ("Error creating new stat cat entry"); } - - warn "Stat cat entry create returned id $id\n"; - return $id; -} - - -__PACKAGE__->register_method( - method => "update_stat_entry", - api_name => "open-ils.circ.stat_cat.actor.entry.update"); - -__PACKAGE__->register_method( - method => "update_stat_entry", - api_name => "open-ils.circ.stat_cat.asset.entry.update"); - -sub update_stat_entry { - my( $self, $client, $user_session, $entry ) = @_; - - - my $method = "open-ils.storage.direct.actor.stat_cat_entry.update"; - my $perm = 'UPDATE_PATRON_STAT_CAT_ENTRY'; - if($self->api_name =~ /asset/) { - $method = "open-ils.storage.direct.asset.stat_cat_entry.update"; - $perm = 'UPDATE_COPY_STAT_CAT_ENTRY'; - } - - my( $user_obj, $evt ) = $apputils->checkses($user_session); - return $evt if $evt; - $evt = $apputils->check_perms( $user_obj->id, $entry->owner, $perm ); - return $evt if $evt; - - my $session = $apputils->start_db_session(); - my $req = $session->request($method, $entry); - my $status = $req->gather(1); - $apputils->commit_db_session($session); - warn "stat cat entry with value " . $entry->value . " updated with status $status\n"; - return 1; -} - - -__PACKAGE__->register_method( - method => "update_stat", - api_name => "open-ils.circ.stat_cat.actor.update"); - -__PACKAGE__->register_method( - method => "update_stat", - api_name => "open-ils.circ.stat_cat.asset.update"); - -sub update_stat { - my( $self, $client, $user_session, $cat ) = @_; - - my $method = "open-ils.storage.direct.actor.stat_cat.update"; - my $perm = 'UPDATE_PATRON_STAT_CAT'; - if($self->api_name =~ /asset/) { - $method = "open-ils.storage.direct.asset.stat_cat.update"; - $perm = 'UPDATE_COPY_STAT_CAT'; - } - - my( $user_obj, $evt ) = $apputils->checkses($user_session); - return $evt if $evt; - $evt = $apputils->check_perms( $user_obj->id, $cat->owner, $perm ); - return $evt if $evt; - - my $session = $apputils->start_db_session(); - my $req = $session->request($method, $cat); - my $status = $req->gather(1); - $apputils->commit_db_session($session); - warn "stat cat with id " . $cat->id . " updated with status $status\n"; - return 1; -} - - -__PACKAGE__->register_method( - method => "create_stat_entry", - api_name => "open-ils.circ.stat_cat.actor.entry.create"); - -__PACKAGE__->register_method( - method => "create_stat_entry", - api_name => "open-ils.circ.stat_cat.asset.entry.create"); - -sub create_stat_entry { - my( $self, $client, $user_session, $entry ) = @_; - - my $method = "open-ils.storage.direct.actor.stat_cat_entry.create"; - my $perm = 'CREATE_PATRON_STAT_CAT_ENTRY'; - if($self->api_name =~ /asset/) { - $method = "open-ils.storage.direct.asset.stat_cat_entry.create"; - $perm = 'CREATE_COPY_STAT_CAT_ENTRY'; - } - - my( $user_obj, $evt ) = $apputils->checkses($user_session); - return $evt if $evt; - $evt = $apputils->check_perms( $user_obj->id, $entry->owner, $perm ); - return $evt if $evt; - - $entry->clear_id(); - my $session = $apputils->start_db_session(); - my $req = $session->request($method, $entry); - my $status = $req->gather(1); - $apputils->commit_db_session($session); - - $logger->info("created stat cat entry $status"); - return $status; -} - - - -__PACKAGE__->register_method( - method => "create_stat_map", - api_name => "open-ils.circ.stat_cat.actor.user_map.create"); - -__PACKAGE__->register_method( - method => "create_stat_map", - api_name => "open-ils.circ.stat_cat.asset.copy_map.create"); - -sub create_stat_map { - my( $self, $client, $user_session, $map ) = @_; - - - my ( $evt, $copy, $volume, $patron, $user_obj ); - - my $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.create"; - my $ret = "open-ils.storage.direct.actor.stat_cat_entry_user_map.retrieve"; - my $perm = 'CREATE_PATRON_STAT_CAT_ENTRY_MAP'; - my $perm_org; - - if($self->api_name =~ /asset/) { - $method = "open-ils.storage.direct.asset.stat_cat_entry_copy_map.create"; - $ret = "open-ils.storage.direct.asset.stat_cat_entry_copy_map.retrieve"; - $perm = 'CREATE_COPY_STAT_CAT_ENTRY_MAP'; - ( $copy, $evt ) = $apputils->fetch_copy($map->owning_copy); - return $evt if $evt; - ( $volume, $evt ) = $apputils->fetch_callnumber($copy->call_number); - return $evt if $evt; - $perm_org = $volume->owning_lib; - - } else { - ($patron, $evt) = $apputils->fetch_user($map->target_usr); - return $evt if $evt; - $perm_org = $patron->home_ou; - } - - ( $user_obj, $evt ) = $apputils->checkses($user_session); - return $evt if $evt; - $evt = $apputils->check_perms( $user_obj->id, $perm_org, $perm ); - return $evt if $evt; - - $logger->debug( $user_obj->id . " creating new stat cat map" ); - - $map->clear_id(); - - my $session = $apputils->start_db_session(); - my $req = $session->request($method, $map); - my $newid = $req->gather(1); - warn "Created new stat cat map with id $newid\n"; - $apputils->commit_db_session($session); - - return $apputils->simple_scalar_request( "open-ils.storage", $ret, $newid ); - -} - - -__PACKAGE__->register_method( - method => "update_stat_map", - api_name => "open-ils.circ.stat_cat.actor.user_map.update"); - -__PACKAGE__->register_method( - method => "update_stat_map", - api_name => "open-ils.circ.stat_cat.asset.copy_map.update"); - -sub update_stat_map { - my( $self, $client, $user_session, $map ) = @_; - - my ( $evt, $copy, $volume, $patron, $user_obj ); - - my $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.update"; - my $perm = 'UPDATE_PATRON_STAT_ENTRY_MAP'; - my $perm_org; - - if($self->api_name =~ /asset/) { - $method = "open-ils.storage.direct.asset.stat_cat_entry_copy_map.update"; - $perm = 'UPDATE_COPY_STAT_ENTRY_MAP'; - ( $copy, $evt ) = $apputils->fetch_copy($map->owning_copy); - return $evt if $evt; - ( $volume, $evt ) = $apputils->fetch_callnumber($copy->call_number); - return $evt if $evt; - $perm_org = $volume->owning_lib; - - } else { - ($patron, $evt) = $apputils->fetch_user($map->target_usr); - return $evt if $evt; - $perm_org = $patron->home_ou; - } - - - ( $user_obj, $evt ) = $apputils->checkses($user_session); - return $evt if $evt; - $evt = $apputils->check_perms( $user_obj->id, $perm_org, $perm ); - return $evt if $evt; - - - my $session = $apputils->start_db_session(); - my $req = $session->request($method, $map); - my $newid = $req->gather(1); - warn "Updated new stat cat map with id $newid\n"; - $apputils->commit_db_session($session); - - return $newid; -} - - - -__PACKAGE__->register_method( - method => "retrieve_maps", - api_name => "open-ils.circ.stat_cat.actor.user_map.retrieve"); - -__PACKAGE__->register_method( - method => "retrieve_maps", - api_name => "open-ils.circ.stat_cat.asset.copy_map.retrieve"); - -sub retrieve_maps { - my( $self, $client, $user_session, $target ) = @_; - - - my( $user_obj, $evt ) = $apputils->checkses($user_session); - return $evt if $evt; - - my $method = "open-ils.storage.direct.asset.stat_cat_entry_copy_map.search.owning_copy.atomic"; - if($self->api_name =~ /actor/ ) { - if(!$target) { $target = $user_obj->id; } - $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.search.target_usr.atomic"; - } - - return $apputils->simple_scalar_request("open-ils.storage", $method, $target); -} - - - - -__PACKAGE__->register_method( - method => "delete_stats", - api_name => "open-ils.circ.stat_cat.actor.delete"); - -__PACKAGE__->register_method( - method => "delete_stats", - api_name => "open-ils.circ.stat_cat.asset.delete"); - -sub delete_stats { - my( $self, $client, $user_session, $target ) = @_; - - my $cat; - - my $type = "actor"; - my $perm = 'DELETE_PATRON_STAT_CAT'; - if($self->api_name =~ /asset/) { - $type = "asset"; - $perm = 'DELETE_COPY_STAT_CAT'; - } - - my( $user_obj, $evt ) = $apputils->checkses($user_session); - return $evt if $evt; - - ( $cat, $evt ) = $apputils->fetch_stat_cat( $type, $target ); - return $evt if $evt; - - $evt = $apputils->check_perms( $user_obj->id, $cat->owner, $perm ); - return $evt if $evt; - - my $session = OpenSRF::AppSession->create("open-ils.storage"); - return _delete_stats($session, $target, $type); -} - -sub _delete_stats { - my( $session, $stat, $type) = @_; - - my $method = "open-ils.storage.direct.asset.stat_cat.delete"; - if($type =~ /actor/ ) { - $method = "open-ils.storage.direct.actor.stat_cat.delete"; - } - return $session->request($method, $stat)->gather(1); -} - - - -__PACKAGE__->register_method( - method => "delete_entry", - api_name => "open-ils.circ.stat_cat.actor.entry.delete"); - -__PACKAGE__->register_method( - method => "delete_entry", - api_name => "open-ils.circ.stat_cat.asset.entry.delete"); - -sub delete_entry { - my( $self, $client, $user_session, $target ) = @_; - - my $type = "actor"; - my $perm = 'DELETE_PATRON_STAT_CAT_ENTRY'; - if($self->api_name =~ /asset/) { - $type = "asset"; - $perm = 'DELETE_COPY_STAT_CAT_ENTRY'; - } - - my $entry; - my( $user_obj, $evt ) = $apputils->checkses($user_session); - return $evt if $evt; - - ( $entry, $evt ) = $apputils->fetch_stat_cat_entry( $type, $target ); - return $evt if $evt; - - $evt = $apputils->check_perms( $user_obj->id, $entry->owner, $perm ); - return $evt if $evt; - - my $session = OpenSRF::AppSession->create("open-ils.storage"); - return _delete_entry($session, $target, $type); -} - -sub _delete_entry { - my( $session, $stat_entry, $type) = @_; - - my $method = "open-ils.storage.direct.asset.stat_cat_entry.delete"; - if($type =~ /actor/ ) { - $method = "open-ils.storage.direct.actor.stat_cat_entry.delete"; - } - - return $session->request($method, $stat_entry)->gather(1); -} - - -__PACKAGE__->register_method( - method => 'fetch_stats_by_copy', - api_name => 'open-ils.circ.asset.stat_cat_entries.fleshed.retrieve_by_copy', -); - - -sub fetch_stats_by_copy { - my( $self, $conn, $args ) = @_; - - my @entries; - - if( $$args{public} ) { - my $maps = $U->cstorereq( - 'open-ils.cstore.direct.asset.stat_cat_entry_copy_map.search.atomic', { owning_copy => $$args{copyid} }); - - - warn "here\n"; - for my $map (@$maps) { - - warn "map ".$map->id."\n"; - warn "map ".$map->stat_cat_entry."\n"; - - my $entry = $U->cstorereq( - 'open-ils.cstore.direct.asset.stat_cat_entry.retrieve', $map->stat_cat_entry); - - warn "Found entry ".$entry->id."\n"; - - my $cat = $U->cstorereq( - 'open-ils.cstore.direct.asset.stat_cat.retrieve', $entry->stat_cat ); - $entry->stat_cat( $cat ); - push( @entries, $entry ); - } - } - - return \@entries; -} - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ/Survey.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ/Survey.pm deleted file mode 100644 index 9f75be3ddf..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ/Survey.pm +++ /dev/null @@ -1,424 +0,0 @@ -# --------------------------------------------------------------- -# Copyright (C) 2005 Georgia Public Library Service -# Bill Erickson - -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# --------------------------------------------------------------- - -package OpenILS::Application::Circ::Survey; -use base qw/OpenILS::Application/; -use strict; use warnings; -use OpenSRF::EX qw/:try/; -use OpenILS::Application::AppUtils; -use Data::Dumper; -use OpenILS::Event; -use Time::HiRes qw(time); -use OpenILS::Utils::CStoreEditor qw/:funcs/; - -my $apputils = "OpenILS::Application::AppUtils"; - -# - creates a new survey -# expects a survey complete with questions and answers -__PACKAGE__->register_method( - method => "add_survey", - api_name => "open-ils.circ.survey.create"); - -sub add_survey { - my( $self, $client, $user_session, $survey ) = @_; - - my($user_obj, $evt) = $apputils->checkses($user_session); - return $evt if $evt; - - my $session = $apputils->start_db_session(); - my $err = undef; my $id; - - - try { - - $survey = _add_survey($session, $survey); - _add_questions($session, $survey); - $apputils->commit_db_session($session); - - } catch Error with { - my $e = shift; - $err = "Error creating survey: $e\n"; - $apputils->rollback_db_session($session); - }; - - if($err) { throw OpenSRF::EX::ERROR ($err); } - - # re-retrieve the survey from the db and return it - return get_fleshed_survey($self, $client, $survey->id() ); -} - - -sub _add_survey { - my($session, $survey) = @_; - my $req = $session->request( - "open-ils.storage.direct.action.survey.create", - $survey ); - - my $id = $req->gather(1); - - if(!$id) { - throw OpenSRF::EX::ERROR - ("Unable to create new survey " . $survey->name()); - } - - $survey->id($id); - return $survey; -} - -sub _update_survey { - my($session, $survey) = @_; -} - -sub _add_questions { - my($session, $survey) = @_; - - # create new questions in the db - if( $survey->questions() ) { - for my $question (@{$survey->questions()}){ - - $question->survey($survey->id()); - my $virtual_id = $question->id(); - $question->clear_id(); - - - my $req = $session->request( - 'open-ils.storage.direct.action.survey_question.create', - $question ); - my $new_id = $req->gather(1); - - if(!$new_id) { - throw OpenSRF::EX::ERROR - ("Error creating new survey question " . $question->question() . "\n") - } - - # now update the responses to this question - if($question->answers()) { - for my $answer (@{$question->answers()}) { - $answer->question($new_id); - _add_answer($session,$answer); - } - } - } - } -} - - -sub _add_answer { - my($session, $answer) = @_; - $answer->clear_id(); - my $req = $session->request( - "open-ils.storage.direct.action.survey_answer.create", - $answer ); - my $id = $req->gather(1); - if(!$id) { - throw OpenSRF::EX::ERROR - ("Error creating survey answer " . $answer->answer() ); - } - -} - - - -# retrieve surveys for a specific org subtree. -__PACKAGE__->register_method( - method => "get_required_surveys", - api_name => "open-ils.circ.survey.retrieve.required"); - -sub get_required_surveys { - my( $self, $client, $user_session ) = @_; - - - my ($user_obj, $evt) = $apputils->checkses($user_session); - return $evt if $evt; - - my $orgid = $user_obj->ws_ou() ? $user_obj->ws_ou() : $user_obj->home_ou(); - my $surveys = $apputils->simple_scalar_request( - "open-ils.storage", - "open-ils.storage.action.survey.required.atomic", - $orgid ); - - my @fleshed; - for my $survey (@$surveys) { - push(@fleshed, get_fleshed_survey($self, $client, $survey)); - } - return \@fleshed; - -} - -__PACKAGE__->register_method( - method => "get_survey_responses", - api_name => "open-ils.circ.survey.response.retrieve"); - -sub get_survey_responses { - my( $self, $client, $user_session, $survey_id, $user_id ) = @_; - - if(!$user_id) { - my ($user_obj, $evt) = $apputils->checkses($user_session); - return $evt if $evt; - $user_id = $user_obj->id; - } - - my $res = $apputils->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.action.survey_response.search.atomic", - { usr => $user_id, survey => $survey_id } ); - - if( $res && ref($res) and $res->[0]) { - return [ sort { $a->id() <=> $b->id() } @$res ]; - } - - return []; -} - -__PACKAGE__->register_method( - method => "get_all_surveys", - api_name => "open-ils.circ.survey.retrieve.all"); - -sub get_all_surveys { - my( $self, $client, $user_session ) = @_; - - my ($user_obj, $evt) = $apputils->checkses($user_session); - return $evt if $evt; - - my $orgid = $user_obj->ws_ou() ? $user_obj->ws_ou() : $user_obj->home_ou(); - my $surveys = $apputils->simple_scalar_request( - "open-ils.storage", - "open-ils.storage.action.survey.all.atomic", - $orgid ); - - my @fleshed; - for my $survey (@$surveys) { - push(@fleshed, get_fleshed_survey($self, $client, $survey)); - } - return \@fleshed; -} - - - - -__PACKAGE__->register_method( - method => "get_fleshed_survey", - api_name => "open-ils.circ.survey.fleshed.retrieve"); - -sub get_fleshed_survey { - my( $self, $client, $survey_id ) = @_; - - my $session = OpenSRF::AppSession->create("open-ils.storage"); - - my $survey; - if( ref($survey_id) and - (ref($survey_id) =~ /^Fieldmapper/)) { - $survey = $survey_id; - - } else { - - my $sreq = $session->request( - "open-ils.storage.direct.action.survey.retrieve", - $survey_id ); - $survey = $sreq->gather(1); - if(! $survey) { return undef; } - } - - $survey->questions([]); - - - my $qreq = $session->request( - "open-ils.storage.direct.action.survey_question.search.survey.atomic", - $survey->id() ); - - my $questions = $qreq->gather(1); - - if($questions) { - - for my $question (@$questions) { - next unless defined $question; - - # add this question to the survey - push( @{$survey->questions()}, $question ); - - - my $ans_req = $session->request( - "open-ils.storage.direct.action.survey_answer.search.question.atomic", - $question->id() ); - - # add this array of answers to this question - $question->answers( $ans_req->gather(1) ); - - } - } - - $session->disconnect(); - return $survey; - -} - - - -__PACKAGE__->register_method( - method => "submit_survey", - api_name => "open-ils.circ.survey.submit.session"); - -__PACKAGE__->register_method( - method => "submit_survey", - api_name => "open-ils.circ.survey.submit.user_id"); - -__PACKAGE__->register_method( - method => "submit_survey", - api_name => "open-ils.circ.survey.submit.anon"); - - -sub submit_survey { - my( $self, $client, $responses ) = @_; - - if(!$responses) { - throw OpenSRF::EX::ERROR - ("No survey object sent in update"); - } - - - if(!ref($responses)) { $responses = [$responses]; } - - my $session = $apputils->start_db_session(); - - my $group_id = $session->request( - "open-ils.storage.action.survey_response.next_group_id")->gather(1); - - my %already_seen; - for my $res (@$responses) { - - my $id; - - if($self->api_name =~ /session/) { - if( ! ($id = $already_seen{$res->usr}) ) { - my ($user_obj, $evt) = $apputils->checkses($res->usr); - return $evt if $evt; - $id = $user_obj->id; - $already_seen{$res->usr} = $id; - } - $res->usr($id); - } elsif( $self->api_name =~ /anon/ ) { - $res->clear_usr(); - } - - $res->response_group_id($group_id); - my $req = $session->request( - "open-ils.storage.direct.action.survey_response.create", - $res ); - my $newid = $req->gather(1); - - if(!$newid) { - throw OpenSRF::EX::ERROR - ("Error creating new survey response"); - } - } - - $apputils->commit_db_session($session); - - return 1; -} - - -__PACKAGE__->register_method( - method => "get_random_survey", - api_name => "open-ils.circ.survey.retrieve.opac.random"); - -sub get_random_survey { - my( $self, $client, $user_session ) = @_; - - my ($user_obj, $evt) = $apputils->checkses($user_session); - return $evt if $evt; - - my $surveys = $apputils->simple_scalar_request( - "open-ils.storage", - "open-ils.storage.action.survey.opac.atomic", - $user_obj->home_ou() ); - - my $random = int(rand(scalar(@$surveys))); - my $surv = $surveys->[$random]; - - return get_fleshed_survey($self, $client, $surv); - -} - -__PACKAGE__->register_method( - method => "get_random_survey_global", - api_name => "open-ils.circ.survey.retrieve.opac.random.global"); - -sub get_random_survey_global { - my( $self, $client ) = @_; - - my $surveys = $apputils->simple_scalar_request( - "open-ils.storage", - "open-ils.storage.direct.action.survey.search.atomic", - # XXX grab the org tree to get the root id... - { owner => 1, opac => 't' } ); - - my $random = int(rand(scalar(@$surveys))); - my $surv = $surveys->[$random]; - - return get_fleshed_survey($self, $client, $surv); - -} - - -__PACKAGE__->register_method ( - method => 'delete_survey', - api_name => 'open-ils.circ.survey.delete.cascade' -); -__PACKAGE__->register_method ( - method => 'delete_survey', - api_name => 'open-ils.circ.survey.delete.cascade.override' -); - -sub delete_survey { - my($self, $conn, $auth, $survey_id) = @_; - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - - my $survey = $e->retrieve_action_survey($survey_id) - or return $e->die_event; - return $e->die_event unless $e->allowed('ADMIN_SURVEY', $survey->owner); - - my $questions = $e->search_action_survey_question({survey => $survey_id}); - my @answers; - push(@answers, @{$e->search_action_survey_answer({question => $_->id})}) for @$questions; - my $responses = $e->search_action_survey_response({survey => $survey_id}); - - return OpenILS::Event->new('SURVEY_RESPONSES_EXIST') - if @$responses and $self->api_name =! /override/; - - for my $resp (@$responses) { - $e->delete_action_survey_response($resp) or return $e->die_event; - } - - for my $ans (@answers) { - $e->delete_action_survey_answer($ans) or return $e->die_event; - } - - for my $quest (@$questions) { - $e->delete_action_survey_question($quest) or return $e->die_event; - } - - $e->delete_action_survey($survey) or return $e->die_event; - - $e->commit; - return 1; -} - - - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Circ/Transit.pm b/Open-ILS/src/perlmods/OpenILS/Application/Circ/Transit.pm deleted file mode 100644 index aa3d0448ca..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Circ/Transit.pm +++ /dev/null @@ -1,377 +0,0 @@ -package OpenILS::Application::Circ::Transit; -use base 'OpenILS::Application'; -use strict; use warnings; -use OpenSRF::EX qw(:try); -use Data::Dumper; -use OpenSRF::Utils; -use OpenSRF::Utils::Cache; -use Digest::MD5 qw(md5_hex); -use OpenILS::Utils::CStoreEditor qw/:funcs/; -use OpenILS::Application::AppUtils; -use OpenILS::Application::Circ::Holds; -use OpenSRF::Utils::Logger qw(:logger); -use OpenSRF::AppSession; -use OpenILS::Const qw/:const/; - -my $U = "OpenILS::Application::AppUtils"; -my $holdcode = "OpenILS::Application::Circ::Holds"; -$Data::Dumper::Indent = 0; - - - -__PACKAGE__->register_method( - method => "copy_transit_receive", - api_name => "open-ils.circ.copy_transit.receive", - notes => q/ - Closes out a copy transit - Requestor needs the COPY_TRANSIT_RECEIVE permission - @param authtoken The login session key - @param params An object of named params including - copyid - the id of the copy in quest - barcode - the barcode of the copy in question - If copyid is not sent, this is used. - @return A ROUTE_ITEM if the copy is destined for a different location. - A SUCCESS event on success. Other events on error. - /); - -sub copy_transit_receive { - my( $self, $client, $authtoken, $params ) = @_; - my %params = %$params; - my( $evt, $copy, $requestor ); - ($requestor, $evt) = $U->checksesperm($authtoken, 'COPY_TRANSIT_RECEIVE'); - return $evt if $evt; - ($copy, $evt) = $U->fetch_copy($params{copyid}); - ($copy, $evt) = $U->fetch_copy_by_barcode($params{barcode}) unless $copy; - return $evt if $evt; - my $session = $U->start_db_session(); - $evt = transit_receive( $self, $copy, $requestor, $session ); - $U->commit_db_session($session) if $U->event_equals($evt,'SUCCESS'); - return $evt; -} - -# ------------------------------------------------------------------------------ -# If the transit destination is different than the requestor's lib, -# a ROUTE_TO event is returned with the org set. -# If -# ------------------------------------------------------------------------------ -sub transit_receive { - my ( $class, $copy, $requestor, $session ) = @_; - $U->logmark; - - my( $transit, $evt ); - my $copyid = $copy->id; - - my $status_name = $U->copy_status_to_name($copy->status); - $logger->debug("Attempting transit receive on copy $copyid. Copy status is $status_name"); - - # fetch the transit - ($transit, $evt) = $U->fetch_open_transit_by_copy($copyid); - return $evt if $evt; - - if( $transit->dest != $requestor->home_ou ) { - $logger->activity("Fowarding transit on copy which is destined ". - "for a different location. copy=$copyid,current ". - "location=".$requestor->home_ou.",destination location=".$transit->dest); - - return OpenILS::Event->new('ROUTE_ITEM', org => $transit->dest ); - } - - # The transit is received, set the receive time - $transit->dest_recv_time('now'); - my $r = $session->request( - 'open-ils.storage.direct.action.transit_copy.update', $transit )->gather(1); - return $U->DB_UPDATE_FAILED($transit) unless $r; - - my $ishold = 0; - my ($ht) = $U->fetch_hold_transit( $transit->id ); - if($ht) { - $logger->info("Hold transit found in transit receive..."); - $ishold = 1; - } - - $logger->info("Recovering original copy status in transit: ".$transit->copy_status); - $copy->status( $transit->copy_status ); - return $evt if ( $evt = - $U->update_copy( copy => $copy, editor => $requestor->id, session => $session )); - - return OpenILS::Event->new('SUCCESS', ishold => $ishold, - payload => { transit => $transit, holdtransit => $ht } ); -} - - - - - -__PACKAGE__->register_method( - method => "copy_transit_create", - api_name => "open-ils.circ.copy_transit.create", - notes => q/ - Creates a new copy transit. Requestor must have the - CREATE_COPY_TRANSIT permission. - @param authtoken The login session key - @param params A param object containing the following keys: - copyid - the copy id - destination - the id of the org destination. If not defined, - defaults to the copy's circ_lib - @return SUCCESS event on success, other event on error - /); - -sub copy_transit_create { - - my( $self, $client, $authtoken, $params ) = @_; - my %params = %$params; - - my( $requestor, $evt ) = - $U->checksesperm( $authtoken, 'CREATE_COPY_TRANSIT' ); - return $evt if $evt; - - my $copy; - ($copy,$evt) = $U->fetch_copy($params{copyid}); - return $evt if $evt; - - my $session = $params{session} || $U->start_db_session(); - my $source = $requestor->home_ou; - my $dest = $params{destination} || $copy->circ_lib; - my $transit = Fieldmapper::action::transit_copy->new; - - $logger->activity("User ". $requestor->id ." creating a ". - " new copy transit for copy ".$copy->id." to org $dest"); - - $transit->source($source); - $transit->dest($dest); - $transit->target_copy($copy->id); - $transit->source_send_time("now"); - $transit->copy_status($copy->status); - - $logger->debug("Creating new copy_transit in DB"); - - my $s = $session->request( - "open-ils.storage.direct.action.transit_copy.create", $transit )->gather(1); - return $U->DB_UPDATE_FAILED($transit) unless $s; - - my $stat = $U->copy_status_from_name('in transit'); - - $copy->status($stat->id); - return $evt if ($evt = $U->update_copy( - copy => $copy, editor => $requestor->id, session => $session )); - - $U->commit_db_session($session) unless $params{session}; - - return OpenILS::Event->new('SUCCESS', - payload => { copy => $copy, transit => $transit } ); -} - - -__PACKAGE__->register_method( - method => 'abort_transit', - api_name => 'open-ils.circ.transit.abort', - signature => q/ - Deletes a cleans up a transit - / -); - -sub abort_transit { - my( $self, $conn, $authtoken, $params ) = @_; - - my $copyid = $$params{copyid}; - my $barcode = $$params{barcode}; - my $transitid = $$params{transitid}; - - my $copy; - my $transit; - my $evt; - - my $e = new_editor(xact => 1, authtoken => $authtoken); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('ABORT_TRANSIT'); - - # --------------------------------------------------------------------- - # Find the related copy and/or transit based on whatever data we have - if( $barcode ) { - $copy = $e->search_asset_copy({barcode=>$barcode, deleted => 'f'})->[0]; - return $e->event unless $copy; - - } elsif( $copyid ) { - $copy = $e->retrieve_asset_copy($copyid) or return $e->event; - } - - if( $transitid ) { - $transit = $e->retrieve_action_transit_copy($transitid) - or return $e->event; - - } elsif( $copy ) { - - $transit = $e->search_action_transit_copy( - { target_copy => $copy->id, dest_recv_time => undef })->[0]; - return $e->event unless $transit; - } - - if($transit and !$copy) { - $copy = $e->retrieve_asset_copy($transit->target_copy) - or return $e->event; - } - # --------------------------------------------------------------------- - - return __abort_transit( $e, $transit, $copy ); -} - - - -sub __abort_transit { - - my( $e, $transit, $copy, $no_reset_hold ) = @_; - - my $evt; - my $hold; - - if( $transit->copy_status == OILS_COPY_STATUS_LOST or - $transit->copy_status == OILS_COPY_STATUS_MISSING ) { - $e->rollback; - return OpenILS::Event->new('TRANSIT_ABORT_NOT_ALLOWED'); - } - - - if( $transit->dest != $e->requestor->ws_ou - and $transit->source != $e->requestor->ws_ou ) { - return $e->event unless $e->allowed('ABORT_REMOTE_TRANSIT', $e->requestor->ws_ou); - } - - # recover the copy status - $copy->status( $transit->copy_status ); - $copy->editor( $e->requestor->id ); - $copy->edit_date('now'); - - my $holdtransit = $e->retrieve_action_hold_transit_copy($transit->id); - - if( $holdtransit ) { - $logger->info("setting copy to reshelving on hold transit abort"); - $copy->status( OILS_COPY_STATUS_RESHELVING ); - } - - return $e->event unless $e->delete_action_transit_copy($transit); - return $e->event unless $e->update_asset_copy($copy); - - $e->commit; - - # if this is a hold transit, un-capture/un-target the hold - if($holdtransit and !$no_reset_hold) { - $hold = $e->retrieve_action_hold_request($holdtransit->hold) - or return $e->event; - $evt = $holdcode->_reset_hold( $e->requestor, $hold ); - return $evt if $evt; - } - - return 1; -} - - -__PACKAGE__->register_method( - method => 'get_open_copy_transit', - api_name => 'open-ils.circ.open_copy_transit.retrieve', - signature => q/ - Retrieves the open transit object for a given copy - @param auth The login session key - @param copyid The id of the copy - @return Transit object - / -); - -sub get_open_copy_transit { - my( $self, $conn, $auth, $copyid ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_USER'); # XXX rely on editor perms - my $t = $e->search_action_transit_copy( - { target_copy => $copyid, dest_recv_time => undef }); - return $e->event unless @$t; - return $$t[0]; -} - - - -__PACKAGE__->register_method( - method => 'fetch_transit_by_copy', - api_name => 'open-ils.circ.fetch_transit_by_copy', -); - -sub fetch_transit_by_copy { - my( $self, $conn, $auth, $copyid ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - my $t = $e->search_action_transit_copy( - { - target_copy => $copyid, - dest_recv_time => undef - } - )->[0]; - return $e->event unless $t; - my $ht = $e->retrieve_action_hold_transit_copy($t->id); - return { atc => $t, ahtc => $ht }; -} - - - -__PACKAGE__->register_method( - method => 'transits_by_lib', - api_name => 'open-ils.circ.transit.retrieve_by_lib', -); - - -# start_date and end_date are optional endpoints for the transit creation date -sub transits_by_lib { - my( $self, $conn, $auth, $orgid, $start_date, $end_date ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_CIRCULATIONS'); # eh.. basically the same permission - - my $order_by = {order_by => { atc => 'source_send_time' }}; - my $search = { dest_recv_time => undef }; - - if($end_date) { - if($start_date) { - $search->{source_send_time} = {between => [$start_date, $end_date]}; - } else { - $search->{source_send_time} = {'<=' => $end_date}; - } - } elsif($start_date) { - $search->{source_send_time} = {'>=' => $start_date}; - } - - $search->{dest} = $orgid; - - my $tos = $e->search_action_transit_copy([ $search, $order_by ], {idlist=>1}); - - delete $$search{dest}; - $search->{source} = $orgid; - - my $froms = $e->search_action_transit_copy([ $search, $order_by ], {idlist=>1}); - - return { from => $froms, to => $tos }; -} - - - -__PACKAGE__->register_method( - method => 'fetch_transit', - api_name => 'open-ils.circ.transit.retrieve', -); -sub fetch_transit { - my( $self, $conn, $auth, $transid ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_CIRCULATIONS'); # eh.. basically the same permission - - my $ht = $e->retrieve_action_hold_transit_copy($transid); - return $ht if $ht; - - my $t = $e->retrieve_action_transit_copy($transid) - or return $e->event; - return $t; -} - - - - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Collections.pm b/Open-ILS/src/perlmods/OpenILS/Application/Collections.pm deleted file mode 100644 index 03b6b681fc..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Collections.pm +++ /dev/null @@ -1,1059 +0,0 @@ -package OpenILS::Application::Collections; -use strict; use warnings; -use OpenSRF::EX qw(:try); -use OpenILS::Application::AppUtils; -use OpenSRF::Utils::Logger qw(:logger); -use OpenSRF::Utils qw/:datetime/; -use OpenILS::Application; -use OpenILS::Utils::Fieldmapper; -use base 'OpenILS::Application'; -use OpenILS::Utils::CStoreEditor qw/:funcs/; -use OpenILS::Event; -use OpenILS::Const qw/:const/; -my $U = "OpenILS::Application::AppUtils"; - - -# -------------------------------------------------------------- -# Loads the config info -# -------------------------------------------------------------- -sub initialize { return 1; } - -__PACKAGE__->register_method( - method => 'user_from_bc', - api_name => 'open-ils.collections.user_id_from_barcode', -); - -sub user_from_bc { - my( $self, $conn, $auth, $bc ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('VIEW_USER'); - my $card = $e->search_actor_card({barcode=>$bc})->[0] - or return $e->event; - my $user = $e->retrieve_actor_user($card->usr) - or return $e->event; - return $user->id; -} - - -__PACKAGE__->register_method( - method => 'users_of_interest', - api_name => 'open-ils.collections.users_of_interest.retrieve', - api_level => 1, - argc => 4, - stream => 1, - signature => { - desc => q/ - Returns an array of user information objects that the system - based on the search criteria provided. If the total fines - a user owes reaches or exceeds "fine_level" on or befre "age" - and the fines were created at "location", the user will be - included in the return set/, - - params => [ - { name => 'auth', - desc => 'The authentication token', - type => 'string' }, - - { name => 'age', - desc => q/Number of days back to check/, - type => q/number/, - }, - - { name => 'fine_level', - desc => q/The fine threshold at which users will be included in the search results /, - type => q/number/, - }, - { name => 'location', - desc => q/The short-name of the orginization unit (library) at which the fines were created. - If a selected location has 'child' locations (e.g. a library region), the - child locations will be included in the search/, - type => q/string/, - }, - ], - - 'return' => { - desc => q/An array of user information objects. - usr : Array of user information objects containing id, dob, profile, and groups - threshold_amount : The total amount the patron owes that is at least as old - as the fine "age" and whose transaction was created at the searched location - last_pertinent_billing : The time of the last billing that relates to this query - /, - type => 'array', - example => { - usr => { - id => 'id', - dob => '1970-01-01', - profile => 'Patron', - groups => [ 'Patron', 'Staff' ], - }, - threshold_amount => 99, - } - } - } -); - - -sub users_of_interest { - my( $self, $conn, $auth, $age, $fine_level, $location ) = @_; - - return OpenILS::Event->new('BAD_PARAMS') - unless ($auth and $age and $location); - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - my $org = $e->search_actor_org_unit({shortname => $location}) - or return $e->event; $org = $org->[0]; - - # they need global perms to view users so no org is provided - return $e->event unless $e->allowed('VIEW_USER'); - - my $data = []; - - my $ses = OpenSRF::AppSession->create('open-ils.storage'); - - my $start = time; - my $req = $ses->request( - 'open-ils.storage.money.collections.users_of_interest', - $age, $fine_level, $location); - - # let the client know we're still here - $conn->status( new OpenSRF::DomainObject::oilsContinueStatus ); - - return process_users_of_interest_results( - $self, $conn, $e, $req, $start, $age, $fine_level, $location); -} - - -__PACKAGE__->register_method( - method => 'users_of_interest_warning_penalty', - api_name => 'open-ils.collections.users_of_interest.warning_penalty.retrieve', - api_level => 1, - argc => 4, - stream => 1, - signature => { - desc => q/ - Returns an array of user information objects for users that have the - PATRON_EXCEEDS_COLLECTIONS_WARNING penalty applied, - based on the search criteria provided./, - - params => [ - { name => 'auth', - desc => 'The authentication token', - type => 'string' - }, { - name => 'location', - desc => q/The short-name of the orginization unit (library) at which the penalty is applied. - If a selected location has 'child' locations (e.g. a library region), the - child locations will be included in the search/, - type => q/string/, - }, { - name => 'min_age', - desc => q/Optional. Minimum age of the penalty application/, - type => q/interval, e.g "30 days"/, - }, { - name => 'max_age', - desc => q/Optional. Maximum age of the penalty application/, - type => q/interval, e.g "90 days"/, - } - ], - - 'return' => { - desc => q/An array of user information objects. - usr : Array of user information objects containing id, dob, profile, and groups - threshold_amount : The total amount the patron owes that is at least as old - as the fine "age" and whose transaction was created at the searched location - last_pertinent_billing : The time of the last billing that relates to this query - /, - type => 'array', - example => { - usr => { - id => 'id', - dob => '1970-01-01', - profile => 'Patron', - groups => [ 'Patron', 'Staff' ], - }, - threshold_amount => 99, # TODO: still needed? - } - } - } -); - - - -sub users_of_interest_warning_penalty { - my( $self, $conn, $auth, $location, $min_age, $max_age ) = @_; - - return OpenILS::Event->new('BAD_PARAMS') unless ($auth and $location); - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - my $org = $e->search_actor_org_unit({shortname => $location}) - or return $e->event; $org = $org->[0]; - - # they need global perms to view users so no org is provided - return $e->event unless $e->allowed('VIEW_USER'); - - my $org_ids = $e->json_query({from => ['actor.org_unit_full_path', $org->id]}); - - my $ses = OpenSRF::AppSession->create('open-ils.cstore'); - - # max age == oldest - my $max_set_date = DateTime->now->subtract(seconds => - interval_to_seconds($max_age))->strftime( '%F %T%z' ) if $max_age; - my $min_set_date = DateTime->now->subtract(seconds => - interval_to_seconds($min_age))->strftime( '%F %T%z' ) if $min_age; - - my $start = time; - my $query = { - select => {ausp => ['usr']}, - from => 'ausp', - where => { - standing_penalty => 4, # PATRON_EXCEEDS_COLLECTIONS_WARNING - org_unit => [ map {$_->{id}} @$org_ids ], - '-or' => [ - {stop_date => undef}, - {stop_date => {'>' => 'now'}} - ] - } - }; - - $query->{where}->{'-and'} = [] if $max_set_date or $min_set_date; - push(@{$query->{where}->{'-and'}}, {set_date => {'>' => $max_set_date}}) if $max_set_date; - push(@{$query->{where}->{'-and'}}, {set_date => {'<' => $min_set_date}}) if $min_set_date; - - my $req = $ses->request('open-ils.cstore.json_query', $query); - - # let the client know we're still here - $conn->status( new OpenSRF::DomainObject::oilsContinueStatus ); - - return process_users_of_interest_results( - $self, $conn, $e, $req, $start, $min_age, '', $location, $max_age); -} - - - - -sub process_users_of_interest_results { - my($self, $conn, $e, $req, $starttime, @params) = @_; - - my $total; - while( my $resp = $req->recv(timeout => 7200) ) { - - return $req->failed if $req->failed; - my $hash = $resp->content; - next unless $hash; - - unless($total) { - $total = time - $starttime; - $logger->info("collections: request (@params) took $total seconds"); - } - - my $u = $e->retrieve_actor_user( - [ - $hash->{usr}, - { - flesh => 1, - flesh_fields => {au => ["groups","profile", "card"]}, - } - ] - ) or return $e->event; - - $hash->{usr} = { - id => $u->id, - dob => $u->dob, - profile => $u->profile->name, - barcode => $u->card->barcode, - groups => [ map { $_->name } @{$u->groups} ], - }; - - $conn->respond($hash); - } - - return undef; -} - - -__PACKAGE__->register_method( - method => 'users_owing_money', - api_name => 'open-ils.collections.users_owing_money.retrieve', - api_level => 1, - argc => 5, - stream => 1, - signature => { - desc => q/ - Returns an array of users that owe money during - the given time frame at the location (or child locations) - provided/, - - params => [ - { name => 'auth', - desc => 'The authentication token', - type => 'string' }, - - { name => 'start_date', - desc => 'The start of the time interval to check', - type => q/string (ISO 8601 timestamp. E.g. 2006-06-24, 1994-11-05T08:15:30-05:00 /, - }, - - { name => 'end_date', - desc => q/Then end date of the time interval to check/, - type => q/string (ISO 8601 timestamp. E.g. 2006-06-24, 1994-11-05T08:15:30-05:00 /, - }, - { name => 'fine_level', - desc => q/The fine threshold at which users will be included in the search results /, - type => q/number/, - }, - { name => 'locations', - desc => q/ A list of one or more org-unit short names. - If a selected location has 'child' locations (e.g. a library region), the - child locations will be included in the search/, - type => q'string', - }, - ], - 'return' => { - desc => q/An array of user information objects/, - type => 'array', - } - } -); - - -sub users_owing_money { - my( $self, $conn, $auth, $start_date, $end_date, $fine_level, @locations ) = @_; - - return OpenILS::Event->new('BAD_PARAMS') - unless ($auth and $start_date and $end_date and @locations); - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - # they need global perms to view users so no org is provided - return $e->event unless $e->allowed('VIEW_USER'); - - my $data = []; - - my $ses = OpenSRF::AppSession->create('open-ils.storage'); - - my $start = time; - my $req = $ses->request( - 'open-ils.storage.money.collections.users_owing_money', - $start_date, $end_date, $fine_level, @locations); - - # let the client know we're still here - $conn->status( new OpenSRF::DomainObject::oilsContinueStatus ); - - return process_users_of_interest_results( - $self, $conn, $e, $req, $start, $start_date, $end_date, $fine_level, @locations); -} - - - -__PACKAGE__->register_method( - method => 'users_with_activity', - api_name => 'open-ils.collections.users_with_activity.retrieve', - api_level => 1, - argc => 4, - stream => 1, - signature => { - desc => q/ - Returns an array of users that are already in collections - and had any type of billing or payment activity within - the given time frame at the location (or child locations) - provided/, - - params => [ - { name => 'auth', - desc => 'The authentication token', - type => 'string' }, - - { name => 'start_date', - desc => 'The start of the time interval to check', - type => q/string (ISO 8601 timestamp. E.g. 2006-06-24, 1994-11-05T08:15:30-05:00 /, - }, - - { name => 'end_date', - desc => q/Then end date of the time interval to check/, - type => q/string (ISO 8601 timestamp. E.g. 2006-06-24, 1994-11-05T08:15:30-05:00 /, - }, - { name => 'location', - desc => q/The short-name of the orginization unit (library) at which the activity occurred. - If a selected location has 'child' locations (e.g. a library region), the - child locations will be included in the search/, - type => q'string', - }, - ], - - 'return' => { - desc => q/An array of user information objects/, - type => 'array', - } - } -); - -sub users_with_activity { - my( $self, $conn, $auth, $start_date, $end_date, $location ) = @_; - return OpenILS::Event->new('BAD_PARAMS') - unless ($auth and $start_date and $end_date and $location); - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - my $org = $e->search_actor_org_unit({shortname => $location}) - or return $e->event; $org = $org->[0]; - return $e->event unless $e->allowed('VIEW_USER', $org->id); - - my $ses = OpenSRF::AppSession->create('open-ils.storage'); - - my $start = time; - my $req = $ses->request( - 'open-ils.storage.money.collections.users_with_activity.atomic', - $start_date, $end_date, $location); - - $conn->status( new OpenSRF::DomainObject::oilsContinueStatus ); - - my $total; - while( my $resp = $req->recv(timeout => 7200) ) { - - unless($total) { - $total = time - $start; - $logger->info("collections: users_with_activity search ". - "($start_date, $end_date, $location) took $total seconds"); - } - - return $req->failed if $req->failed; - $conn->respond($resp->content); - } - - return undef; -} - - - -__PACKAGE__->register_method( - method => 'put_into_collections', - api_name => 'open-ils.collections.put_into_collections', - api_level => 1, - argc => 3, - signature => { - desc => q/ - Marks a user as being "in collections" at a given location - /, - - params => [ - { name => 'auth', - desc => 'The authentication token', - type => 'string' }, - - { name => 'user_id', - desc => 'The id of the user to plact into collections', - type => 'number', - }, - - { name => 'location', - desc => q/The short-name of the orginization unit (library) - for which the user is being placed in collections/, - type => q'string', - }, - { name => 'fee_amount', - desc => q/ - The amount of money that a patron should be fined. - If this field is empty, no fine is created. - /, - type => 'string', - }, - { name => 'fee_note', - desc => q/ - Custom note that is added to the the billing. - This field is not required. - Note: fee_note is not the billing_type. Billing_type type is - decided by the system. (e.g. "fee for collections"). - fee_note is purely used for any additional needed information - and is only visible to staff. - /, - type => 'string', - }, - ], - - 'return' => { - desc => q/A SUCCESS event on success, error event on failure/, - type => 'object', - } - } -); -sub put_into_collections { - my( $self, $conn, $auth, $user_id, $location, $fee_amount, $fee_note ) = @_; - - return OpenILS::Event->new('BAD_PARAMS') - unless ($auth and $user_id and $location); - - my $e = new_editor(authtoken => $auth, xact =>1); - return $e->event unless $e->checkauth; - - my $org = $e->search_actor_org_unit({shortname => $location}); - return $e->event unless $org = $org->[0]; - return $e->event unless $e->allowed('money.collections_tracker.create', $org->id); - - my $existing = $e->search_money_collections_tracker( - { - location => $org->id, - usr => $user_id, - collector => $e->requestor->id - }, - {idlist => 1} - ); - - return OpenILS::Event->new('MONEY_COLLECTIONS_TRACKER_EXISTS') if @$existing; - - $logger->info("collect: user ".$e->requestor->id. - " putting user $user_id into collections for $location"); - - my $tracker = Fieldmapper::money::collections_tracker->new; - - $tracker->usr($user_id); - $tracker->collector($e->requestor->id); - $tracker->location($org->id); - $tracker->enter_time('now'); - - $e->create_money_collections_tracker($tracker) - or return $e->event; - - if( $fee_amount ) { - my $evt = add_collections_fee($e, $user_id, $org, $fee_amount, $fee_note ); - return $evt if $evt; - } - - $e->commit; - - my $pen = Fieldmapper::actor::user_standing_penalty->new; - $pen->org_unit($org->id); - $pen->usr($user_id); - $pen->standing_penalty(30); # PATRON_IN_COLLECTIONS - $pen->staff($e->requestor->id); - $pen->note($fee_note) if $fee_note; - $U->simplereq('open-ils.actor', 'open-ils.actor.user.penalty.apply', $auth, $pen); - - return OpenILS::Event->new('SUCCESS'); -} - -sub add_collections_fee { - my( $e, $patron_id, $org, $fee_amount, $fee_note ) = @_; - - $fee_note ||= ""; - - $logger->info("collect: adding fee to user $patron_id : $fee_amount : $fee_note"); - - my $xact = Fieldmapper::money::grocery->new; - $xact->usr($patron_id); - $xact->xact_start('now'); - $xact->billing_location($org->id); - - $xact = $e->create_money_grocery($xact) or return $e->event; - - my $bill = Fieldmapper::money::billing->new; - $bill->note($fee_note); - $bill->xact($xact->id); - $bill->btype(2); - $bill->billing_type(OILS_BILLING_TYPE_COLLECTION_FEE); - $bill->amount($fee_amount); - - $e->create_money_billing($bill) or return $e->event; - return undef; -} - - - - -__PACKAGE__->register_method( - method => 'remove_from_collections', - api_name => 'open-ils.collections.remove_from_collections', - signature => q/ - Returns the users that are currently in collections and - had activity during the provided interval. Dates are inclusive. - @param start_date The beginning of the activity interval - @param end_date The end of the activity interval - @param location The location at which the fines were created - / -); - - -__PACKAGE__->register_method( - method => 'remove_from_collections', - api_name => 'open-ils.collections.remove_from_collections', - api_level => 1, - argc => 3, - signature => { - desc => q/ - Removes a user from the collections table for the given location - /, - - params => [ - { name => 'auth', - desc => 'The authentication token', - type => 'string' }, - - { name => 'user_id', - desc => 'The id of the user to plact into collections', - type => 'number', - }, - - { name => 'location', - desc => q/The short-name of the orginization unit (library) - for which the user is being removed from collections/, - type => q'string', - }, - ], - - 'return' => { - desc => q/A SUCCESS event on success, error event on failure/, - type => 'object', - } - } -); - -sub remove_from_collections { - my( $self, $conn, $auth, $user_id, $location ) = @_; - - return OpenILS::Event->new('BAD_PARAMS') - unless ($auth and $user_id and $location); - - my $e = new_editor(authtoken => $auth, xact=>1); - return $e->event unless $e->checkauth; - - my $org = $e->search_actor_org_unit({shortname => $location}) - or return $e->event; $org = $org->[0]; - return $e->event unless $e->allowed('money.collections_tracker.delete', $org->id); - - my $tracker = $e->search_money_collections_tracker( - { usr => $user_id, location => $org->id }) - or return $e->event; - - $e->delete_money_collections_tracker($tracker->[0]) - or return $e->event; - - $e->commit; - return OpenILS::Event->new('SUCCESS'); -} - - -#__PACKAGE__->register_method( -# method => 'transaction_details', -# api_name => 'open-ils.collections.user_transaction_details.retrieve', -# signature => q/ -# / -#); - - -__PACKAGE__->register_method( - method => 'transaction_details', - api_name => 'open-ils.collections.user_transaction_details.retrieve', - api_level => 1, - argc => 5, - signature => { - desc => q/ - Returns a list of fleshed user objects with transaction details - /, - - params => [ - { name => 'auth', - desc => 'The authentication token', - type => 'string' }, - - { name => 'start_date', - desc => 'The start of the time interval to check', - type => q/string (ISO 8601 timestamp. E.g. 2006-06-24, 1994-11-05T08:15:30-05:00 /, - }, - - { name => 'end_date', - desc => q/Then end date of the time interval to check/, - type => q/string (ISO 8601 timestamp. E.g. 2006-06-24, 1994-11-05T08:15:30-05:00 /, - }, - { name => 'location', - desc => q/The short-name of the orginization unit (library) at which the activity occurred. - If a selected location has 'child' locations (e.g. a library region), the - child locations will be included in the search/, - type => q'string', - }, - { - name => 'user_list', - desc => 'An array of user ids', - type => 'array', - }, - ], - - 'return' => { - desc => q/A list of objects. Object keys include: - usr : - transactions : An object with keys : - circulations : Fleshed circulation objects - grocery : Fleshed 'grocery' transaction objects - /, - type => 'object' - } - } -); - -sub transaction_details { - my( $self, $conn, $auth, $start_date, $end_date, $location, $user_list ) = @_; - - return OpenILS::Event->new('BAD_PARAMS') - unless ($auth and $start_date and $end_date and $location and $user_list); - - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - - # they need global perms to view users so no org is provided - return $e->event unless $e->allowed('VIEW_USER'); - - my $org = $e->search_actor_org_unit({shortname => $location}) - or return $e->event; $org = $org->[0]; - - # get a reference to the org inside of the tree - $org = $U->find_org($U->fetch_org_tree(), $org->id); - - my @data; - for my $uid (@$user_list) { - my $blob = {}; - - $blob->{usr} = $e->retrieve_actor_user( - [ - $uid, - { - "flesh" => 1, - "flesh_fields" => { - "au" => [ - "cards", - "card", - "standing_penalties", - "addresses", - "billing_address", - "mailing_address", - "stat_cat_entries" - ] - } - } - ] - ); - - $blob->{transactions} = { - circulations => - fetch_circ_xacts($e, $uid, $org, $start_date, $end_date), - grocery => - fetch_grocery_xacts($e, $uid, $org, $start_date, $end_date), - reservations => - fetch_reservation_xacts($e, $uid, $org, $start_date, $end_date) - }; - - # for each transaction, flesh the workstatoin on any attached payment - # and make the payment object a real object (e.g. cash payment), - # not just a generic payment object - for my $xact ( - @{$blob->{transactions}->{circulations}}, - @{$blob->{transactions}->{reservations}}, - @{$blob->{transactions}->{grocery}} ) { - - my $ps; - if( $ps = $xact->payments and @$ps ) { - my @fleshed; my $evt; - for my $p (@$ps) { - ($p, $evt) = flesh_payment($e,$p); - return $evt if $evt; - push(@fleshed, $p); - } - $xact->payments(\@fleshed); - } - } - - push( @data, $blob ); - } - - return \@data; -} - -sub flesh_payment { - my $e = shift; - my $p = shift; - my $type = $p->payment_type; - $logger->debug("collect: fleshing workstation on payment $type : ".$p->id); - my $meth = "retrieve_money_$type"; - $p = $e->$meth($p->id) or return (undef, $e->event); - try { - $p->payment_type($type); - $p->cash_drawer( - $e->retrieve_actor_workstation( - [ - $p->cash_drawer, - { - flesh => 1, - flesh_fields => { aws => [ 'owning_lib' ] } - } - ] - ) - ); - } catch Error with {}; - return ($p); -} - - -# -------------------------------------------------------------- -# Collect all open circs for the user -# For each circ, see if any billings or payments were created -# during the given time period. -# -------------------------------------------------------------- -sub fetch_circ_xacts { - my $e = shift; - my $uid = shift; - my $org = shift; - my $start_date = shift; - my $end_date = shift; - - my @circs; - - # at the specified org and each descendent org, - # fetch the open circs for this user - $U->walk_org_tree( $org, - sub { - my $n = shift; - $logger->debug("collect: searching for open circs at " . $n->shortname); - push( @circs, - @{ - $e->search_action_circulation( - { - usr => $uid, - circ_lib => $n->id, - }, - {idlist => 1} - ) - } - ); - } - ); - - - my @data; - my $active_ids = fetch_active($e, \@circs, $start_date, $end_date); - - for my $cid (@$active_ids) { - push( @data, - $e->retrieve_action_circulation( - [ - $cid, - { - flesh => 1, - flesh_fields => { - circ => [ "billings", "payments", "circ_lib", 'target_copy' ] - } - } - ] - ) - ); - } - - return \@data; -} - -sub fetch_grocery_xacts { - my $e = shift; - my $uid = shift; - my $org = shift; - my $start_date = shift; - my $end_date = shift; - - my @xacts; - $U->walk_org_tree( $org, - sub { - my $n = shift; - $logger->debug("collect: searching for open grocery xacts at " . $n->shortname); - push( @xacts, - @{ - $e->search_money_grocery( - { - usr => $uid, - billing_location => $n->id, - }, - {idlist => 1} - ) - } - ); - } - ); - - my @data; - my $active_ids = fetch_active($e, \@xacts, $start_date, $end_date); - - for my $id (@$active_ids) { - push( @data, - $e->retrieve_money_grocery( - [ - $id, - { - flesh => 1, - flesh_fields => { - mg => [ "billings", "payments", "billing_location" ] } - } - ] - ) - ); - } - - return \@data; -} - -sub fetch_reservation_xacts { - my $e = shift; - my $uid = shift; - my $org = shift; - my $start_date = shift; - my $end_date = shift; - - my @xacts; - $U->walk_org_tree( $org, - sub { - my $n = shift; - $logger->debug("collect: searching for open grocery xacts at " . $n->shortname); - push( @xacts, - @{ - $e->search_booking_reservation( - { - usr => $uid, - pickup_lib => $n->id, - }, - {idlist => 1} - ) - } - ); - } - ); - - my @data; - my $active_ids = fetch_active($e, \@xacts, $start_date, $end_date); - - for my $id (@$active_ids) { - push( @data, - $e->retrieve_booking_reservation( - [ - $id, - { - flesh => 1, - flesh_fields => { - bresv => [ "billings", "payments", "pickup_lib" ] } - } - ] - ) - ); - } - - return \@data; -} - - - -# -------------------------------------------------------------- -# Given a list of xact id's, this returns a list of id's that -# had any activity within the given time span -# -------------------------------------------------------------- -sub fetch_active { - my( $e, $ids, $start_date, $end_date ) = @_; - - # use this.. - # { payment_ts => { between => [ $start, $end ] } } ' ;) - - my @active; - for my $id (@$ids) { - - # see if any billings were created in the given time range - my $bills = $e->search_money_billing ( - { - xact => $id, - billing_ts => { between => [ $start_date, $end_date ] }, - }, - {idlist =>1} - ); - - my $payments = []; - - if( !@$bills ) { - - # see if any payments were created in the given range - $payments = $e->search_money_payment ( - { - xact => $id, - payment_ts => { between => [ $start_date, $end_date ] }, - }, - {idlist =>1} - ); - } - - - push( @active, $id ) if @$bills or @$payments; - } - - return \@active; -} - - -__PACKAGE__->register_method( - method => 'create_user_note', - api_name => 'open-ils.collections.patron_note.create', - api_level => 1, - argc => 4, - signature => { - desc => q/ Adds a note to a patron's account /, - params => [ - { name => 'auth', - desc => 'The authentication token', - type => 'string' }, - - { name => 'user_barcode', - desc => q/The patron's barcode/, - type => q/string/, - }, - { name => 'title', - desc => q/The title of the note/, - type => q/string/, - }, - - { name => 'note', - desc => q/The text of the note/, - type => q/string/, - }, - ], - - 'return' => { - desc => q/ - Returns SUCCESS event on success, error event otherwise. - /, - type => 'object' - } - } -); - - -sub create_user_note { - my( $self, $conn, $auth, $user_barcode, $title, $note_txt ) = @_; - - my $e = new_editor(authtoken=>$auth, xact=>1); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('UPDATE_USER'); # XXX Makre more specific perm for this - - return $e->event unless - my $card = $e->search_actor_card({barcode=>$user_barcode})->[0]; - - my $note = Fieldmapper::actor::usr_note->new; - $note->usr($card->usr); - $note->title($title); - $note->creator($e->requestor->id); - $note->create_date('now'); - $note->pub('f'); - $note->value($note_txt); - - $e->create_actor_usr_note($note) or return $e->event; - $e->commit; - return OpenILS::Event->new('SUCCESS'); -} - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Fielder.pm b/Open-ILS/src/perlmods/OpenILS/Application/Fielder.pm deleted file mode 100644 index 38a56c55b5..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Fielder.pm +++ /dev/null @@ -1,153 +0,0 @@ -# vim:et:ts=4:sw=4: - -package OpenILS::Application::Fielder; -use OpenILS::Application; -use base qw/OpenILS::Application/; - -use Unicode::Normalize; -use OpenSRF::EX qw/:try/; - -use OpenSRF::AppSession; -use OpenSRF::Utils::SettingsClient; -use OpenSRF::Utils::Cache; -use OpenSRF::Utils::Logger qw/:level/; - -use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::JSON; - -use OpenILS::Utils::CStoreEditor qw/:funcs/; - -use Digest::MD5 qw(md5_hex); - -use XML::LibXML; -use XML::LibXML::XPathContext; -use XML::LibXSLT; - -our %namespace_map = ( - oils_persist=> {ns => 'http://open-ils.org/spec/opensrf/IDL/persistence/v1'}, - oils_obj => {ns => 'http://open-ils.org/spec/opensrf/IDL/objects/v1'}, - idl => {ns => 'http://opensrf.org/spec/IDL/base/v1'}, - reporter => {ns => 'http://open-ils.org/spec/opensrf/IDL/reporter/v1'}, - perm => {ns => 'http://open-ils.org/spec/opensrf/IDL/permacrud/v1'}, -); - - -my $log = 'OpenSRF::Utils::Logger'; - -my $cache; -my $cache_timeout; -my $parser = XML::LibXML->new(); -my $xslt = XML::LibXSLT->new(); - -my $xpc = XML::LibXML::XPathContext->new(); -$xpc->registerNs($_, $namespace_map{$_}{ns}) for ( keys %namespace_map ); - -my $idl; - -sub initialize { - - my $conf = OpenSRF::Utils::SettingsClient->new; - my $idl_file = $conf->config_value( 'IDL' ); - - $idl = $parser->parse_file( $idl_file ); - - $log->debug( 'IDL XML file loaded' ); - - $cache_timeout = $conf->config_value( - "apps", "open-ils.fielder", "app_settings", "cache_timeout" ) || 300; - - generate_methods(); - -} -sub child_init { - $cache = OpenSRF::Utils::Cache->new('global'); -} - -sub fielder_fetch { - my $self = shift; - my $client = shift; - my $obj = shift; - - my $query = $obj->{query}; - my $nocache = $obj->{cache} ? 0 : 1; - my $fields = $obj->{fields}; - my $distinct = $obj->{distinct} ? 1 : 0; - - return undef unless $query; - - my $obj_class = $self->{class_hint}; - my $fm_class = $self->{class_name}; - - if (!$fields) { - $fields = [ $fm_class->real_fields ]; - } - - $fields = [$fields] if (!ref($fields)); - - my $qstring = OpenSRF::Utils::JSON->perl2JSON( $query ); - my $fstring = OpenSRF::Utils::JSON->perl2JSON( [ sort { $a cmp $b } @$fields ] ); - - $log->debug( 'Query Class: '. $obj_class ); - $log->debug( 'Field list: '. $fstring ); - $log->debug( 'Query: '. $qstring ); - - my ($key,$res); - unless ($nocache) { - $key = 'open-ils.fielder_' . md5_hex( - $self->api_name . - $qstring . - $fstring . - $distinct . - $obj_class - ); - - $res = $cache->get_cache( $key ); - - if ($res) { - $client->respond($_) for (@$res); - return undef; - } - } - - $res = new_editor()->json_query({ - select => { $obj_class => $fields }, - from => $obj_class, - where => $query, - distinct=> $distinct - }); - - for my $value (@$res) { - $client->respond($value); - } - - $client->respond_complete(); - - $cache->put_cache( $key => $res => $cache_timeout ) unless ($nocache); - return undef; -} - -sub generate_methods { - try { - for my $class_node ( $xpc->findnodes( '//idl:class[@oils_persist:field_safe="true"]', $idl->documentElement ) ) { - my $hint = $class_node->getAttribute('id'); - my $fm = $class_node->getAttributeNS('http://open-ils.org/spec/opensrf/IDL/objects/v1','fieldmapper'); - $log->debug("Fielder class_node $hint"); - - __PACKAGE__->register_method( - method => 'fielder_fetch', - api_name => 'open-ils.fielder.' . $hint, - class_hint => $hint, - class_name => "Fieldmapper::$fm", - stream => 1, - argc => 1 - ); - } - } catch Error with { - my $e = shift; - $log->error("error generating Fielder methods: $e"); - }; -} - - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Ingest.pm b/Open-ILS/src/perlmods/OpenILS/Application/Ingest.pm deleted file mode 100644 index 765000ce31..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Ingest.pm +++ /dev/null @@ -1,1453 +0,0 @@ -package OpenILS::Application::Ingest; -use OpenILS::Application; -use base qw/OpenILS::Application/; - -use Unicode::Normalize; -use OpenSRF::EX qw/:try/; - -use OpenSRF::AppSession; -use OpenSRF::Utils::SettingsClient; -use OpenSRF::Utils::Logger qw/:level/; - -use OpenILS::Application::AppUtils; -use OpenILS::Utils::ScriptRunner; -use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::JSON; - -use OpenILS::Utils::Fieldmapper; - -use XML::LibXML; -use XML::LibXSLT; -use Time::HiRes qw(time); - -our %supported_formats = ( - mods33 => {ns => 'http://www.loc.gov/mods/v3'}, - mods32 => {ns => 'http://www.loc.gov/mods/v3'}, - mods3 => {ns => 'http://www.loc.gov/mods/v3'}, - mods => {ns => 'http://www.loc.gov/mods/'}, - marcxml => {ns => 'http://www.loc.gov/MARC21/slim'}, - srw_dc => {ns => 'info:srw/schema/1/dc-schema'}, - oai_dc => {ns => 'http://www.openarchives.org/OAI/2.0/oai_dc/'}, - rdf_dc => {ns => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'}, - atom => {ns => 'http://www.w3.org/2005/Atom'}, - rss091 => {ns => 'http://my.netscape.com/rdf/simple/0.9/'}, - rss092 => {ns => ''}, - rss093 => {ns => ''}, - rss094 => {ns => ''}, - rss10 => {ns => 'http://purl.org/rss/1.0/'}, - rss11 => {ns => 'http://purl.org/net/rss1.1#'}, - rss2 => {ns => ''}, -); - - -my $log = 'OpenSRF::Utils::Logger'; - -my $parser = XML::LibXML->new(); -my $xslt = XML::LibXSLT->new(); - -my $mods_sheet; -my $mads_sheet; -my $xpathset = {}; -sub initialize {} -sub child_init {} - -sub post_init { - - unless (keys %$xpathset) { - $log->debug("Running post_init", DEBUG); - - my $xsldir = OpenSRF::Utils::SettingsClient->new->config_value(dirs => 'xsl'); - - unless ($supported_formats{mods}{xslt}) { - $log->debug("Loading MODS XSLT", DEBUG); - my $xslt_doc = $parser->parse_file( $xsldir . "/MARC21slim2MODS.xsl"); - $supported_formats{mods}{xslt} = $xslt->parse_stylesheet( $xslt_doc ); - } - - unless ($supported_formats{mods3}{xslt}) { - $log->debug("Loading MODS v3 XSLT", DEBUG); - my $xslt_doc = $parser->parse_file( $xsldir . "/MARC21slim2MODS3.xsl"); - $supported_formats{mods3}{xslt} = $xslt->parse_stylesheet( $xslt_doc ); - } - - unless ($supported_formats{mods32}{xslt}) { - $log->debug("Loading MODS v32 XSLT", DEBUG); - my $xslt_doc = $parser->parse_file( $xsldir . "/MARC21slim2MODS32.xsl"); - $supported_formats{mods32}{xslt} = $xslt->parse_stylesheet( $xslt_doc ); - } - - unless ($supported_formats{mods33}{xslt}) { - $log->debug("Loading MODS v33 XSLT", DEBUG); - my $xslt_doc = $parser->parse_file( $xsldir . "/MARC21slim2MODS33.xsl"); - $supported_formats{mods33}{xslt} = $xslt->parse_stylesheet( $xslt_doc ); - } - - my $req = OpenSRF::AppSession - ->create('open-ils.cstore') - - # XXX testing new metabib field use for faceting - #->request( 'open-ils.cstore.direct.config.metabib_field.search.atomic', { id => { '!=' => undef } } ) - ->request( 'open-ils.cstore.direct.config.metabib_field.search.atomic', { search_field => 't' } ) - - ->gather(1); - - if (ref $req and @$req) { - for my $f (@$req) { - $xpathset->{ $f->field_class }->{ $f->name }->{xpath} = $f->xpath; - $xpathset->{ $f->field_class }->{ $f->name }->{id} = $f->id; - $xpathset->{ $f->field_class }->{ $f->name }->{format} = $f->format; - $log->debug("Loaded XPath from DB: ".$f->field_class." => ".$f->name." : ".$f->xpath, DEBUG); - } - } - } -} - -# -------------------------------------------------------------------------------- -# Biblio ingest - -package OpenILS::Application::Ingest::Biblio; -use base qw/OpenILS::Application::Ingest/; -use Unicode::Normalize; - -sub rw_biblio_ingest_single_object { - my $self = shift; - my $client = shift; - my $bib = shift; - - my ($blob) = $self->method_lookup("open-ils.ingest.full.biblio.object.readonly")->run($bib); - return undef unless ($blob); - - $bib->fingerprint( $blob->{fingerprint}->{fingerprint} ); - $bib->quality( $blob->{fingerprint}->{quality} ); - - my $cstore = OpenSRF::AppSession->connect('open-ils.cstore'); - - my $xact = $cstore->request('open-ils.cstore.transaction.begin')->gather(1); - my $tmp; - - # update uri stuff ... - - # gather URI call numbers for this record - my $uri_cns = $u->{call_number} = $cstore->request( - 'open-ils.cstore.direct.asset.call_number.id_list.atomic' => { record => $bib->id, label => '##URI##' } - )->gather(1); - - if (@$uri_cns) { - # gather the maps for those call numbers - my $uri_maps = $u->{call_number} = $cstore->request( - 'open-ils.cstore.direct.asset.uri_call_number_map.id_list.atomic' => { call_number => $uri_cns } - )->gather(1); - - # delete the old maps - $cstore->request( 'open-ils.cstore.direct.asset.uri_call_number_map.delete' => $_ )->gather(1) for (@$uri_maps); - - # and delete the call numbers if there are no more URIs - if (!@{ $blob->{uri} }) { - $cstore->request( 'open-ils.cstore.direct.asset.call_number.delete' => $_ )->gather(1) for (@$uri_cns); - } - } - - # now, add CNs, URIs and maps - my %new_cns_by_owner; - my %new_uris_by_owner; - for my $u ( @{ $blob->{uri} } ) { - - my $owner = $u->{call_number}->owning_lib; - - if ($u->{call_number}->isnew) { - if ($new_cns_by_owner{$owner}) { - $u->{call_number} = $new_cns_by_owner{$owner}; - } else { - $u->{call_number}->clear_id; - $u->{call_number} = $new_cns_by_owner{$owner} = $cstore->request( - 'open-ils.cstore.direct.asset.call_number.create' => $u->{call_number} - )->gather(1); - } - } - - if ($u->{uri}->isnew) { - if ($new_uris_by_owner{$owner}) { - $u->{uri} = $new_uris_by_owner{$owner}; - } else { - $u->{uri} = $new_uris_by_owner{$owner} = $cstore->request( - 'open-ils.cstore.direct.asset.uri.create' => $u->{uri} - )->gather(1); - } - } - - # Check for an existing CN-URI map - $tmp = $cstore->request( - 'open-ils.cstore.direct.asset.uri_call_number_map.id_list', - { call_number => $u->{call_number}->id, uri => $u->{uri}->id } - )->gather(1); - - next if ($tmp); - - my $umap = Fieldmapper::asset::uri_call_number_map->new; - $umap->uri($u->{uri}->id); - $umap->call_number($u->{call_number}->id); - - $cstore->request( 'open-ils.cstore.direct.asset.uri_call_number_map.create' => $umap )->gather(1); - } - - # update full_rec stuff ... - $tmp = $cstore->request( - 'open-ils.cstore.direct.metabib.full_rec.id_list.atomic', - { record => $bib->id } - )->gather(1); - - $cstore->request( 'open-ils.cstore.direct.metabib.full_rec.delete' => $_ )->gather(1) for (@$tmp); - $cstore->request( 'open-ils.cstore.direct.metabib.full_rec.create' => $_ )->gather(1) for (@{ $blob->{full_rec} }); - - # update rec_descriptor stuff ... - $tmp = $cstore->request( - 'open-ils.cstore.direct.metabib.record_descriptor.id_list.atomic', - { record => $bib->id } - )->gather(1); - - $cstore->request( 'open-ils.cstore.direct.metabib.record_descriptor.delete' => $_ )->gather(1) for (@$tmp); - $cstore->request( 'open-ils.cstore.direct.metabib.record_descriptor.create' => $blob->{descriptor} )->gather(1); - - # deal with classed fields... - for my $class ( qw/title author subject keyword series identifier/ ) { - $tmp = $cstore->request( - "open-ils.cstore.direct.metabib.${class}_field_entry.id_list.atomic", - { source => $bib->id } - )->gather(1); - - $cstore->request( "open-ils.cstore.direct.metabib.${class}_field_entry.delete" => $_ )->gather(1) for (@$tmp); - } - for my $obj ( @{ $blob->{field_entries} } ) { - my $class = $obj->class_name; - $class =~ s/^Fieldmapper:://o; - $class =~ s/::/./go; - $cstore->request( "open-ils.cstore.direct.$class.create" => $obj )->gather(1); - } - - # update MR map ... - - $tmp = $cstore->request( - 'open-ils.cstore.direct.metabib.metarecord_source_map.search.atomic', - { source => $bib->id } - )->gather(1); - - $cstore->request( 'open-ils.cstore.direct.metabib.metarecord_source_map.delete' => $_->id )->gather(1) for (@$tmp); - - # get the old MRs - my $old_mrs = $cstore->request( - 'open-ils.cstore.direct.metabib.metarecord.search.atomic' => { id => [map { $_->metarecord } @$tmp] } - )->gather(1) if (@$tmp); - - $old_mrs = [] if (!ref($old_mrs)); - - my $mr; - for my $m (@$old_mrs) { - if ($m->fingerprint eq $bib->fingerprint) { - $mr = $m; - } else { - my $others = $cstore->request( - 'open-ils.cstore.direct.metabib.metarecord_source_map.id_list.atomic' => { metarecord => $m->id } - )->gather(1); - - if (!@$others) { - $cstore->request( - 'open-ils.cstore.direct.metabib.metarecord.delete' => $m->id - )->gather(1); - } - - $m->isdeleted(1); - } - } - - my $holds; - if (!$mr) { - # Get the matchin MR, if any. - $mr = $cstore->request( - 'open-ils.cstore.direct.metabib.metarecord.search', - { fingerprint => $bib->fingerprint } - )->gather(1); - - $holds = $cstore->request( - 'open-ils.cstore.direct.action.hold_request.search.atomic', - { hold_type => 'M', target => [ map { $_->id } grep { $_->isdeleted } @$old_mrs ] } - )->gather(1) if (@$old_mrs); - - if ($mr) { - for my $h (@$holds) { - $h->target($mr); - $cstore->request( 'open-ils.cstore.direct.action.hold_request.update' => $h )->gather(1); - $h->ischanged(1); - } - } - } - - if (!$mr) { - $mr = new Fieldmapper::metabib::metarecord; - $mr->fingerprint( $bib->fingerprint ); - $mr->master_record( $bib->id ); - $mr->id( - $cstore->request( - "open-ils.cstore.direct.metabib.metarecord.create", - $mr => { quiet => 'true' } - )->gather(1) - ); - - for my $h (grep { !$_->ischanged } @$holds) { - $h->target($mr); - $cstore->request( 'open-ils.cstore.direct.action.hold_request.update' => $h )->gather(1); - } - } else { - my $mrm = $cstore->request( - 'open-ils.cstore.direct.metabib.metarecord_source_map.search.atomic', - { metarecord => $mr->id } - )->gather(1); - - if (@$mrm) { - my $best = $cstore->request( - "open-ils.cstore.direct.biblio.record_entry.search", - { id => [ map { $_->source } @$mrm ] }, - { 'select' => { bre => [ qw/id quality/ ] }, - order_by => { bre => "quality desc" }, - limit => 1, - } - )->gather(1); - - if ($best->quality > $bib->quality) { - $mr->master_record($best->id); - } else { - $mr->master_record($bib->id); - } - } else { - $mr->master_record($bib->id); - } - - $mr->clear_mods; - - $cstore->request( 'open-ils.cstore.direct.metabib.metarecord.update' => $mr )->gather(1); - } - - my $mrm = new Fieldmapper::metabib::metarecord_source_map; - $mrm->source($bib->id); - $mrm->metarecord($mr->id); - - $cstore->request( 'open-ils.cstore.direct.metabib.metarecord_source_map.create' => $mrm )->gather(1); - $cstore->request( 'open-ils.cstore.direct.biblio.record_entry.update' => $bib )->gather(1); - - $cstore->request( 'open-ils.cstore.json_query.atomic' => { from => [ 'reporter.simple_rec_update', $bib->id ] } )->gather(1); - - $cstore->request( 'open-ils.cstore.transaction.commit' )->gather(1) || return undef;; - $cstore->disconnect; - - return $bib->id; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.biblio.object", - method => "rw_biblio_ingest_single_object", - api_level => 1, - argc => 1, -); - -sub rw_biblio_ingest_single_record { - my $self = shift; - my $client = shift; - my $rec = shift; - - OpenILS::Application::Ingest->post_init(); - my $cstore = OpenSRF::AppSession->connect( 'open-ils.cstore' ); - $cstore->request('open-ils.cstore.transaction.begin')->gather(1); - - my $r = $cstore->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve' => $rec )->gather(1); - - $cstore->request('open-ils.cstore.transaction.rollback')->gather(1); - $cstore->disconnect; - - return undef unless ($r and @$r); - - return ($self->method_lookup("open-ils.ingest.full.biblio.object")->run($r))[0]; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.biblio.record", - method => "rw_biblio_ingest_single_record", - api_level => 1, - argc => 1, -); - -sub rw_biblio_ingest_record_list { - my $self = shift; - my $client = shift; - my @rec = ref($_[0]) ? @{ $_[0] } : @_ ; - - OpenILS::Application::Ingest->post_init(); - my $cstore = OpenSRF::AppSession->connect( 'open-ils.cstore' ); - $cstore->request('open-ils.cstore.transaction.begin')->gather(1); - - my $r = $cstore->request( 'open-ils.cstore.direct.biblio.record_entry.search.atomic' => { id => \@rec } )->gather(1); - - $cstore->request('open-ils.cstore.transaction.rollback')->gather(1); - $cstore->disconnect; - - return undef unless ($r and @$r); - - my $count = 0; - for (@$r) { - if (($self->method_lookup("open-ils.ingest.full.biblio.object")->run($_))[0]) { - $count++ - } - } - return $count; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.biblio.record_list", - method => "rw_biblio_ingest_record_list", - api_level => 1, - argc => 1, -); - -sub ro_biblio_ingest_single_object { - my $self = shift; - my $client = shift; - my $bib = shift; - my $xml = OpenILS::Application::AppUtils->entityize($bib->marc); - my $max_cn = shift; - my $max_uri = shift; - - my $cstore = OpenSRF::AppSession->connect( 'open-ils.cstore' ); - - if (!$max_cn) { - my $cn = $cstore->request( 'open-ils.cstore.direct.asset.call_number.search' => { id => { '!=' => undef } }, { limit => 1, order_by => { acn => 'id desc' } } )->gather(1); - $max_cn = int($cn->id) + 1000; - } - - if (!$max_uri) { - my $cn = $cstore->request( 'open-ils.cstore.direct.asset.call_number.search' => { id => { '!=' => undef } }, { limit => 1, order_by => { acn => 'id desc' } } )->gather(1); - $max_uri = int($cn->id) + 1000; - } - - $cstore->disconnect; - - my $document = $parser->parse_string($xml); - - my @uris = $self->method_lookup("open-ils.ingest.856_uri.object")->run($bib, $max_cn, $max_uri); - my @mfr = $self->method_lookup("open-ils.ingest.flat_marc.biblio.xml")->run($document); - my @mXfe = $self->method_lookup("open-ils.ingest.extract.field_entry.all.xml")->run($document); - my ($fp) = $self->method_lookup("open-ils.ingest.fingerprint.xml")->run($xml); - my ($rd) = $self->method_lookup("open-ils.ingest.descriptor.xml")->run($xml); - - $_->source($bib->id) for (@mXfe); - $_->record($bib->id) for (@mfr); - $rd->record($bib->id) if ($rd); - - return { full_rec => \@mfr, field_entries => \@mXfe, fingerprint => $fp, descriptor => $rd, uri => \@uris }; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.biblio.object.readonly", - method => "ro_biblio_ingest_single_object", - api_level => 1, - argc => 1, -); - -sub ro_biblio_ingest_single_xml { - my $self = shift; - my $client = shift; - my $xml = OpenILS::Application::AppUtils->entityize(shift); - - my $document = $parser->parse_string($xml); - - my @mfr = $self->method_lookup("open-ils.ingest.flat_marc.biblio.xml")->run($document); - my @mXfe = $self->method_lookup("open-ils.ingest.extract.field_entry.all.xml")->run($document); - my ($fp) = $self->method_lookup("open-ils.ingest.fingerprint.xml")->run($xml); - my ($rd) = $self->method_lookup("open-ils.ingest.descriptor.xml")->run($xml); - - return { full_rec => \@mfr, field_entries => \@mXfe, fingerprint => $fp, descriptor => $rd }; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.biblio.xml.readonly", - method => "ro_biblio_ingest_single_xml", - api_level => 1, - argc => 1, -); - -sub ro_biblio_ingest_single_record { - my $self = shift; - my $client = shift; - my $rec = shift; - - OpenILS::Application::Ingest->post_init(); - my $r = OpenSRF::AppSession - ->create('open-ils.cstore') - ->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve' => $rec ) - ->gather(1); - - return undef unless ($r and @$r); - - my ($res) = $self->method_lookup("open-ils.ingest.full.biblio.xml.readonly")->run($r->marc); - - $_->source($rec) for (@{$res->{field_entries}}); - $_->record($rec) for (@{$res->{full_rec}}); - $res->{descriptor}->record($rec); - - return $res; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.biblio.record.readonly", - method => "ro_biblio_ingest_single_record", - api_level => 1, - argc => 1, -); - -sub ro_biblio_ingest_stream_record { - my $self = shift; - my $client = shift; - - OpenILS::Application::Ingest->post_init(); - - my $ses = OpenSRF::AppSession->create('open-ils.cstore'); - - while (my ($resp) = $client->recv( count => 1, timeout => 5 )) { - - my $rec = $resp->content; - last unless (defined $rec); - - $log->debug("Running open-ils.ingest.full.biblio.record.readonly ..."); - my ($res) = $self->method_lookup("open-ils.ingest.full.biblio.record.readonly")->run($rec); - - $_->source($rec) for (@{$res->{field_entries}}); - $_->record($rec) for (@{$res->{full_rec}}); - - $client->respond( $res ); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.biblio.record_stream.readonly", - method => "ro_biblio_ingest_stream_record", - api_level => 1, - stream => 1, -); - -sub ro_biblio_ingest_stream_xml { - my $self = shift; - my $client = shift; - - OpenILS::Application::Ingest->post_init(); - - my $ses = OpenSRF::AppSession->create('open-ils.cstore'); - - while (my ($resp) = $client->recv( count => 1, timeout => 5 )) { - - my $xml = $resp->content; - last unless (defined $xml); - - $log->debug("Running open-ils.ingest.full.biblio.xml.readonly ..."); - my ($res) = $self->method_lookup("open-ils.ingest.full.biblio.xml.readonly")->run($xml); - - $client->respond( $res ); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.biblio.xml_stream.readonly", - method => "ro_biblio_ingest_stream_xml", - api_level => 1, - stream => 1, -); - -sub rw_biblio_ingest_stream_import { - my $self = shift; - my $client = shift; - - OpenILS::Application::Ingest->post_init(); - - my $ses = OpenSRF::AppSession->create('open-ils.cstore'); - - while (my ($resp) = $client->recv( count => 1, timeout => 5 )) { - - my $bib = $resp->content; - last unless (defined $bib); - - $log->debug("Running open-ils.ingest.full.biblio.xml.readonly ..."); - my ($res) = $self->method_lookup("open-ils.ingest.full.biblio.xml.readonly")->run($bib->marc); - - $_->source($bib->id) for (@{$res->{field_entries}}); - $_->record($bib->id) for (@{$res->{full_rec}}); - - $client->respond( $res ); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.biblio.bib_stream.import", - method => "rw_biblio_ingest_stream_import", - api_level => 1, - stream => 1, -); - - -# -------------------------------------------------------------------------------- -# Authority ingest - -package OpenILS::Application::Ingest::Authority; -use base qw/OpenILS::Application::Ingest/; -use Unicode::Normalize; - -sub rw_authority_ingest_single_object { - my $self = shift; - my $client = shift; - my $auth = shift; - - my ($blob) = $self->method_lookup("open-ils.ingest.full.authority.object.readonly")->run($auth); - return undef unless ($blob); - - my $cstore = OpenSRF::AppSession->connect('open-ils.cstore'); - - my $xact = $cstore->request('open-ils.cstore.transaction.begin')->gather(1); - my $tmp; - - # update full_rec stuff ... - $tmp = $cstore->request( - 'open-ils.cstore.direct.authority.full_rec.id_list.atomic', - { record => $auth->id } - )->gather(1); - - $cstore->request( 'open-ils.cstore.direct.authority.full_rec.delete' => $_ )->gather(1) for (@$tmp); - $cstore->request( 'open-ils.cstore.direct.authority.full_rec.create' => $_ )->gather(1) for (@{ $blob->{full_rec} }); - - # XXX when we start extracting authority descriptors and adding sources ... - # - # update rec_descriptor stuff ... - #$tmp = $cstore->request( - # 'open-ils.cstore.direct.authority.record_descriptor.id_list.atomic', - # { record => $auth->id } - #)->gather(1); - # - #$cstore->request( 'open-ils.cstore.direct.authority.record_descriptor.delete' => $_ )->gather(1) for (@$tmp); - #$cstore->request( 'open-ils.cstore.direct.authority.record_descriptor.create' => $blob->{descriptor} )->gather(1); - #$cstore->request( 'open-ils.cstore.direct.authority.record_entry.update' => $auth )->gather(1); - - $cstore->request( 'open-ils.cstore.transaction.commit' )->gather(1) || return undef;; - $cstore->disconnect; - - return $auth->id; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.authority.object", - method => "rw_authority_ingest_single_object", - api_level => 1, - argc => 1, -); - -sub rw_authority_ingest_single_record { - my $self = shift; - my $client = shift; - my $rec = shift; - - OpenILS::Application::Ingest->post_init(); - my $cstore = OpenSRF::AppSession->connect( 'open-ils.cstore' ); - $cstore->request('open-ils.cstore.transaction.begin')->gather(1); - - my $r = $cstore->request( 'open-ils.cstore.direct.authority.record_entry.retrieve' => $rec )->gather(1); - - $cstore->request('open-ils.cstore.transaction.rollback')->gather(1); - $cstore->disconnect; - - return undef unless ($r and @$r); - - return ($self->method_lookup("open-ils.ingest.full.authority.object")->run($r))[0]; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.authority.record", - method => "rw_authority_ingest_single_record", - api_level => 1, - argc => 1, -); - -sub ro_authority_ingest_single_object { - my $self = shift; - my $client = shift; - my $bib = shift; - my $xml = OpenILS::Application::AppUtils->entityize($bib->marc); - - my $document = $parser->parse_string($xml); - - my @mfr = $self->method_lookup("open-ils.ingest.flat_marc.authority.xml")->run($document); - - $_->record($bib->id) for (@mfr); - - return { full_rec => \@mfr }; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.authority.object.readonly", - method => "ro_authority_ingest_single_object", - api_level => 1, - argc => 1, -); - -sub ro_authority_ingest_single_xml { - my $self = shift; - my $client = shift; - my $xml = OpenILS::Application::AppUtils->entityize(shift); - - my $document = $parser->parse_string($xml); - - my @mfr = $self->method_lookup("open-ils.ingest.flat_marc.authority.xml")->run($document); - - return { full_rec => \@mfr }; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.authority.xml.readonly", - method => "ro_authority_ingest_single_xml", - api_level => 1, - argc => 1, -); - -sub ro_authority_ingest_single_record { - my $self = shift; - my $client = shift; - my $rec = shift; - - OpenILS::Application::Ingest->post_init(); - my $r = OpenSRF::AppSession - ->create('open-ils.cstore') - ->request( 'open-ils.cstore.direct.authority.record_entry.retrieve' => $rec ) - ->gather(1); - - return undef unless ($r and @$r); - - my ($res) = $self->method_lookup("open-ils.ingest.full.authority.xml.readonly")->run($r->marc); - - $_->record($rec) for (@{$res->{full_rec}}); - $res->{descriptor}->record($rec); - - return $res; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.authority.record.readonly", - method => "ro_authority_ingest_single_record", - api_level => 1, - argc => 1, -); - -sub ro_authority_ingest_stream_record { - my $self = shift; - my $client = shift; - - OpenILS::Application::Ingest->post_init(); - - my $ses = OpenSRF::AppSession->create('open-ils.cstore'); - - while (my ($resp) = $client->recv( count => 1, timeout => 5 )) { - - my $rec = $resp->content; - last unless (defined $rec); - - $log->debug("Running open-ils.ingest.full.authority.record.readonly ..."); - my ($res) = $self->method_lookup("open-ils.ingest.full.authority.record.readonly")->run($rec); - - $_->record($rec) for (@{$res->{full_rec}}); - - $client->respond( $res ); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.authority.record_stream.readonly", - method => "ro_authority_ingest_stream_record", - api_level => 1, - stream => 1, -); - -sub ro_authority_ingest_stream_xml { - my $self = shift; - my $client = shift; - - OpenILS::Application::Ingest->post_init(); - - my $ses = OpenSRF::AppSession->create('open-ils.cstore'); - - while (my ($resp) = $client->recv( count => 1, timeout => 5 )) { - - my $xml = $resp->content; - last unless (defined $xml); - - $log->debug("Running open-ils.ingest.full.authority.xml.readonly ..."); - my ($res) = $self->method_lookup("open-ils.ingest.full.authority.xml.readonly")->run($xml); - - $client->respond( $res ); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.authority.xml_stream.readonly", - method => "ro_authority_ingest_stream_xml", - api_level => 1, - stream => 1, -); - -sub rw_authority_ingest_stream_import { - my $self = shift; - my $client = shift; - - OpenILS::Application::Ingest->post_init(); - - my $ses = OpenSRF::AppSession->create('open-ils.cstore'); - - while (my ($resp) = $client->recv( count => 1, timeout => 5 )) { - - my $bib = $resp->content; - last unless (defined $bib); - - $log->debug("Running open-ils.ingest.full.authority.xml.readonly ..."); - my ($res) = $self->method_lookup("open-ils.ingest.full.authority.xml.readonly")->run($bib->marc); - - $_->record($bib->id) for (@{$res->{full_rec}}); - - $client->respond( $res ); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.full.authority.bib_stream.import", - method => "rw_authority_ingest_stream_import", - api_level => 1, - stream => 1, -); - -# -------------------------------------------------------------------------------- -# MARC index extraction - -package OpenILS::Application::Ingest::XPATH; -use base qw/OpenILS::Application::Ingest/; -use Unicode::Normalize; - -# give this an XML documentElement and an XPATH expression -sub xpath_to_string { - my $xml = shift; - my $xpath = shift; - my $ns_uri = shift; - my $ns_prefix = shift; - my $unique = shift; - - $xml->setNamespace( $ns_uri, $ns_prefix, 1 ) if ($ns_uri && $ns_prefix); - - my $string = ""; - - # grab the set of matching nodes - my @nodes = $xml->findnodes( $xpath ); - for my $value (@nodes) { - - # grab all children of the node - my @children = $value->childNodes(); - for my $child (@children) { - - # add the childs content to the growing buffer - my $content = quotemeta($child->textContent); - next if ($unique && $string =~ /$content/); # uniquify the values - $string .= $child->textContent . " "; - } - if( ! @children ) { - $string .= $value->textContent . " "; - } - } - - $string =~ s/(\w+)\/(\w+)/$1 $2/sgo; - # Split date ranges and ISSNs on the hyphen - $string =~ s/(\d{4})-(\d{3,4}x?)/ $1 $2 /goi; - - return NFD($string); -} - -sub class_index_string_xml { - my $self = shift; - my $client = shift; - my $xml = shift; - my @classes = @_; - - OpenILS::Application::Ingest->post_init(); - $xml = $parser->parse_string(OpenILS::Application::AppUtils->entityize($xml)) unless (ref $xml); - - my %transform_cache; - - for my $class (@classes) { - my $class_constructor = "Fieldmapper::metabib::${class}_field_entry"; - for my $type ( keys %{ $xpathset->{$class} } ) { - - my $def = $xpathset->{$class}->{$type}; - my $sf = $OpenILS::Application::Ingest::supported_formats{$def->{format}}; - - my $document = $xml; - - if ($sf->{xslt}) { - $document = $transform_cache{$def->{format}} || $sf->{xslt}->transform($xml); - $transform_cache{$def->{format}} = $document; - } - - my $value = xpath_to_string( - $document->documentElement => $def->{xpath}, - $sf->{ns} => $def->{format}, - 1 - ); - - next unless $value; - - $value = NFD($value); - $value =~ s/\pM+//sgo; - $value =~ s/\pC+//sgo; - $value =~ s/\W+$//sgo; - - # hack to normalize ratio-like strings - while ($term =~ /\b\d{1}:[, ]?\d+(?:[ ,]\d+[^:])+/o) { - $term = $` . join ('', split(/[, ]/, $&)) . $'; - } - - $value =~ s/\b\.+\b//sgo; - $value = lc($value); - - my $fm = $class_constructor->new; - $fm->value( $value ); - $fm->field( $xpathset->{$class}->{$type}->{id} ); - $client->respond($fm); - } - } - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.field_entry.class.xml", - method => "class_index_string_xml", - api_level => 1, - argc => 2, - stream => 1, -); - -sub class_index_string_record { - my $self = shift; - my $client = shift; - my $rec = shift; - my @classes = shift; - - OpenILS::Application::Ingest->post_init(); - my $r = OpenSRF::AppSession - ->create('open-ils.cstore') - ->request( 'open-ils.cstore.direct.authority.record_entry.retrieve' => $rec ) - ->gather(1); - - return undef unless ($r and @$r); - - for my $fm ($self->method_lookup("open-ils.ingest.field_entry.class.xml")->run($r->marc, @classes)) { - $fm->source($rec); - $client->respond($fm); - } - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.field_entry.class.record", - method => "class_index_string_record", - api_level => 1, - argc => 2, - stream => 1, -); - -sub all_index_string_xml { - my $self = shift; - my $client = shift; - my $xml = shift; - - for my $fm ($self->method_lookup("open-ils.ingest.field_entry.class.xml")->run($xml, keys(%$xpathset))) { - $client->respond($fm); - } - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.extract.field_entry.all.xml", - method => "all_index_string_xml", - api_level => 1, - argc => 1, - stream => 1, -); - -sub all_index_string_record { - my $self = shift; - my $client = shift; - my $rec = shift; - - OpenILS::Application::Ingest->post_init(); - my $r = OpenSRF::AppSession - ->create('open-ils.cstore') - ->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve' => $rec ) - ->gather(1); - - return undef unless ($r and @$r); - - for my $fm ($self->method_lookup("open-ils.ingest.field_entry.class.xml")->run($r->marc, keys(%$xpathset))) { - $fm->source($rec); - $client->respond($fm); - } - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.extract.field_entry.all.record", - method => "all_index_string_record", - api_level => 1, - argc => 1, - stream => 1, -); - -# -------------------------------------------------------------------------------- -# Flat MARC - -package OpenILS::Application::Ingest::FlatMARC; -use base qw/OpenILS::Application::Ingest/; -use Unicode::Normalize; - - -sub _marcxml_to_full_rows { - - my $marcxml = shift; - my $xmltype = shift || 'metabib'; - - my $type = "Fieldmapper::${xmltype}::full_rec"; - - my @ns_list; - - my ($root) = $marcxml->findnodes('//*[local-name()="record"]'); - - for my $tagline ( @{$root->getChildrenByTagName("leader")} ) { - next unless $tagline; - _special_tag_to_full_rows($type, $tagline, \@ns_list, 'LDR'); - } - - for my $tagline ( @{$root->getChildrenByTagName("controlfield")} ) { - next unless $tagline; - _special_tag_to_full_rows($type, $tagline, \@ns_list, $tagline->getAttribute( "tag" )); - } - - for my $tagline ( @{$root->getChildrenByTagName("datafield")} ) { - next unless $tagline; - _data_tag_to_full_rows($type, $tagline, \@ns_list, $tagline->getAttribute( "tag" )); - - if ($xmltype eq 'metabib' and $tag eq '245') { - _data_tag_to_full_rows($type, $tagline, \@ns_list, 'tnf'); - } - } - - $log->debug("Returning ".scalar(@ns_list)." Fieldmapper nodes from $xmltype xml"); - return @ns_list; -} - -=head2 _special_tag_to_full_rows - -Converts a leader or control field to a set of normalized values - -=cut - -sub _special_tag_to_full_rows { - my $type = shift; - my $tagline = shift; - my $ns_list = shift; - my $tagname = shift; - - my $ns = $type->new; - - $ns->tag( $tagname ); - my $val = $tagline->textContent; - $val = NFD($val); - $val =~ s/\pM+//sgo; - $val =~ s/\pC+//sgo; - $val =~ s/\W+$//sgo; - $ns->value( $val ); - - push @$ns_list, $ns; -} - -=head2 _data_tag_to_full_rows - -Converts a data field to a set of normalized values - -=cut - -sub _data_tag_to_full_rows { - my $type = shift; - my $tagline = shift; - my $ns_list = shift; - my $tag = shift; - - my $ind1 = $tagline->getAttribute( "ind1" ); - my $ind2 = $tagline->getAttribute( "ind2" ); - - for my $data ( @{$tagline->getChildrenByTagName('subfield')} ) { - next unless $data; - - my $ns = $type->new; - - $ns->tag( $tag ); - $ns->ind1( $ind1 ); - $ns->ind2( $ind2 ); - $ns->subfield( $data->getAttribute( "code" ) ); - my $val = $data->textContent; - $val = NFD($val); - $val =~ s/\pM+//sgo; - $val =~ s/\pC+//sgo; - $val =~ s/\W+$//sgo; - # Split date ranges and ISSNs on the hyphen - $val =~ s/(\d{4})-(\d{3,4}x?)/ $1 $2 /goi; - $val =~ s/(\w+)\/(\w+)/$1 $2/sgo; - $ns->value( lc($val) ); - - push @$ns_list, $ns; - } -} - -sub flat_marc_xml { - my $self = shift; - my $client = shift; - my $xml = shift; - - $log->debug("processing [$xml]"); - - $xml = $parser->parse_string(OpenILS::Application::AppUtils->entityize($xml)) unless (ref $xml); - - my $type = 'metabib'; - $type = 'authority' if ($self->api_name =~ /authority/o); - - OpenILS::Application::Ingest->post_init(); - - $client->respond($_) for (_marcxml_to_full_rows($xml, $type)); - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.flat_marc.authority.xml", - method => "flat_marc_xml", - api_level => 1, - argc => 1, - stream => 1, -); -__PACKAGE__->register_method( - api_name => "open-ils.ingest.flat_marc.biblio.xml", - method => "flat_marc_xml", - api_level => 1, - argc => 1, - stream => 1, -); - -sub flat_marc_record { - my $self = shift; - my $client = shift; - my $rec = shift; - - my $type = 'biblio'; - $type = 'authority' if ($self->api_name =~ /authority/o); - - OpenILS::Application::Ingest->post_init(); - my $r = OpenSRF::AppSession - ->create('open-ils.cstore') - ->request( "open-ils.cstore.direct.${type}.record_entry.retrieve" => $rec ) - ->gather(1); - - - return undef unless ($r and $r->marc); - - my @rows = $self->method_lookup("open-ils.ingest.flat_marc.$type.xml")->run($r->marc); - for my $row (@rows) { - $client->respond($row); - $log->debug(OpenSRF::Utils::JSON->perl2JSON($row), DEBUG); - } - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.flat_marc.biblio.record_entry", - method => "flat_marc_record", - api_level => 1, - argc => 1, - stream => 1, -); -__PACKAGE__->register_method( - api_name => "open-ils.ingest.flat_marc.authority.record_entry", - method => "flat_marc_record", - api_level => 1, - argc => 1, - stream => 1, -); - -# -------------------------------------------------------------------------------- -# URI extraction - -package OpenILS::Application::Ingest::Biblio::URI; -use base qw/OpenILS::Application::Ingest/; -use Unicode::Normalize; -use OpenSRF::EX qw/:try/; - - -sub _extract_856_uris { - - my $rec = shift; - my $max_cn = shift; - my $max_uri = shift; - my @objects; - - my $recid = $rec->id; - my $marcxml = $rec->marc; - - my $document = $parser->parse_string($marcxml); - my @nodes = $document->findnodes('//*[local-name()="datafield" and @tag="856" and (@ind1="4" or @ind1="1") and (@ind2="0" or @ind2="1")]'); - - my $cstore = OpenSRF::AppSession->connect('open-ils.cstore'); - - my %cn_cache; - - for my $node (@nodes) { - # first, is there a URI? - my $href = $node->findvalue('*[local-name()="subfield" and @code="u"]/text()'); - next unless ($href); - - # now, find the best possible label - my $label = $node->findvalue('*[local-name()="subfield" and @code="y"]/text()'); - $label ||= $node->findvalue('*[local-name()="subfield" and @code="3"]/text()'); - $label ||= $href; - - # look for use info - my $use = $node->findvalue('*[local-name()="subfield" and @code="z"]/text()'); - $use ||= $node->findvalue('*[local-name()="subfield" and @code="2"]/text()'); - $use ||= $node->findvalue('*[local-name()="subfield" and @code="n"]/text()'); - - # moving on to the URI owner - my $owner = $node->findvalue('*[local-name()="subfield" and @code="9"]/text()'); # Evergreen special sauce - $owner ||= $node->findvalue('*[local-name()="subfield" and @code="w"]/text()'); - $owner ||= $node->findvalue('*[local-name()="subfield" and @code="n"]/text()'); - - $owner =~ s/^.*?\((\w+)\).*$/$1/o; # unwrap first paren-enclosed string and then ... - - # no owner? skip it :( - next unless ($owner); - - my $org = $cstore - ->request( 'open-ils.cstore.direct.actor.org_unit.search' => { shortname => $owner} ) - ->gather(1); - - next unless ($org); - - # now we can construct the uri object - my $uri = $cstore - ->request( 'open-ils.cstore.direct.asset.uri.search' => { label => $label, href => $href, use_restriction => $use, active => 't' } ) - ->gather(1); - - if (!$uri) { - $uri = Fieldmapper::asset::uri->new; - $uri->isnew( 1 ); - $uri->id( $$max_uri++ ); - $uri->label($label); - $uri->href($href); - $uri->active('t'); - $uri->use_restriction($use); - } - - # see if we need to create a call number - my $cn = $cn_cache{$org->id}; - $cn = $cn->clone if ($cn); - $cn->clear_isnew if ($cn); - - $cn ||= $cstore - ->request( 'open-ils.cstore.direct.asset.call_number.search' => { owning_lib => $org->id, record => $recid, label => '##URI##' } ) - ->gather(1); - - if (!$cn) { - $cn = Fieldmapper::asset::call_number->new; - $cn->isnew( 1 ); - $cn->deleted('f'); - $cn->id( $$max_cn++ ); - $cn->owning_lib( $org->id ); - $cn->record( $recid ); - $cn->create_date( 'now' ); - $cn->creator( $rec->creator ); - $cn->editor( $rec->editor ); - $cn->edit_date( 'now' ); - $cn->label( '##URI##' ); - } - - $cn_cache{$org->id} = $cn; - - push @objects, { uri => $uri, call_number => $cn }; - } - - $log->debug("Returning ".scalar(@objects)." URI nodes for record $recid"); - $cstore->disconnect; - return @objects; -} - -sub get_uris_record { - my $self = shift; - my $client = shift; - my $rec = shift; - - OpenILS::Application::Ingest->post_init(); - my $r = OpenSRF::AppSession - ->create('open-ils.cstore') - ->request( "open-ils.cstore.direct.biblio.record_entry.retrieve" => $rec ) - ->gather(1); - - return undef unless ($r and $r->marc); - - $client->respond($_) for (_extract_856_uris($r)); - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.856_uri.record", - method => "get_uris_record", - api_level => 1, - argc => 1, - stream => 1, -); - -sub get_uris_object { - my $self = shift; - my $client = shift; - my $obj = shift; - my $max_cn = shift; - my $max_uri = shift; - - return undef unless ($obj and $obj->marc); - - $client->respond($_) for (_extract_856_uris($obj, \$max_cn, \$max_uri)); - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.856_uri.object", - method => "get_uris_object", - api_level => 1, - argc => 1, - stream => 1, -); - - -# -------------------------------------------------------------------------------- -# Fingerprinting - -package OpenILS::Application::Ingest::Biblio::Fingerprint; -use base qw/OpenILS::Application::Ingest/; -use Unicode::Normalize; -use OpenSRF::EX qw/:try/; - -sub biblio_fingerprint_record { - my $self = shift; - my $client = shift; - my $rec = shift; - - OpenILS::Application::Ingest->post_init(); - - my $r = OpenSRF::AppSession - ->create('open-ils.cstore') - ->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve' => $rec ) - ->gather(1); - - return undef unless ($r and $r->marc); - - my ($fp) = $self->method_lookup('open-ils.ingest.fingerprint.xml')->run($r->marc); - $log->debug("Returning [$fp] as fingerprint for record $rec", INFO); - $fp->{quality} = int($fp->{quality}); - return $fp; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.fingerprint.record", - method => "biblio_fingerprint_record", - api_level => 1, - argc => 1, -); - -our $fp_script; -sub biblio_fingerprint { - my $self = shift; - my $client = shift; - my $xml = OpenILS::Application::AppUtils->entityize(shift); - - $log->internal("Got MARC [$xml]"); - - if(!$fp_script) { - my @pfx = ( "apps", "open-ils.ingest","app_settings" ); - my $conf = OpenSRF::Utils::SettingsClient->new; - - my $libs = $conf->config_value(@pfx, 'script_path'); - my $script_file = $conf->config_value(@pfx, 'scripts', 'biblio_fingerprint'); - my $script_libs = (ref($libs)) ? $libs : [$libs]; - - $log->debug("Loading script $script_file for biblio fingerprinting..."); - - $fp_script = new OpenILS::Utils::ScriptRunner - ( file => $script_file, - paths => $script_libs, - reset_count => 100 ); - } - - $fp_script->insert('environment' => {marc => $xml} => 1); - - my $res = $fp_script->run || ($log->error( "Fingerprint script died! $@" ) && return undef); - $log->debug("Script for biblio fingerprinting completed successfully..."); - - return $res; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.fingerprint.xml", - method => "biblio_fingerprint", - api_level => 1, - argc => 1, -); - -our $rd_script; -sub biblio_descriptor { - my $self = shift; - my $client = shift; - my $xml = OpenILS::Application::AppUtils->entityize(shift); - - $log->internal("Got MARC [$xml]"); - - if(!$rd_script) { - my @pfx = ( "apps", "open-ils.ingest","app_settings" ); - my $conf = OpenSRF::Utils::SettingsClient->new; - - my $libs = $conf->config_value(@pfx, 'script_path'); - my $script_file = $conf->config_value(@pfx, 'scripts', 'biblio_descriptor'); - my $script_libs = (ref($libs)) ? $libs : [$libs]; - - $log->debug("Loading script $script_file for biblio descriptor extraction..."); - - $rd_script = new OpenILS::Utils::ScriptRunner - ( file => $script_file, - paths => $script_libs, - reset_count => 100 ); - } - - $log->debug("Setting up environment for descriptor extraction script..."); - $rd_script->insert('environment.marc' => $xml => 1); - $log->debug("Environment building complete..."); - - my $res = $rd_script->run || ($log->error( "Descriptor script died! $@" ) && return undef); - $log->debug("Script for biblio descriptor extraction completed successfully"); - - my $d1 = $res->date1; - if ($d1 && $d1 ne ' ') { - $d1 =~ tr/ux/00/; - $res->date1( $d1 ); - } - - my $d2 = $res->date2; - if ($d2 && $d2 ne ' ') { - $d2 =~ tr/ux/99/; - $res->date2( $d2 ); - } - - return $res; -} -__PACKAGE__->register_method( - api_name => "open-ils.ingest.descriptor.xml", - method => "biblio_descriptor", - api_level => 1, - argc => 1, -); - - -1; - -# vim:et:ts=4:sw=4: diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Penalty.pm b/Open-ILS/src/perlmods/OpenILS/Application/Penalty.pm deleted file mode 100644 index 48a893e48d..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Penalty.pm +++ /dev/null @@ -1,41 +0,0 @@ -package OpenILS::Application::Penalty; -use strict; use warnings; -use OpenSRF::EX qw(:try); -use OpenILS::Application; -use OpenILS::Utils::Penalty; -use OpenILS::Utils::CStoreEditor qw/:funcs/; -use base 'OpenILS::Application'; - -__PACKAGE__->register_method ( - method => 'patron_penalty', - api_name => 'open-ils.penalty.patron_penalty.calculate', - signature => q/ - Calculates the patron's standing penalties - @param args An object of named params including: - patronid The id of the patron - update True if this call should update the database - background True if this call should return immediately, - then go on to process the penalties. This flag - works only in conjunction with the 'update' flag. - @return An object with keys 'fatal_penalties' and - 'info_penalties' who are themeselves arrays of 0 or - more penalties. Returns event on error. - / -); - -# -------------------------------------------------------------- -# if $args->{background} is true, immediately respond complete -# to the caller, then finish the calculation -# -------------------------------------------------------------- -sub patron_penalty { - my( $self, $conn, $args ) = @_; - $conn->respond_complete(1) if $$args{background}; - my $e = new_editor(xact => 1); - OpenILS::Utils::Penalty->calculate_penalties($e, $args->{patronid}, $args->{context_org}); - my $p = OpenILS::Utils::Penalty->retrieve_penalties($e, $args->{patronid}, $args->{context_org}); - $e->commit; - return $p -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/PermaCrud.pm b/Open-ILS/src/perlmods/OpenILS/Application/PermaCrud.pm deleted file mode 100644 index 0d1e7646e7..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/PermaCrud.pm +++ /dev/null @@ -1,281 +0,0 @@ -# vim:et:ts=4:sw=4: - -package OpenILS::Application::PermaCrud; -use OpenILS::Application; -use base qw/OpenILS::Application/; -use strict; use warnings; - -use Unicode::Normalize; -use OpenSRF::EX qw/:try/; - -use OpenSRF::AppSession; -use OpenSRF::Utils::SettingsClient; -use OpenSRF::Utils::Logger qw/:level/; - -use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::JSON; - -use OpenILS::Utils::CStoreEditor qw/:funcs/; - -use XML::LibXML; -use XML::LibXML::XPathContext; -use XML::LibXSLT; -use OpenILS::Event; - -our %namespace_map = ( - oils_persist=> {ns => 'http://open-ils.org/spec/opensrf/IDL/persistence/v1'}, - oils_obj => {ns => 'http://open-ils.org/spec/opensrf/IDL/objects/v1'}, - idl => {ns => 'http://opensrf.org/spec/IDL/base/v1'}, - reporter => {ns => 'http://open-ils.org/spec/opensrf/IDL/reporter/v1'}, - perm => {ns => 'http://open-ils.org/spec/opensrf/IDL/permacrud/v1'}, -); - - -my $log = 'OpenSRF::Utils::Logger'; - -my $parser = XML::LibXML->new(); -my $xslt = XML::LibXSLT->new(); - -my $xpc = XML::LibXML::XPathContext->new(); -$xpc->registerNs($_, $namespace_map{$_}{ns}) for ( keys %namespace_map ); - -my $idl; - -sub initialize { - - my $conf = OpenSRF::Utils::SettingsClient->new; - my $idl_file = $conf->config_value( 'IDL' ); - - $idl = $parser->parse_file( $idl_file ); - - $log->debug( 'IDL XML file loaded' ); - - generate_methods(); - -} -sub child_init {} - -sub CRUD_action_object_permcheck { - my $self = shift; - my $client = shift; - my $auth = shift; - my $obj = shift; - - my $e = shift || new_editor(authtoken => $auth, xact => 1); - return $e->event unless $e->checkauth; - - if (ref($obj) && $obj->json_hint ne $self->{class_hint}) { - throw OpenSRF::DomainObject::oilsException->new( - statusCode => 500, - status => "Class missmatch: $self->{class_hint} method called with " . $obj->json_hint, - ); - } - - my $class_node; - my $error = ''; - try { - ($class_node) = $xpc->findnodes( "//idl:class[\@id='$self->{class_hint}']", $idl->documentElement ); - } catch Error with { - $error = shift; - $log->error("Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]"); - throw OpenSRF::DomainObject::oilsException->new( - statusCode => 500, - status => "Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]" - ); - }; - - if (!$class_node) { - $log->error("Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]"); - throw OpenSRF::DomainObject::oilsException->new( - statusCode => 500, - status => "Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]" - ); - } - - my $action_node; - try { - ($action_node) = $xpc->findnodes( "perm:permacrud/perm:actions/perm:$self->{action}", $class_node ); - } catch Error with { - $error = shift; - $log->error("Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]"); - throw OpenSRF::DomainObject::oilsException->new( - statusCode => 500, - status => "Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]" - ); - }; - - if (!$action_node) { - $log->error("Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]"); - throw OpenSRF::DomainObject::oilsException->new( - statusCode => 500, - status => "Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]" - ); - } - - my $all_perms = $action_node->getAttribute( 'all_perms' ); - - my $fm_class = $xpc->findvalue( '@oils_obj:fieldmapper', $class_node ); - if (!ref($obj)) { - my $retrieve_method = 'retrieve_' . $fm_class; - $retrieve_method =~ s/::/_/go; - $obj = $e->$retrieve_method( $obj ) or return $e->die_event; - } - - (my $o_type = $fm_class) =~ s/::/./go; - - my $perm_field_value = $action_node->getAttribute('permission'); - - if ($perm_field_value) { - my @perms = split ' ', $perm_field_value; - - my @context_ous; - if ($action_node->getAttribute('global_required')) { - push @context_ous, $e->search_actor_org_unit( { parent_ou => undef } )->[0]->id; - - } else { - my $context_field_value = $action_node->getAttribute('context_field'); - - if ($context_field_value) { - push @context_ous, $obj->$_ for ( split ' ', $context_field_value ); - } else { - for my $context_node ( $xpc->findnodes( "perm:context", $action_node ) ) { - my $context_field = $context_node->getAttribute('field'); - my $link_field = $context_node->getAttribute('link'); - - if ($link_field) { - - my ($link_node) = $xpc->findnodes( "idl:links/idl:link[\@field='$link_field']", $class_node ); - my $link_class_hint = $link_node->getAttribute('class'); - my $remote_field = $link_node->getAttribute('key'); - - my ($remote_class_node) = $xpc->findnodes( "//idl:class[\@id='$link_class_hint']", $idl->documentElement ); - my $search_method = 'search_' . $xpc->findvalue( '@oils_obj:fieldmapper', $remote_class_node ); - $search_method =~ s/::/_/go; - - for my $remote_object ( @{$e->$search_method( { $remote_field => $obj->$link_field } )} ) { - push @context_ous, $remote_object->$context_field; - } - } else { - push @context_ous, $obj->$_ for ( split ' ', $context_field ); - } - } - } - } - - my $pok = 0; - for my $perm (@perms) { - if (@context_ous) { - for my $c_ou (@context_ous) { - if ($e->allowed($perm => $c_ou => $obj)) { - $pok++; - last; - } - } - } else { - $pok++ if ($e->allowed($perm => undef => $obj)); - } - } - - if ((lc($all_perms) eq 'true' && @perms != $pok) or !$pok) { - return OpenILS::Event->new('PERM_FAILURE', - ilsperm => "", # XXX add logic to report which perm failed - ilspermloc => "", - payload => "Perm failure -- action: $self->{action}, object type: $self->{json_hint}", - ); - } - } - - if ($self->{action} eq 'retrieve') { - $e->rollback; - return $obj; - } - - $o_type =~ s/\./_/og; - my $method = $self->{action} . "_$o_type"; - my $val = $e->$method($obj) or return $e->die_event; - $e->commit; - - return $val; -} - -sub search_permacrud { - my $self = shift; - my $client = shift; - my $auth = shift; - my @args = @_; - - if (@args > 1) { - delete $args[1]{flesh}; - delete $args[1]{flesh_fields}; - } - - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->event unless $e->checkauth; - - my $class_node; - try { - ($class_node) = $xpc->findnodes( "//idl:class[\@id='$self->{class_hint}']", $idl->documentElement ); - } catch Error with { - my $error = shift; - $log->error("Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]"); - throw OpenSRF::DomainObject::oilsException->new( - statusCode => 500, - status => "Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]" - ); - }; - - my $search_method = 'search_' . $xpc->findvalue( '@oils_obj:fieldmapper', $class_node ); - $search_method =~ s/::/_/go; - - $log->debug("Calling CStoreEditor search method: $search_method"); - - my $obj_list = $e->$search_method( \@args ); - - my $retriever = $self->method_lookup( $self->{retriever} ); - for my $o ( @$obj_list ) { - try { - ($o) = $retriever->run( $auth, $o, $e ); - $client->respond( $o ) if ($o); - }; - } - - return undef; -} - -sub generate_methods { - try { - for my $class_node ( $xpc->findnodes( '//idl:class[perm:permacrud]', $idl->documentElement ) ) { - my $hint = $class_node->getAttribute('id'); - $log->debug("permacrud class_node $hint"); - - for my $action_node ( $xpc->findnodes( "perm:permacrud/perm:actions/perm:*", $class_node ) ) { - (my $method = $action_node->localname) =~ s/^.+:(.+)$/$1/o; - $log->internal("permacrud method = $method"); - - __PACKAGE__->register_method( - method => 'CRUD_action_object_permcheck', - api_name => 'open-ils.permacrud.' . $method . '.' . $hint, - class_hint => $hint, - action => $method, - ); - - if ($method eq 'retrieve') { - __PACKAGE__->register_method( - method => 'search_permacrud', - api_name => 'open-ils.permacrud.search.' . $hint, - class_hint => $hint, - retriever => 'open-ils.permacrud.retrieve.' . $hint, - stream => 1 - ); - } - } - } - } catch Error with { - my $e = shift; - $log->error("error generating permacrud methods: $e"); - }; -} - - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Proxy.pm b/Open-ILS/src/perlmods/OpenILS/Application/Proxy.pm deleted file mode 100644 index c355c0e753..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Proxy.pm +++ /dev/null @@ -1,53 +0,0 @@ -package OpenILS::Application::Proxy; -use strict; use warnings; -use OpenILS::Application; -use base qw/OpenILS::Application/; -use OpenSRF::EX qw(:try); - - -__PACKAGE__->register_method( - method => "proxy", - api_name => "open-ils.proxy.proxy", - stream => 1, -); - - -sub proxy { - my($self, $client, $user_session, - $server, $method, @params) = @_; - - warn "$user_session - $server - $method\n"; - - throw OpenSRF::EX::ERROR ("Not enough args to proxy") - unless ($user_session and $server and $method); - - - my $session = OpenSRF::AppSession->create($server); - my $request = $session->request( $method, @params ); - if(!$request) { - throw OpenSRF::EX::ERROR - ("No request built on call to session->request( $method, @params )"); - } - - $request->wait_complete; - - if( $request->failed() ) { - - throw OpenSRF::EX::ERROR - ($request->failed()->stringify()); - - } else { - - while( my $response = $request->recv ) { - $client->respond( $response->content ); - } - } - - $request->finish(); - $session->finish(); - $session->disconnect(); - - return undef; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Reporter.pm b/Open-ILS/src/perlmods/OpenILS/Application/Reporter.pm deleted file mode 100644 index 1cd1e2ee72..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Reporter.pm +++ /dev/null @@ -1,626 +0,0 @@ -package OpenILS::Application::Reporter; -use OpenILS::Application; -use base qw/OpenILS::Application/; -use strict; use warnings; -use OpenSRF::Utils::Logger qw/$logger/; -use OpenILS::Utils::CStoreEditor qw/:funcs/; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Application::AppUtils; -my $U = "OpenILS::Application::AppUtils"; - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.folder.create', - method => 'create_folder' -); - -sub create_folder { - my( $self, $conn, $auth, $type, $folder ) = @_; - - my $e = new_rstore_editor(xact=>1, authtoken=>$auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - - return 0 if $folder->owner ne $e->requestor->id; - - $folder->owner($e->requestor->id); - my $meth = "create_reporter_${type}_folder"; - $e->$meth($folder) or return $e->die_event; - $e->commit; - - return $folder->id; -} - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.report.exists', - method => 'report_exists', - notes => q/ - Returns 1 if a report with the given name and folder already exists. - / -); - -sub report_exists { - my( $self, $conn, $auth, $report ) = @_; - - my $e = new_rstore_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('RUN_REPORTS'); - - my $existing = $e->search_reporter_report( - {folder=>$report->folder, name=>$report->name}); - return 1 if @$existing; - return 0; -} - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.folder.visible.retrieve', - method => 'retrieve_visible_folders' -); - -sub retrieve_visible_folders { - my( $self, $conn, $auth, $type ) = @_; - my $e = new_rstore_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('RUN_REPORTS'); - - my $class = 'rrf'; - $class = 'rtf' if $type eq 'template'; - $class = 'rof' if $type eq 'output'; - my $flesh = {flesh => 1,flesh_fields => { $class => ['owner', 'share_with']}}; - - my $meth = "search_reporter_${type}_folder"; - my $fs = $e->$meth( [{ owner => $e->requestor->id }, $flesh] ); - - my @orgs; - my $o = $U->storagereq( - 'open-ils.storage.actor.org_unit.full_path.atomic', $e->requestor->ws_ou); - push( @orgs, $_->id ) for @$o; - - my $fs2 = $e->$meth( - [ - { - shared => 't', - share_with => \@orgs, - owner => { '!=' => $e->requestor->id } - }, - $flesh - ] - ); - push( @$fs, @$fs2); - return $fs; -} - - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.folder_data.retrieve', - method => 'retrieve_folder_data' -); - -sub retrieve_folder_data { - my( $self, $conn, $auth, $type, $folderid, $limit ) = @_; - my $e = new_rstore_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('RUN_REPORTS'); - my $meth = "search_reporter_${type}"; - my $class = 'rr'; - $class = 'rt' if $type eq 'template'; - my $flesh = { - flesh => 1, - flesh_fields => { $class => ['owner']}, - order_by => { $class => 'create_time DESC'} - }; - $flesh->{limit} = $limit if $limit; - return $e->$meth([{ folder => $folderid }, $flesh]); -} - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.schedule.retrieve_by_folder', - method => 'retrieve_schedules'); -sub retrieve_schedules { - my( $self, $conn, $auth, $folderId, $limit, $complete ) = @_; - my $e = new_rstore_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('RUN_REPORTS'); - - my $search = { folder => $folderId }; - my $query = [ - { folder => $folderId }, - { - order_by => { rs => 'run_time DESC' } , - flesh => 1, - flesh_fields => { rs => ['report'] } - } - ]; - - $query->[1]->{limit} = $limit if $limit; - $query->[0]->{complete_time} = undef unless $complete; - $query->[0]->{complete_time} = { '!=' => undef } if $complete; - - return $e->search_reporter_schedule($query); -} - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.schedule.retrieve', - method => 'retrieve_schedules'); -sub retrieve_schedule { - my( $self, $conn, $auth, $sched_id ) = @_; - my $e = new_rstore_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('RUN_REPORTS'); - my $s = $e->retrieve_reporter_schedule($sched_id) - or return $e->event; - return $s; -} - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.template.create', - method => 'create_template'); -sub create_template { - my( $self, $conn, $auth, $template ) = @_; - my $e = new_rstore_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - $template->owner($e->requestor->id); - - my $existing = $e->search_reporter_template( {owner=>$template->owner, - folder=>$template->folder, name=>$template->name},{idlist=>1}); - return OpenILS::Event->new('REPORT_TEMPLATE_EXISTS') if @$existing; - - my $tmpl = $e->create_reporter_template($template) - or return $e->die_event; - $e->commit; - return $tmpl; -} - - - - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.report.create', - method => 'create_report'); -sub create_report { - my( $self, $conn, $auth, $report, $schedule ) = @_; - my $e = new_rstore_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - $report->owner($e->requestor->id); - - my $existing = $e->search_reporter_report( {owner=>$report->owner, - folder=>$report->folder, name=>$report->name},{idlist=>1}); - return OpenILS::Event->new('REPORT_REPORT_EXISTS') if @$existing; - - my $rpt = $e->create_reporter_report($report) - or return $e->die_event; - $schedule->report($rpt->id); - $schedule->runner($e->requestor->id); - $e->create_reporter_schedule($schedule) or return $e->die_event; - $e->commit; - return $rpt; -} - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.schedule.create', - method => 'create_schedule'); -sub create_schedule { - my( $self, $conn, $auth, $schedule ) = @_; - my $e = new_rstore_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - my $sched = $e->create_reporter_schedule($schedule) - or return $e->die_event; - $e->commit; - return $sched; -} - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.template.retrieve', - method => 'retrieve_template'); -sub retrieve_template { - my( $self, $conn, $auth, $id ) = @_; - my $e = new_rstore_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('RUN_REPORTS'); - my $t = $e->retrieve_reporter_template($id) - or return $e->event; - return $t; -} - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.report.retrieve', - method => 'retrieve_report'); -sub retrieve_report { - my( $self, $conn, $auth, $id ) = @_; - my $e = new_rstore_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('RUN_REPORTS'); - my $r = $e->retrieve_reporter_report($id) - or return $e->event; - return $r; -} - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.template.update', - method => 'update_template'); -sub update_template { - my( $self, $conn, $auth, $tmpl ) = @_; - my $e = new_rstore_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - my $t = $e->retrieve_reporter_template($tmpl->id) - or return $e->die_event; - return 0 if $t->owner ne $e->requestor->id; - $e->update_reporter_template($tmpl) - or return $e->die_event; - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.report.update', - method => 'update_report'); -sub update_report { - my( $self, $conn, $auth, $report ) = @_; - my $e = new_rstore_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - my $r = $e->retrieve_reporter_report($report->id) - or return $e->die_event; - if( $r->owner ne $e->requestor->id ) { - $e->rollback; - return 0; - } - $e->update_reporter_report($report) - or return $e->die_event; - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.schedule.update', - method => 'update_schedule'); -sub update_schedule { - my( $self, $conn, $auth, $schedule ) = @_; - my $e = new_rstore_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - my $s = $e->retrieve_reporter_schedule($schedule->id) - or return $e->die_event; - my $r = $e->retrieve_reporter_report($s->report) - or return $e->die_event; - if( $r->owner ne $e->requestor->id ) { - $e->rollback; - return 0; - } - $e->update_reporter_schedule($schedule) - or return $e->die_event; - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.folder.update', - method => 'update_folder'); -sub update_folder { - my( $self, $conn, $auth, $type, $folder ) = @_; - my $e = new_rstore_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - my $meth = "retrieve_reporter_${type}_folder"; - my $f = $e->$meth($folder->id) or return $e->die_event; - return 0 if $f->owner ne $e->requestor->id; - $meth = "update_reporter_${type}_folder"; - $e->$meth($folder) or return $e->die_event; - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.folder.delete', - method => 'delete_folder'); -sub delete_folder { - my( $self, $conn, $auth, $type, $folderId ) = @_; - my $e = new_rstore_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - my $meth = "retrieve_reporter_${type}_folder"; - my $f = $e->$meth($folderId) or return $e->die_event; - return 0 if $f->owner ne $e->requestor->id; - $meth = "delete_reporter_${type}_folder"; - $e->$meth($f) or return $e->die_event; - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.template.delete', - method => 'delete_template'); -sub delete_template { - my( $self, $conn, $auth, $templateId ) = @_; - my $e = new_rstore_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - - my $t = $e->retrieve_reporter_template($templateId) - or return $e->die_event; - return 0 if $t->owner ne $e->requestor->id; - $e->delete_reporter_template($t) or return $e->die_event; - $e->commit; - return 1; -} - - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.template.delete.cascade', - method => 'cascade_delete_template'); - -#__PACKAGE__->register_method( -# api_name => 'open-ils.reporter.template.delete.cascade.force', -# method => 'cascade_delete_template'); - -sub cascade_delete_template { - my( $self, $conn, $auth, $templateId ) = @_; - - my $e = new_rstore_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - - my $ret = cascade_delete_template_impl( - $e, $e->requestor->id, $templateId, ($self->api_name =~ /force/o) ); - return $ret if ref $ret; # some fatal event occurred - - $e->rollback if $ret == 0; - $e->commit if $ret > 0; - return $ret; -} - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.report.delete.cascade', - method => 'cascade_delete_report'); - -#__PACKAGE__->register_method( -# api_name => 'open-ils.reporter.report.delete.cascade.force', -# method => 'cascade_delete_report'); - -sub cascade_delete_report { - my( $self, $conn, $auth, $reportId ) = @_; - - my $e = new_rstore_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - - my $ret = cascade_delete_report_impl($e, $e->requestor->id, $reportId); - return $ret if ref $ret; # some fatal event occurred - - $e->rollback if $ret == 0; - $e->commit if $ret > 0; - return $ret; -} - - -# performs a cascading template delete -# returns 2 if all data was deleted -# returns 1 if some data was deleted -# returns 0 if no data was deleted -# returns event on error -sub cascade_delete_template_impl { - my( $e, $owner, $templateId ) = @_; - - # fetch the template to delete - my $template = $e->search_reporter_template( - {id=>$templateId, owner=>$owner})->[0] or return 0; - - # fetch he attached report IDs for this owner - my $reports = $e->search_reporter_report( - {template=>$templateId, owner=>$owner},{idlist=>1}); - - # delete the attached reports - my $all_rpts_deleted = 1; - for my $r (@$reports) { - my $evt = cascade_delete_report_impl($e, $owner, $r); - return $evt if ref $evt; - $all_rpts_deleted = 0 unless $evt == 2; - } - - # fetch all reports attached to this template that - # do not belong to $owner. If there are any, we can't - # delete the template - my $alt_reports = $e->search_reporter_report( - {template=>$templateId, owner=>{"!=" => $owner}},{idlist=>1}); - - # all_rpts_deleted will be false if a report has an - # attached scheduled owned by a different user - return 1 if @$alt_reports or not $all_rpts_deleted; - - $e->delete_reporter_template($template) - or return $e->die_event; - return 2; -} - -# performs a cascading report delete -# returns 2 if all data was deleted -# returns 1 if some data was deleted -# returns 0 if no data was deleted -# returns event on error -sub cascade_delete_report_impl { - my( $e, $owner, $reportId ) = @_; - - # fetch the report to delete - my $report = $e->search_reporter_report( - {id=>$reportId, owner=>$owner})->[0] or return 0; - - # fetch the attached schedule IDs for this owner - my $scheds = $e->search_reporter_schedule( - {report=>$reportId, runner=>$owner},{idlist=>1}); - - # delete the attached schedules - for my $sched (@$scheds) { - my $evt = delete_schedule_impl($e, $sched); - return $evt if $evt; - } - - # fetch all schedules attached to this report that - # do not belong to $owner. If there are any, we can't - # delete the report - my $alt_scheds = $e->search_reporter_schedule( - {report=>$reportId, runner=>{"!=" => $owner}},{idlist=>1}); - - return 1 if @$alt_scheds; - - $e->delete_reporter_report($report) - or return $e->die_event; - - return 2; -} - - -# deletes the requested schedule -# returns undef on success, event on error -sub delete_schedule_impl { - my( $e, $schedId ) = @_; - my $s = $e->retrieve_reporter_schedule($schedId) - or return $e->die_event; - $e->delete_reporter_schedule($s) or return $e->die_event; - return undef; -} - - - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.report.delete', - method => 'delete_report'); -sub delete_report { - my( $self, $conn, $auth, $reportId ) = @_; - my $e = new_rstore_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - - my $t = $e->retrieve_reporter_report($reportId) - or return $e->die_event; - return 0 if $t->owner ne $e->requestor->id; - $e->delete_reporter_report($t) or return $e->die_event; - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.schedule.delete', - method => 'delete_schedule'); -sub delete_schedule { - my( $self, $conn, $auth, $scheduleId ) = @_; - my $e = new_rstore_editor(authtoken=>$auth, xact=>1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - - my $t = $e->retrieve_reporter_schedule($scheduleId) - or return $e->die_event; - return 0 if $t->runner ne $e->requestor->id; - $e->delete_reporter_schedule($t) or return $e->die_event; - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.template_has_reports', - method => 'has_reports'); -sub has_reports { - my( $self, $conn, $auth, $templateId ) = @_; - my $e = new_rstore_editor(authtoken=>$auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - my $rpts = $e->search_reporter_report({template=>$templateId},{idlist=>1}); - return 1 if @$rpts; - return 0; -} - -__PACKAGE__->register_method( - api_name => 'open-ils.reporter.report_has_output', - method => 'has_output'); -sub has_output { - my( $self, $conn, $auth, $reportId ) = @_; - my $e = new_rstore_editor(authtoken=>$auth); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('RUN_REPORTS'); - my $outs = $e->search_reporter_schedule({report=>$reportId},{idlist=>1}); - return 1 if @$outs; - return 0; -} - - - -__PACKAGE__->register_method( - method => 'org_full_path', - api_name => 'open-ils.reporter.org_unit.full_path'); - -sub org_full_path { - my( $self, $conn, $orgid ) = @_; - return $U->storagereq( - 'open-ils.storage.actor.org_unit.full_path.atomic', $orgid ); -} - - - - -__PACKAGE__->register_method( - method => 'magic_fetch_all', - api_name => 'open-ils.reporter.magic_fetch'); -sub magic_fetch_all { - my( $self, $conn, $auth, $args ) = @_; - my $e = new_editor(authtoken => $auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('RUN_REPORTS'); - - my $hint = $$args{hint}; - my $org_col = $$args{org_column}; - my $orgs = $$args{org}; - -# if ($orgs && !$$args{no_fetch}) { -# ($orgs) = $self -# ->method_lookup( 'open-ils.reporter.org_unit.full_path' ) -# ->run( @$orgs ); -# $orgs = [ map {$_->id} @$orgs ]; -# } - - # Find the class the iplements the given hint - my ($class) = grep { - $Fieldmapper::fieldmap->{$_}{hint} eq $hint } Fieldmapper->classes; - - return undef unless $class->Selector; - - $class =~ s/Fieldmapper:://og; - $class =~ s/::/_/og; - - my $method; - my $margs; - - if( $org_col ) { - $method = "search_$class"; - $margs = { $org_col => $orgs }; - } else { - $method = "retrieve_all_$class"; - } - - $logger->info("reporter.magic_fetch => $method"); - - return $e->$method($margs); -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/ResolverResolver.pm b/Open-ILS/src/perlmods/OpenILS/Application/ResolverResolver.pm deleted file mode 100644 index 3463c1e9ef..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/ResolverResolver.pm +++ /dev/null @@ -1,304 +0,0 @@ -#!/usr/bin/perl - -# Copyright (C) 2009-2010 Dan Scott - -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. - -=head1 NAME - -OpenILS::Application::ResolverResolver - retrieves holdings from OpenURL resolvers - -=head1 SYNOPSIS - -Via srfsh: - request open-ils.resolver open-ils.resolver.resolve_holdings "issn", "0022-362X" -or: - request open-ils.resolver open-ils.resolver.resolve_holdings.raw "issn", "0022-362X" - -Via Perl: - my $session = OpenSRF::AppSession->create("open-ils.resolver"); - my $request = $session->request("open-ils.resolver.resolve_holdings", [ "issn", "0022-362X" ] )->gather(); - $session->disconnect(); - - # $request is a reference to the list of hashes - -=head1 DESCRIPTION - -OpenILS::Application::ResolverResolver caches responses from OpenURL resolvers -to requests for full-text holdings. Currently integration with SFX is supported. - -Each org_unit can specify a different base URL as the third argument to -resolve_holdings(). Eventually org_units will have org_unit settings to hold -their resolver type and base URL. - -=head1 AUTHOR - -Dan Scott, dscott@laurentian.ca - -=cut - -package OpenILS::Application::ResolverResolver; - -use strict; -use warnings; -use LWP::UserAgent; -use XML::LibXML; - -# All OpenSRF applications must be based on OpenSRF::Application or -# a subclass thereof. Makes sense, eh? -use OpenILS::Application; -use base qw/OpenILS::Application/; - -# This is the client class, used for connecting to open-ils.storage -use OpenSRF::AppSession; - -# This is an extension of Error.pm that supplies some error types to throw -use OpenSRF::EX qw(:try); - -# This is a helper class for querying the OpenSRF Settings application ... -use OpenSRF::Utils::SettingsClient; - -# ... and here we have the built in logging helper ... -use OpenSRF::Utils::Logger qw($logger); - -# ... and this manages cached results for us ... -use OpenSRF::Utils::Cache; - -# ... and this gives us access to the Fieldmapper -use OpenILS::Utils::Fieldmapper; - -my $prefix = "open-ils.resolver_"; # Prefix for caching values -my $cache; -my $cache_timeout; -my $default_url_base; # Default resolver location - -our ($ua, $parser); - - -sub initialize { - $cache = OpenSRF::Utils::Cache->new('global'); - my $sclient = OpenSRF::Utils::SettingsClient->new(); - $cache_timeout = $sclient->config_value( - "apps", "open-ils.resolver", "app_settings", "cache_timeout" ) || 300; - $default_url_base = $sclient->config_value( - "apps", "open-ils.resolver", "app_settings", "default_url_base"); -} - -sub child_init { - # We need a User Agent to speak to the SFX beast - $ua = new LWP::UserAgent; - $ua->agent('SameOrigin/1.0'); - - # SFX returns XML to us; let us parse - $parser = new XML::LibXML; -} - -sub resolve_holdings { - my $self = shift; - my $conn = shift; - my $id_type = shift; # keep it simple for now, either 'issn' or 'isbn' - my $id_value = shift; # the normalized ISSN or ISBN - my $url_base = shift || $default_url_base; - - # We'll use this in our cache key - my $method = $self->api_name; - - # We might want to return raw JSON for speedier responses - my $format = 'fieldmapper'; - if ($self->api_name =~ /raw$/) { - $format = 'raw'; - } - - # Big ugly SFX OpenURL request - my $url_args = '?url_ver=Z39.88-2004&url_ctx_fmt=infofi/fmt:kev:mtx:ctx&' - . 'ctx_enc=UTF-8&ctx_ver=Z39.88-2004&rfr_id=info:sid/conifer&' - . 'sfx.ignore_date_threshold=1&' - . 'sfx.response_type=multi_obj_detailed_xml&__service_type=getFullTxt'; - - if ($id_type eq 'issn') { - $url_args .= "&rft.issn=$id_value"; - } elsif ($id_type eq 'isbn') { - $url_args .= "&rft.isbn=$id_value"; - } - - my $ckey = $prefix . $method . $url_base . $id_type . $id_value; - - # Check the cache to see if we've already looked this up - # If we have, shortcut our return value - my $result = $cache->get_cache($ckey) || undef; - if ($result) { - $logger->info("Resolver found a cache hit"); - return $result; - } - - # Otherwise, let's go and grab the info from the SFX server - my $req = HTTP::Request->new('GET', "$url_base$url_args"); - - # Let's see what we we're trying to request - $logger->info("Resolving the following request: $url_base$url_args"); - - my $res = $ua->request($req); - - my $xml = $res->content; - my $parsed_sfx = $parser->parse_string($xml); - - my (@targets) = $parsed_sfx->findnodes('//target'); - - my @sfx_result; - foreach my $target (@targets) { - if ($format eq 'raw') { - push @sfx_result, { - public_name => $target->findvalue('./target_public_name'), - target_url => $target->findvalue('.//target_url'), - target_coverage => $target->findvalue('.//coverage_statement'), - target_embargo => $target->findvalue('.//embargo_statement'), - }; - } else { - my $rhr = Fieldmapper::resolver::holdings_record->new; - $rhr->public_name($target->findvalue('./target_public_name')); - $rhr->target_url($target->findvalue('.//target_url')); - $rhr->target_coverage($target->findvalue('.//coverage_statement')); - $rhr->target_embargo($target->findvalue('.//embargo_statement')); - push @sfx_result, $rhr; - } - } - - # Stuff this into the cache - $cache->put_cache($ckey, \@sfx_result, $cache_timeout); - - # Don't return the list unless it contains results - if (scalar(@sfx_result)) { - return \@sfx_result; - } - - return undef; -} - -__PACKAGE__->register_method( - method => 'resolve_holdings', - api_name => 'open-ils.resolver.resolve_holdings', - api_level => 1, - argc => 3, - signature => { - desc => <<" DESC", -Returns a list of "rhr" objects representing the full-text holdings for a given ISBN or ISSN - DESC - 'params' => [ { - name => 'id_type', - desc => 'The type of identifier ("issn" or "isbn")', - type => 'string' - }, { - name => 'id_value', - desc => 'The identifier value', - type => 'string' - }, { - name => 'url_base', - desc => 'The base URL for the resolver and instance', - type => 'string' - }, - ], - 'return' => { - desc => 'Returns a list of "rhr" objects representing the full-text holdings for a given ISBN or ISSN', - type => 'array' - } - } -); - -__PACKAGE__->register_method( - method => 'resolve_holdings', - api_name => 'open-ils.resolver.resolve_holdings.raw', - api_level => 1, - argc => 3, - signature => { - desc => <<" DESC", -Returns a list of raw JSON objects representing the full-text holdings for a given ISBN or ISSN - DESC - 'params' => [ { - name => 'id_type', - desc => 'The type of identifier ("issn" or "isbn")', - type => 'string' - }, { - name => 'id_value', - desc => 'The identifier value', - type => 'string' - }, { - name => 'url_base', - desc => 'The base URL for the resolver and instance', - type => 'string' - }, - ], - 'return' => { - desc => 'Returns a list of raw JSON objects representing the full-text holdings for a given ISBN or ISSN', - type => 'array' - } - } -); - -# Clear cache for specific lookups -sub delete_cached_holdings { - my $self = shift; - my $conn = shift; - my $id_type = shift; # keep it simple for now, either 'issn' or 'isbn' - my $id_value = shift; # the normalized ISSN or ISBN - my $url_base = shift || $default_url_base; - my @deleted_keys; - - $logger->warn("Deleting value [$id_value]"); - # We'll use this in our cache key - foreach my $method ('open-ils.resolver.resolve_holdings.raw', 'open-ils.resolver.resolve_holdings') { - my $ckey = $prefix . $method . $url_base . $id_type . $id_value; - - $logger->warn("Deleted cache key [$ckey]"); - my $result = $cache->delete_cache($ckey); - - $logger->warn("Result of deleting cache key: [$result]"); - push @deleted_keys, $result; - } - - return \@deleted_keys; -} - -__PACKAGE__->register_method( - method => 'delete_holdings_cache', - api_name => 'open-ils.resolver.delete_cached_holdings', - api_level => 1, - argc => 3, - signature => { - desc => <<" DESC", -Deletes the cached value of the full-text holdings for a given ISBN or ISSN - DESC - 'params' => [ { - name => 'id_type', - desc => 'The type of identifier ("issn" or "isbn")', - type => 'string' - }, { - name => 'id_value', - desc => 'The identifier value', - type => 'string' - }, { - name => 'url_base', - desc => 'The base URL for the resolver and instance', - type => 'string' - }, - ], - 'return' => { - desc => 'Deletes the cached value of the full-text holdings for a given ISBN or ISSN', - type => 'array' - } - } -); - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Search.pm b/Open-ILS/src/perlmods/OpenILS/Application/Search.pm deleted file mode 100644 index 6de6225a73..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Search.pm +++ /dev/null @@ -1,122 +0,0 @@ -package OpenILS::Application::Search; -use OpenILS::Application; -use base qw/OpenILS::Application/; -use strict; use warnings; -use OpenSRF::Utils::JSON; -use OpenSRF::Utils::Logger qw(:logger); - -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::ModsParser; -use OpenSRF::Utils::SettingsClient; -use OpenSRF::Utils::Cache; - -use OpenILS::Application::Search::Biblio; -use OpenILS::Application::Search::Authority; -use OpenILS::Application::Search::Z3950; -use OpenILS::Application::Search::Zips; -use OpenILS::Application::Search::CNBrowse; -use OpenILS::Application::Search::Serial; - - -use OpenILS::Application::AppUtils; - -use Time::HiRes qw(time); -use OpenSRF::EX qw(:try); - -use Text::Aspell; - -# Houses generic search utilites - -sub initialize { - OpenILS::Application::Search::Z3950->initialize(); - OpenILS::Application::Search::Zips->initialize(); - OpenILS::Application::Search::Biblio->initialize(); -} - -sub child_init { - OpenILS::Application::Search::Z3950->child_init; -} - - - -# ------------------------------------------------------------------ -# Create custom dictionaries like so: -# aspell --lang=en create master ./oils_authority.dict < /tmp/words -# where /tmp/words is a space separated list of words -# ------------------------------------------------------------------ - -__PACKAGE__->register_method( - method => "spellcheck", - api_name => "open-ils.search.spellcheck", - signature => { - desc => 'Returns alternate spelling suggestions', - param => [ - { - name => 'phrase', - desc => 'Word or phrase to return alternate spelling suggestions for', - type => 'string' - }, - { - name => 'Dictionary class', - desc => 'Alternate configured dictionary to use (optional)', - type => 'string' - }, - ], - return => { - desc => 'Array with a suggestions hash for each word in the phrase, like: ' - . q# [{ word: original_word, suggestions: [sug1, sug2, ...], found: 1 }, ... ] # - . 'The "found" value will be 1 if the word was found in the dictionary, 0 otherwise.', - type => 'array', - } - } -); - -my $speller = Text::Aspell->new(); - -sub spellcheck { - my( $self, $client, $phrase, $class ) = @_; - - return [] unless $phrase; # nothing to check, abort. - - my $conf = OpenSRF::Utils::SettingsClient->new; - $class ||= 'default'; - - my @conf_path = (apps => 'open-ils.search' => app_settings => spelling_dictionary => $class); - - if( my $dict = $conf->config_value(@conf_path) ) { - $speller->set_option('master', $dict); - $logger->debug("spelling dictionary set to $dict"); - } - - my @resp; - - for my $word (split(/\s+/,$phrase) ) { - - my @suggestions = $speller->suggest($word); - my @trimmed; - - for my $sug (@suggestions) { - - # suggestion matches alternate case of original word - next if lc($sug) eq lc($word); - - # suggestion matches alternate case of already suggested word - next if grep { lc($sug) eq lc($_) } @trimmed; - - push(@trimmed, $sug); - } - - push( @resp, - { - word => $word, - suggestions => (@trimmed) ? [@trimmed] : undef, - found => $speller->check($word) - } - ); - } - return \@resp; -} - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Search/AddedContent.pm b/Open-ILS/src/perlmods/OpenILS/Application/Search/AddedContent.pm deleted file mode 100644 index 0538deab8b..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Search/AddedContent.pm +++ /dev/null @@ -1,67 +0,0 @@ -package OpenILS::Application::Search::AddedContent; -use base qw/OpenILS::Application/; -use strict; use warnings; - -sub initialize { return 1; } - - -__PACKAGE__->register_method( - method => "summary", - api_name => "open-ils.search.added_content.summary.retrieve", - notes => <<" NOTE"); - Returns an object like so: - { - Review : true/false - Inventory : true/false - Annotation : true/false - Jacket : true/false - TOC : true/false - Product : true/false - } - This object indicates the existance of each type of added content for the given ISBN - PARAMS( ISBN ), - NOTE - -sub summary { - return { - Review => "false", - Inventory => "false", - Annotation => "false", - Jacket => "false", - TOC => "false", - Product => "false", - }; -} - - -__PACKAGE__->register_method( - method => "reviews", - api_name => "open-ils.search.added_content.review.retrieve.random", - notes => <<" NOTE"); - Returns a singe random review article object - PARAMS( ISBN ), - NOTE - -__PACKAGE__->register_method( - method => "reviews", - api_name => "open-ils.search.added_content.review.retrieve.all", - notes => <<" NOTE"); - Returns an array review article objects - PARAMS( ISBN ), - NOTE - -sub reviews { return []; } - - -__PACKAGE__->register_method( - method => "toc", - api_name => "open-ils.search.added_content.toc.retrieve", - notes => <<" NOTE"); - Returns the table of contents for the given ISBN - PARAMS( ISBN ), - NOTE - -sub toc { return ""; } - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Search/Authority.pm b/Open-ILS/src/perlmods/OpenILS/Application/Search/Authority.pm deleted file mode 100644 index 37bc763109..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Search/Authority.pm +++ /dev/null @@ -1,280 +0,0 @@ -package OpenILS::Application::Search::Authority; -use base qw/OpenILS::Application/; -use strict; use warnings; - -use OpenILS::Utils::Fieldmapper; -use OpenILS::Application::AppUtils; -use XML::LibXML; -use XML::LibXSLT; -use OpenILS::Utils::Editor q/:funcs/; -use OpenSRF::Utils::Logger qw/$logger/; - -use OpenSRF::Utils::JSON; - -use Time::HiRes qw(time); -use OpenSRF::EX qw(:try); -use Digest::MD5 qw(md5_hex); - -my $cache; - - -sub validate_authority { - my $self = shift; - my $client = shift; - - my $session = OpenSRF::AppSession->create("open-ils.storage"); - return $session->request( 'open-ils.storage.authority.validate.tag' => @_ )->gather(1); -} -__PACKAGE__->register_method( - method => "validate_authority", - api_name => "open-ils.search.authority.validate.tag", - argc => 4, - note => "Validates authority data from existing controlled terms", -); - -sub validate_authority_return_records_by_id { - my $self = shift; - my $client = shift; - - my $session = OpenSRF::AppSession->create("open-ils.storage"); - return $session->request( 'open-ils.storage.authority.validate.tag.id_list' => @_ )->gather(1); -} -__PACKAGE__->register_method( - method => "validate_authority_return_records_by_id", - api_name => "open-ils.search.authority.validate.tag.id_list", - argc => 4, - note => "Validates authority data from existing controlled terms", -); - -sub search_authority { - my $self = shift; - my $client = shift; - - my $session = OpenSRF::AppSession->create("open-ils.storage"); - return $session->request( 'open-ils.storage.authority.search.marc.atomic' => @_ )->gather(1); -} -__PACKAGE__->register_method( - method => "search_authority", - api_name => "open-ils.search.authority.fts", - argc => 2, - note => "Searches authority data for existing controlled terms and crossrefs", -); - - -sub crossref_authority { - my $self = shift; - my $client = shift; - my $class = shift; - my $term = shift; - my $limit = shift || 10; - - my $session = OpenSRF::AppSession->create("open-ils.storage"); - - # Avoid generating spurious errors for more granular indexes, like author|personal - $class =~ s/^(.*?)\|.*?$/$1/; - - $logger->info("authority xref search for $class=$term, limit=$limit"); - my $fr = $session->request( - "open-ils.storage.authority.$class.see_from.controlled.atomic",$term, $limit)->gather(1); - my $al = $session->request( - "open-ils.storage.authority.$class.see_also_from.controlled.atomic",$term, $limit)->gather(1); - - my $data = _auth_flatten( $term, $fr, $al, 1 ); - - return $data; -} - -sub _auth_flatten { - my $term = shift; - my $fr = shift; - my $al = shift; - my $limit = shift; - - my %hash = (); - for my $x (@$fr) { - my $string = $$x[0]; - for my $i (1..10) { - last unless ($$x[$i]); - if ($string =~ /\W$/o) { - $string .= ' '.$$x[$i]; - } else { - $string .= ' -- '.$$x[$i]; - } - } - next if (lc($string) eq lc($term)); - $hash{$string}++; - $hash{$string}++ if (lc($$x[0]) eq lc($term)); - } - my $from = [keys %hash]; #[ sort { $hash{$b} <=> $hash{$a} || $a cmp $b } keys %hash ]; - -# $from = [ @$from[0..4] ] if $limit; - - %hash = (); - for my $x (@$al) { - my $string = $$x[0]; - for my $i (1..10) { - last unless ($$x[$i]); - if ($string =~ /\W$/o) { - $string .= ' '.$$x[$i]; - } else { - $string .= ' -- '.$$x[$i]; - } - } - next if (lc($string) eq lc($term)); - $hash{$string}++; - $hash{$string}++ if (lc($$x[0]) eq lc($term)); - } - my $also = [keys %hash]; #[ sort { $hash{$b} <=> $hash{$a} || $a cmp $b } keys %hash ]; - -# $also = [ @$also[0..4] ] if $limit; - - #warn Dumper( { from => $from, also => $also } ); - - return { from => $from, also => $also }; -} - -__PACKAGE__->register_method( - method => "crossref_authority", - api_name => "open-ils.search.authority.crossref", - argc => 2, - note => "Searches authority data for existing controlled terms and crossrefs", -); - -__PACKAGE__->register_method( - #method => "new_crossref_authority_batch", - method => "crossref_authority_batch2", - api_name => "open-ils.search.authority.crossref.batch", - argc => 1, - note => <<" NOTE"); - Takes an array of class,term pair sub-arrays and performs an authority lookup for each - - PARAMS( [ ["subject", "earth"], ["author","shakespeare"] ] ); - - Returns an object like so: - { - "classname" : { - "term" : { "from" : [ ...], "also" : [...] } - "term2" : { "from" : [ ...], "also" : [...] } - } - } - NOTE - -sub new_crossref_authority_batch { - my( $self, $client, $reqs ) = @_; - - my $response = {}; - my $lastr = []; - my $session = OpenSRF::AppSession->create("open-ils.storage"); - - for my $req (@$reqs) { - - my $class = $req->[0]; - my $term = $req->[1]; - next unless $class and $term; - $logger->info("Sending authority request for $class : $term"); - my $fr = $session->request("open-ils.storage.authority.$class.see_from.controlled.atomic",$term, 10)->gather(1); - my $al = $session->request("open-ils.storage.authority.$class.see_also_from.controlled.atomic",$term, 10)->gather(1); - - $response->{$class} = {} unless exists $response->{$class}; - $response->{$class}->{$term} = _auth_flatten( $term, $fr, $al, 1 ); - - } - - #warn Dumper( $response ); - return $response; -} - -sub crossref_authority_batch { - my( $self, $client, $reqs ) = @_; - - my $response = {}; - my $lastr = []; - my $session = OpenSRF::AppSession->create("open-ils.storage"); - - for my $req (@$reqs) { - - my $class = $req->[0]; - my $term = $req->[1]; - next unless $class and $term; - $logger->info("Sending authority request for $class : $term"); - my $freq = $session->request("open-ils.storage.authority.$class.see_from.controlled.atomic",$term, 10); - my $areq = $session->request("open-ils.storage.authority.$class.see_also_from.controlled.atomic",$term, 10); - - if( $lastr->[0] ) { #process old data while waiting on new data - my $cls = $lastr->[0]; - my $trm = $lastr->[1]; - my $fr = $lastr->[2]; - my $al = $lastr->[3]; - $response->{$cls} = {} unless exists $response->{$cls}; - $response->{$cls}->{$trm} = _auth_flatten( $trm, $fr, $al, 1 ); - } - - $lastr->[0] = $class; - $lastr->[1] = $term; - $lastr->[2] = $freq->gather(1); - $lastr->[3] = $areq->gather(1); - } - - if( $lastr->[0] ) { #process old data while waiting on new data - my $cls = $lastr->[0]; - my $trm = $lastr->[1]; - my $fr = $lastr->[2]; - my $al = $lastr->[3]; - $response->{$cls} = {} unless exists $response->{$cls}; - $response->{$cls}->{$trm} = _auth_flatten( $trm, $fr, $al, 1); - } - - return $response; -} - - - - -sub crossref_authority_batch2 { - my( $self, $client, $reqs ) = @_; - - my $response = {}; - my $lastr = []; - my $session = OpenSRF::AppSession->create("open-ils.storage"); - - $cache = OpenSRF::Utils::Cache->new('global') unless $cache; - - for my $req (@$reqs) { - - my $class = $req->[0]; - my $term = $req->[1]; - next unless $class and $term; - - my $t = $term; - $t =~ s/\s//og; - my $cdata = $cache->get_cache("oils_authority_${class}_$t"); - - if( $cdata ) { - $logger->debug("returning authority response from cache.."); - $response->{$class} = {} unless exists $response->{$class}; - $response->{$class}->{$term} = $cdata; - next; - } - - $logger->debug("authority data not found in cache.. fetching from storage"); - - $logger->info("Sending authority request for $class : $term"); - my $freq = $session->request("open-ils.storage.authority.$class.see_from.controlled.atomic",$term, 10); - my $areq = $session->request("open-ils.storage.authority.$class.see_also_from.controlled.atomic",$term, 10); - my $fr = $freq->gather(1); - my $al = $areq->gather(1); - $response->{$class} = {} unless exists $response->{$class}; - my $auth = _auth_flatten( $term, $fr, $al, 1 ); - - my $timeout = 7200; #two hours - $timeout = 300 if @{$auth->{from}} or @{$auth->{also}}; # 5 minutes - $response->{$class}->{$term} = $auth; - $logger->debug("adding authority lookup to cache with timeout $timeout"); - $cache->put_cache("oils_authority_${class}_$t", $auth, $timeout); - } - return $response; -} - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Search/Biblio.pm b/Open-ILS/src/perlmods/OpenILS/Application/Search/Biblio.pm deleted file mode 100644 index 96ca5d2f3e..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Search/Biblio.pm +++ /dev/null @@ -1,2429 +0,0 @@ -package OpenILS::Application::Search::Biblio; -use base qw/OpenILS::Application/; -use strict; use warnings; - - -use OpenSRF::Utils::JSON; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::ModsParser; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenSRF::Utils::Cache; -use Encode; - -use OpenSRF::Utils::Logger qw/:logger/; - - -use OpenSRF::Utils::JSON; - -use Time::HiRes qw(time); -use OpenSRF::EX qw(:try); -use Digest::MD5 qw(md5_hex); - -use XML::LibXML; -use XML::LibXSLT; - -use Data::Dumper; -$Data::Dumper::Indent = 0; - -use OpenILS::Const qw/:const/; - -use OpenILS::Application::AppUtils; -my $apputils = "OpenILS::Application::AppUtils"; -my $U = $apputils; - -my $pfx = "open-ils.search_"; - -my $cache; -my $cache_timeout; -my $superpage_size; -my $max_superpages; - -sub initialize { - $cache = OpenSRF::Utils::Cache->new('global'); - my $sclient = OpenSRF::Utils::SettingsClient->new(); - $cache_timeout = $sclient->config_value( - "apps", "open-ils.search", "app_settings", "cache_timeout" ) || 300; - - $superpage_size = $sclient->config_value( - "apps", "open-ils.search", "app_settings", "superpage_size" ) || 500; - - $max_superpages = $sclient->config_value( - "apps", "open-ils.search", "app_settings", "max_superpages" ) || 20; - - $logger->info("Search cache timeout is $cache_timeout, ". - " superpage_size is $superpage_size, max_superpages is $max_superpages"); -} - - - -# --------------------------------------------------------------------------- -# takes a list of record id's and turns the docs into friendly -# mods structures. Creates one MODS structure for each doc id. -# --------------------------------------------------------------------------- -sub _records_to_mods { - my @ids = @_; - - my @results; - my @marcxml_objs; - - my $session = OpenSRF::AppSession->create("open-ils.cstore"); - my $request = $session->request( - "open-ils.cstore.direct.biblio.record_entry.search", { id => \@ids } ); - - while( my $resp = $request->recv ) { - my $content = $resp->content; - next if $content->id == OILS_PRECAT_RECORD; - my $u = OpenILS::Utils::ModsParser->new(); # FIXME: we really need a new parser for each object? - $u->start_mods_batch( $content->marc ); - my $mods = $u->finish_mods_batch(); - $mods->doc_id($content->id()); - $mods->tcn($content->tcn_value); - push @results, $mods; - } - - $session->disconnect(); - return \@results; -} - -__PACKAGE__->register_method( - method => "record_id_to_mods", - api_name => "open-ils.search.biblio.record.mods.retrieve", - argc => 1, - signature => { - desc => "Provide ID, we provide the MODS object with copy count. " - . "Note: this method does NOT take an array of IDs like mods_slim.retrieve", # FIXME: do it here too - params => [ - { desc => 'Record ID', type => 'number' } - ], - return => { - desc => 'MODS object', type => 'object' - } - } -); - -# converts a record into a mods object with copy counts attached -sub record_id_to_mods { - - my( $self, $client, $org_id, $id ) = @_; - - my $mods_list = _records_to_mods( $id ); - my $mods_obj = $mods_list->[0]; - my $cmethod = $self->method_lookup("open-ils.search.biblio.record.copy_count"); - my ($count) = $cmethod->run($org_id, $id); - $mods_obj->copy_count($count); - - return $mods_obj; -} - - - -__PACKAGE__->register_method( - method => "record_id_to_mods_slim", - api_name => "open-ils.search.biblio.record.mods_slim.retrieve", - argc => 1, - authoritative => 1, - signature => { - desc => "Provide ID(s), we provide the MODS", - params => [ - { desc => 'Record ID or array of IDs' } - ], - return => { - desc => 'MODS object(s), event on error' - } - } -); - -# converts a record into a mods object with NO copy counts attached -sub record_id_to_mods_slim { - my( $self, $client, $id ) = @_; - return undef unless defined $id; - - if(ref($id) and ref($id) == 'ARRAY') { - return _records_to_mods( @$id ); - } - my $mods_list = _records_to_mods( $id ); - my $mods_obj = $mods_list->[0]; - return OpenILS::Event->new('BIBLIO_RECORD_ENTRY_NOT_FOUND') unless $mods_obj; - return $mods_obj; -} - - - -__PACKAGE__->register_method( - method => "record_id_to_mods_slim_batch", - api_name => "open-ils.search.biblio.record.mods_slim.batch.retrieve", - stream => 1 -); -sub record_id_to_mods_slim_batch { - my($self, $conn, $id_list) = @_; - $conn->respond(_records_to_mods($_)->[0]) for @$id_list; - return undef; -} - - -# Returns the number of copies attached to a record based on org location -__PACKAGE__->register_method( - method => "record_id_to_copy_count", - api_name => "open-ils.search.biblio.record.copy_count", - signature => { - desc => q/Returns a copy summary for the given record for the context org - unit and all ancestor org units/, - params => [ - {desc => 'Context org unit id', type => 'number'}, - {desc => 'Record ID', type => 'number'} - ], - return => { - desc => q/summary object per org unit in the set, where the set - includes the context org unit and all parent org units. - Object includes the keys "transcendant", "count", "org_unit", "depth", - "unshadow", "available". Each is a count, except "org_unit" which is - the context org unit and "depth" which is the depth of the context org unit - /, - type => 'array' - } - } -); - -__PACKAGE__->register_method( - method => "record_id_to_copy_count", - api_name => "open-ils.search.biblio.record.copy_count.staff", - authoritative => 1, - signature => { - desc => q/Returns a copy summary for the given record for the context org - unit and all ancestor org units/, - params => [ - {desc => 'Context org unit id', type => 'number'}, - {desc => 'Record ID', type => 'number'} - ], - return => { - desc => q/summary object per org unit in the set, where the set - includes the context org unit and all parent org units. - Object includes the keys "transcendant", "count", "org_unit", "depth", - "unshadow", "available". Each is a count, except "org_unit" which is - the context org unit and "depth" which is the depth of the context org unit - /, - type => 'array' - } - } -); - -__PACKAGE__->register_method( - method => "record_id_to_copy_count", - api_name => "open-ils.search.biblio.metarecord.copy_count", - signature => { - desc => q/Returns a copy summary for the given record for the context org - unit and all ancestor org units/, - params => [ - {desc => 'Context org unit id', type => 'number'}, - {desc => 'Record ID', type => 'number'} - ], - return => { - desc => q/summary object per org unit in the set, where the set - includes the context org unit and all parent org units. - Object includes the keys "transcendant", "count", "org_unit", "depth", - "unshadow", "available". Each is a count, except "org_unit" which is - the context org unit and "depth" which is the depth of the context org unit - /, - type => 'array' - } - } -); - -__PACKAGE__->register_method( - method => "record_id_to_copy_count", - api_name => "open-ils.search.biblio.metarecord.copy_count.staff", - signature => { - desc => q/Returns a copy summary for the given record for the context org - unit and all ancestor org units/, - params => [ - {desc => 'Context org unit id', type => 'number'}, - {desc => 'Record ID', type => 'number'} - ], - return => { - desc => q/summary object per org unit in the set, where the set - includes the context org unit and all parent org units. - Object includes the keys "transcendant", "count", "org_unit", "depth", - "unshadow", "available". Each is a count, except "org_unit" which is - the context org unit and "depth" which is the depth of the context org - unit. "depth" is always -1 when the count from a lasso search is - performed, since depth doesn't mean anything in a lasso context. - /, - type => 'array' - } - } -); - -sub record_id_to_copy_count { - my( $self, $client, $org_id, $record_id ) = @_; - - return [] unless $record_id; - - my $key = $self->api_name =~ /metarecord/ ? 'metarecord' : 'record'; - my $staff = $self->api_name =~ /staff/ ? 't' : 'f'; - - my $data = $U->cstorereq( - "open-ils.cstore.json_query.atomic", - { from => ['asset.' . $key . '_copy_count' => $org_id => $record_id => $staff] } - ); - - my @count; - for my $d ( @$data ) { # fix up the key name change required by stored-proc version - $$d{count} = delete $$d{visible}; - push @count, $d; - } - - return [ sort { $a->{depth} <=> $b->{depth} } @count ]; -} - - -__PACKAGE__->register_method( - method => "biblio_search_tcn", - api_name => "open-ils.search.biblio.tcn", - argc => 1, - signature => { - desc => "Retrieve related record ID(s) given a TCN", - params => [ - { desc => 'TCN', type => 'string' }, - { desc => 'Flag indicating to include deleted records', type => 'string' } - ], - return => { - desc => 'Results object like: { "count": $i, "ids": [...] }', - type => 'object' - } - } - -); - -sub biblio_search_tcn { - - my( $self, $client, $tcn, $include_deleted ) = @_; - - $tcn =~ s/^\s+|\s+$//og; - - my $e = new_editor(); - my $search = {tcn_value => $tcn}; - $search->{deleted} = 'f' unless $include_deleted; - my $recs = $e->search_biblio_record_entry( $search, {idlist =>1} ); - - return { count => scalar(@$recs), ids => $recs }; -} - - -# -------------------------------------------------------------------------------- - -__PACKAGE__->register_method( - method => "biblio_barcode_to_copy", - api_name => "open-ils.search.asset.copy.find_by_barcode", -); -sub biblio_barcode_to_copy { - my( $self, $client, $barcode ) = @_; - my( $copy, $evt ) = $U->fetch_copy_by_barcode($barcode); - return $evt if $evt; - return $copy; -} - -__PACKAGE__->register_method( - method => "biblio_id_to_copy", - api_name => "open-ils.search.asset.copy.batch.retrieve", -); -sub biblio_id_to_copy { - my( $self, $client, $ids ) = @_; - $logger->info("Fetching copies @$ids"); - return $U->cstorereq( - "open-ils.cstore.direct.asset.copy.search.atomic", { id => $ids } ); -} - - -__PACKAGE__->register_method( - method => "biblio_id_to_uris", - api_name=> "open-ils.search.asset.uri.retrieve_by_bib", - argc => 2, - stream => 1, - signature => q# - @param BibID Which bib record contains the URIs - @param OrgID Where to look for URIs - @param OrgDepth Range adjustment for OrgID - @return A stream or list of 'auri' objects - # - -); -sub biblio_id_to_uris { - my( $self, $client, $bib, $org, $depth ) = @_; - die "Org ID required" unless defined($org); - die "Bib ID required" unless defined($bib); - - my @params; - push @params, $depth if (defined $depth); - - my $ids = $U->cstorereq( "open-ils.cstore.json_query.atomic", - { select => { auri => [ 'id' ] }, - from => { - acn => { - auricnm => { - field => 'call_number', - fkey => 'id', - join => { - auri => { - field => 'id', - fkey => 'uri', - filter => { active => 't' } - } - } - } - } - }, - where => { - '+acn' => { - record => $bib, - owning_lib => { - in => { - select => { aou => [ { column => 'id', transform => 'actor.org_unit_descendants', params => \@params, result_field => 'id' } ] }, - from => 'aou', - where => { id => $org }, - distinct=> 1 - } - } - } - }, - distinct=> 1, - } - ); - - my $uris = $U->cstorereq( - "open-ils.cstore.direct.asset.uri.search.atomic", - { id => [ map { (values %$_) } @$ids ] } - ); - - $client->respond($_) for (@$uris); - - return undef; -} - - -__PACKAGE__->register_method( - method => "copy_retrieve", - api_name => "open-ils.search.asset.copy.retrieve", - argc => 1, - signature => { - desc => 'Retrieve a copy object based on the Copy ID', - params => [ - { desc => 'Copy ID', type => 'number'} - ], - return => { - desc => 'Copy object, event on error' - } - } -); - -sub copy_retrieve { - my( $self, $client, $cid ) = @_; - my( $copy, $evt ) = $U->fetch_copy($cid); - return $evt || $copy; -} - -__PACKAGE__->register_method( - method => "volume_retrieve", - api_name => "open-ils.search.asset.call_number.retrieve" -); -sub volume_retrieve { - my( $self, $client, $vid ) = @_; - my $e = new_editor(); - my $vol = $e->retrieve_asset_call_number($vid) or return $e->event; - return $vol; -} - -__PACKAGE__->register_method( - method => "fleshed_copy_retrieve_batch", - api_name => "open-ils.search.asset.copy.fleshed.batch.retrieve", - authoritative => 1, -); - -sub fleshed_copy_retrieve_batch { - my( $self, $client, $ids ) = @_; - $logger->info("Fetching fleshed copies @$ids"); - return $U->cstorereq( - "open-ils.cstore.direct.asset.copy.search.atomic", - { id => $ids }, - { flesh => 1, - flesh_fields => { acp => [ qw/ circ_lib location status stat_cat_entries / ] } - }); -} - - -__PACKAGE__->register_method( - method => "fleshed_copy_retrieve", - api_name => "open-ils.search.asset.copy.fleshed.retrieve", -); - -sub fleshed_copy_retrieve { - my( $self, $client, $id ) = @_; - my( $c, $e) = $U->fetch_fleshed_copy($id); - return $e || $c; -} - - -__PACKAGE__->register_method( - method => 'fleshed_by_barcode', - api_name => "open-ils.search.asset.copy.fleshed2.find_by_barcode", - authoritative => 1, -); -sub fleshed_by_barcode { - my( $self, $conn, $barcode ) = @_; - my $e = new_editor(); - my $copyid = $e->search_asset_copy( - {barcode => $barcode, deleted => 'f'}, {idlist=>1})->[0] - or return $e->event; - return fleshed_copy_retrieve2( $self, $conn, $copyid); -} - - -__PACKAGE__->register_method( - method => "fleshed_copy_retrieve2", - api_name => "open-ils.search.asset.copy.fleshed2.retrieve", - authoritative => 1, -); - -sub fleshed_copy_retrieve2 { - my( $self, $client, $id ) = @_; - my $e = new_editor(); - my $copy = $e->retrieve_asset_copy( - [ - $id, - { - flesh => 2, - flesh_fields => { - acp => [ - qw/ location status stat_cat_entry_copy_maps notes age_protect / - ], - ascecm => [qw/ stat_cat stat_cat_entry /], - } - } - ] - ) or return $e->event; - - # For backwards compatibility - #$copy->stat_cat_entries($copy->stat_cat_entry_copy_maps); - - if( $copy->status->id == OILS_COPY_STATUS_CHECKED_OUT ) { - $copy->circulations( - $e->search_action_circulation( - [ - { target_copy => $copy->id }, - { - order_by => { circ => 'xact_start desc' }, - limit => 1 - } - ] - ) - ); - } - - return $copy; -} - - -__PACKAGE__->register_method( - method => 'flesh_copy_custom', - api_name => 'open-ils.search.asset.copy.fleshed.custom', - authoritative => 1, -); - -sub flesh_copy_custom { - my( $self, $conn, $copyid, $fields ) = @_; - my $e = new_editor(); - my $copy = $e->retrieve_asset_copy( - [ - $copyid, - { - flesh => 1, - flesh_fields => { - acp => $fields, - } - } - ] - ) or return $e->event; - return $copy; -} - - -__PACKAGE__->register_method( - method => "biblio_barcode_to_title", - api_name => "open-ils.search.biblio.find_by_barcode", -); - -sub biblio_barcode_to_title { - my( $self, $client, $barcode ) = @_; - - my $title = $apputils->simple_scalar_request( - "open-ils.storage", - "open-ils.storage.biblio.record_entry.retrieve_by_barcode", $barcode ); - - return { ids => [ $title->id ], count => 1 } if $title; - return { count => 0 }; -} - -__PACKAGE__->register_method( - method => 'title_id_by_item_barcode', - api_name => 'open-ils.search.bib_id.by_barcode', - authoritative => 1, - signature => { - desc => 'Retrieve copy object with fleshed record, given the barcode', - params => [ - { desc => 'Item barcode', type => 'string' } - ], - return => { - desc => 'Asset copy object with fleshed record and callnumber, or event on error or null set' - } - } -); - -sub title_id_by_item_barcode { - my( $self, $conn, $barcode ) = @_; - my $e = new_editor(); - my $copies = $e->search_asset_copy( - [ - { deleted => 'f', barcode => $barcode }, - { - flesh => 2, - flesh_fields => { - acp => [ 'call_number' ], - acn => [ 'record' ] - } - } - ] - ); - - return $e->event unless @$copies; - return $$copies[0]->call_number->record->id; -} - - -__PACKAGE__->register_method( - method => "biblio_copy_to_mods", - api_name => "open-ils.search.biblio.copy.mods.retrieve", -); - -# takes a copy object and returns it fleshed mods object -sub biblio_copy_to_mods { - my( $self, $client, $copy ) = @_; - - my $volume = $U->cstorereq( - "open-ils.cstore.direct.asset.call_number.retrieve", - $copy->call_number() ); - - my $mods = _records_to_mods($volume->record()); - $mods = shift @$mods; - $volume->copies([$copy]); - push @{$mods->call_numbers()}, $volume; - - return $mods; -} - - -=head1 NAME - -OpenILS::Application::Search::Biblio - -=head1 DESCRIPTION - -=head2 API METHODS - -=head3 open-ils.search.biblio.multiclass.query (arghash, query, docache) - -For arghash and docache, see B. - -The query argument is a string, but built like a hash with key: value pairs. -Recognized search keys include: - - keyword (kw) - search keyword(s) * - author (au) - search author(s) * - name (au) - same as author * - title (ti) - search title * - subject (su) - search subject * - series (se) - search series * - lang - limit by language (specifiy multiple langs with lang:l1 lang:l2 ...) - site - search at specified org unit, corresponds to actor.org_unit.shortname - sort - sort type (title, author, pubdate) - dir - sort direction (asc, desc) - available - if set to anything other than "false" or "0", limits to available items - -* Searching keyword, author, title, subject, and series supports additional search -subclasses, specified with a "|". For example, C. - -For more, see B. - -=cut - -foreach (qw/open-ils.search.biblio.multiclass.query - open-ils.search.biblio.multiclass.query.staff - open-ils.search.metabib.multiclass.query - open-ils.search.metabib.multiclass.query.staff/) -{ -__PACKAGE__->register_method( - api_name => $_, - method => 'multiclass_query', - signature => { - desc => 'Perform a search query. The .staff version of the call includes otherwise hidden hits.', - params => [ - {name => 'arghash', desc => 'Arg hash (see open-ils.search.biblio.multiclass)', type => 'object'}, - {name => 'query', desc => 'Raw human-readable query (see perldoc '. __PACKAGE__ .')', type => 'string'}, - {name => 'docache', desc => 'Flag for caching (see open-ils.search.biblio.multiclass)', type => 'object'}, - ], - return => { - desc => 'Search results from query, like: { "count" : $count, "ids" : [ [ $id, $relevancy, $total ], ...] }', - type => 'object', # TODO: update as miker's new elements are included - } - } -); -} - -sub multiclass_query { - my($self, $conn, $arghash, $query, $docache) = @_; - - $logger->debug("initial search query => $query"); - my $orig_query = $query; - - $query =~ s/\+/ /go; - $query =~ s/'/ /go; - $query =~ s/^\s+//go; - - # convert convenience classes (e.g. kw for keyword) to the full class name - # ensure that the convenience class isn't part of a word (e.g. 'playhouse') - $query =~ s/(^|\s)kw(:|\|)/$1keyword$2/go; - $query =~ s/(^|\s)ti(:|\|)/$1title$2/go; - $query =~ s/(^|\s)au(:|\|)/$1author$2/go; - $query =~ s/(^|\s)su(:|\|)/$1subject$2/go; - $query =~ s/(^|\s)se(:|\|)/$1series$2/go; - $query =~ s/(^|\s)name(:|\|)/$1author$2/og; - - $logger->debug("cleansed query string => $query"); - my $search = {}; - - my $simple_class_re = qr/((?:\w+(?:\|\w+)?):[^:]+?)$/; - my $class_list_re = qr/(?:keyword|title|author|subject|series)/; - my $modifier_list_re = qr/(?:site|dir|sort|lang|available)/; - - my $tmp_value = ''; - while ($query =~ s/$simple_class_re//so) { - - my $qpart = $1; - my $where = index($qpart,':'); - my $type = substr($qpart, 0, $where++); - my $value = substr($qpart, $where); - - if ($type !~ /^(?:$class_list_re|$modifier_list_re)/o) { - $tmp_value = "$qpart $tmp_value"; - next; - } - - if ($type =~ /$class_list_re/o ) { - $value .= $tmp_value; - $tmp_value = ''; - } - - next unless $type and $value; - - $value =~ s/^\s*//og; - $value =~ s/\s*$//og; - $type = 'sort_dir' if $type eq 'dir'; - - if($type eq 'site') { - # 'site' is the org shortname. when using this, we also want - # to search at the requested org's depth - my $e = new_editor(); - if(my $org = $e->search_actor_org_unit({shortname => $value})->[0]) { - $arghash->{org_unit} = $org->id if $org; - $arghash->{depth} = $e->retrieve_actor_org_unit_type($org->ou_type)->depth; - } else { - $logger->warn("'site:' query used on invalid org shortname: $value ... ignoring"); - } - - } elsif($type eq 'available') { - # limit to available - $arghash->{available} = 1 unless $value eq 'false' or $value eq '0'; - - } elsif($type eq 'lang') { - # collect languages into an array of languages - $arghash->{language} = [] unless $arghash->{language}; - push(@{$arghash->{language}}, $value); - - } elsif($type =~ /^sort/o) { - # sort and sort_dir modifiers - $arghash->{$type} = $value; - - } else { - # append the search term to the term under construction - $search->{$type} = {} unless $search->{$type}; - $search->{$type}->{term} = - ($search->{$type}->{term}) ? $search->{$type}->{term} . " $value" : $value; - } - } - - $query .= " $tmp_value"; - $query =~ s/\s+/ /go; - $query =~ s/^\s+//go; - $query =~ s/\s+$//go; - - my $type = $arghash->{default_class} || 'keyword'; - $type = ($type eq '-') ? 'keyword' : $type; - $type = ($type !~ /^(title|author|keyword|subject|series)(?:\|\w+)?$/o) ? 'keyword' : $type; - - if($query) { - # This is the front part of the string before any special tokens were - # parsed OR colon-separated strings that do not denote a class. - # Add this data to the default search class - $search->{$type} = {} unless $search->{$type}; - $search->{$type}->{term} = - ($search->{$type}->{term}) ? $search->{$type}->{term} . " $query" : $query; - } - my $real_search = $arghash->{searches} = { $type => { term => $orig_query } }; - - # capture the original limit because the search method alters the limit internally - my $ol = $arghash->{limit}; - - my $sclient = OpenSRF::Utils::SettingsClient->new; - - (my $method = $self->api_name) =~ s/\.query//o; - - $method =~ s/multiclass/multiclass.staged/ - if $sclient->config_value(apps => 'open-ils.search', - app_settings => 'use_staged_search') =~ /true/i; - - # XXX This stops the session locale from doing the right thing. - # XXX Revisit this and have it translate to a lang instead of a locale. - #$arghash->{preferred_language} = $U->get_org_locale($arghash->{org_unit}) - # unless $arghash->{preferred_language}; - - $method = $self->method_lookup($method); - my ($data) = $method->run($arghash, $docache); - - $arghash->{searches} = $search if (!$data->{complex_query}); - - $arghash->{limit} = $ol if $ol; - $data->{compiled_search} = $arghash; - $data->{query} = $orig_query; - - $logger->info("compiled search is " . OpenSRF::Utils::JSON->perl2JSON($arghash)); - - return $data; -} - -__PACKAGE__->register_method( - method => 'cat_search_z_style_wrapper', - api_name => 'open-ils.search.biblio.zstyle', - stream => 1, - signature => q/@see open-ils.search.biblio.multiclass/ -); - -__PACKAGE__->register_method( - method => 'cat_search_z_style_wrapper', - api_name => 'open-ils.search.biblio.zstyle.staff', - stream => 1, - signature => q/@see open-ils.search.biblio.multiclass/ -); - -sub cat_search_z_style_wrapper { - my $self = shift; - my $client = shift; - my $authtoken = shift; - my $args = shift; - - my $cstore = OpenSRF::AppSession->connect('open-ils.cstore'); - - my $ou = $cstore->request( - 'open-ils.cstore.direct.actor.org_unit.search', - { parent_ou => undef } - )->gather(1); - - my $result = { service => 'native-evergreen-catalog', records => [] }; - my $searchhash = { limit => $$args{limit}, offset => $$args{offset}, org_unit => $ou->id }; - - $$searchhash{searches}{title}{term} = $$args{search}{title} if $$args{search}{title}; - $$searchhash{searches}{author}{term} = $$args{search}{author} if $$args{search}{author}; - $$searchhash{searches}{subject}{term} = $$args{search}{subject} if $$args{search}{subject}; - $$searchhash{searches}{keyword}{term} = $$args{search}{keyword} if $$args{search}{keyword}; - - $$searchhash{searches}{keyword}{term} .= join ' ', $$searchhash{searches}{keyword}{term}, $$args{search}{tcn} if $$args{search}{tcn}; - $$searchhash{searches}{keyword}{term} .= join ' ', $$searchhash{searches}{keyword}{term}, $$args{search}{isbn} if $$args{search}{isbn}; - $$searchhash{searches}{keyword}{term} .= join ' ', $$searchhash{searches}{keyword}{term}, $$args{search}{issn} if $$args{search}{issn}; - $$searchhash{searches}{keyword}{term} .= join ' ', $$searchhash{searches}{keyword}{term}, $$args{search}{publisher} if $$args{search}{publisher}; - $$searchhash{searches}{keyword}{term} .= join ' ', $$searchhash{searches}{keyword}{term}, $$args{search}{pubdate} if $$args{search}{pubdate}; - $$searchhash{searches}{keyword}{term} .= join ' ', $$searchhash{searches}{keyword}{term}, $$args{search}{item_type} if $$args{search}{item_type}; - - my $list = the_quest_for_knowledge( $self, $client, $searchhash ); - - if ($list->{count} > 0) { - $result->{count} = $list->{count}; - - my $records = $cstore->request( - 'open-ils.cstore.direct.biblio.record_entry.search.atomic', - { id => [ map { ( $_->[0] ) } @{$list->{ids}} ] } - )->gather(1); - - for my $rec ( @$records ) { - - my $u = OpenILS::Utils::ModsParser->new(); - $u->start_mods_batch( $rec->marc ); - my $mods = $u->finish_mods_batch(); - - push @{ $result->{records} }, { mvr => $mods, marcxml => $rec->marc, bibid => $rec->id }; - - } - - } - - $cstore->disconnect(); - return $result; -} - -# ---------------------------------------------------------------------------- -# These are the main OPAC search methods -# ---------------------------------------------------------------------------- - -__PACKAGE__->register_method( - method => 'the_quest_for_knowledge', - api_name => 'open-ils.search.biblio.multiclass', - signature => { - desc => "Performs a multi class biblio or metabib search", - params => [ - { - desc => "A search hash with keys: " - . "searches, org_unit, depth, limit, offset, format, sort, sort_dir. " - . "See perldoc " . __PACKAGE__ . " for more detail", - type => 'object', - }, - { - desc => "A flag to enable/disable searching and saving results in cache (default OFF)", - type => 'string', - } - ], - return => { - desc => 'An object of the form: ' - . '{ "count" : $count, "ids" : [ [ $id, $relevancy, $total ], ...] }', - } - } -); - -=head3 open-ils.search.biblio.multiclass (search-hash, docache) - -The search-hash argument can have the following elements: - - searches: { "$class" : "$value", ...} [REQUIRED] - org_unit: The org id to focus the search at - depth : The org depth - limit : The search limit default: 10 - offset : The search offset default: 0 - format : The MARC format - sort : What field to sort the results on? [ author | title | pubdate ] - sort_dir: What direction do we sort? [ asc | desc ] - tag_circulated_records : Boolean, if true, records that are in the user's visible checkout history - will be tagged with an additional value ("1") as the last value in the record ID array for - each record. Requires the 'authtoken' - authtoken : Authentication token string; When actions are performed that require a user login - (e.g. tagging circulated records), the authentication token is required - -The searches element is required, must have a hashref value, and the hashref must contain at least one -of the following classes as a key: - - title - author - subject - series - keyword - -The value paired with a key is the associated search string. - -The docache argument enables/disables searching and saving results in cache (default OFF). - -The return object, if successful, will look like: - - { "count" : $count, "ids" : [ [ $id, $relevancy, $total ], ...] } - -=cut - -__PACKAGE__->register_method( - method => 'the_quest_for_knowledge', - api_name => 'open-ils.search.biblio.multiclass.staff', - signature => q/The .staff search includes hidden bibs, hidden items and bibs with no items. Otherwise, @see open-ils.search.biblio.multiclass/ -); -__PACKAGE__->register_method( - method => 'the_quest_for_knowledge', - api_name => 'open-ils.search.metabib.multiclass', - signature => q/@see open-ils.search.biblio.multiclass/ -); -__PACKAGE__->register_method( - method => 'the_quest_for_knowledge', - api_name => 'open-ils.search.metabib.multiclass.staff', - signature => q/The .staff search includes hidden bibs, hidden items and bibs with no items. Otherwise, @see open-ils.search.biblio.multiclass/ -); - -sub the_quest_for_knowledge { - my( $self, $conn, $searchhash, $docache ) = @_; - - return { count => 0 } unless $searchhash and - ref $searchhash->{searches} eq 'HASH'; - - my $method = 'open-ils.storage.biblio.multiclass.search_fts'; - my $ismeta = 0; - my @recs; - - if($self->api_name =~ /metabib/) { - $ismeta = 1; - $method =~ s/biblio/metabib/o; - } - - # do some simple sanity checking - if(!$searchhash->{searches} or - ( !grep { /^(?:title|author|subject|series|keyword)/ } keys %{$searchhash->{searches}} ) ) { - return { count => 0 }; - } - - my $offset = $searchhash->{offset} || 0; # user value or default in local var now - my $limit = $searchhash->{limit} || 10; # user value or default in local var now - my $end = $offset + $limit - 1; - - my $maxlimit = 5000; - $searchhash->{offset} = 0; # possible user value overwritten in hash - $searchhash->{limit} = $maxlimit; # possible user value overwritten in hash - - return { count => 0 } if $offset > $maxlimit; - - my @search; - push( @search, ($_ => $$searchhash{$_})) for (sort keys %$searchhash); - my $s = OpenSRF::Utils::JSON->perl2JSON(\@search); - my $ckey = $pfx . md5_hex($method . $s); - - $logger->info("bib search for: $s"); - - $searchhash->{limit} -= $offset; - - - my $trim = 0; - my $result = ($docache) ? search_cache($ckey, $offset, $limit) : undef; - - if(!$result) { - - $method .= ".staff" if($self->api_name =~ /staff/); - $method .= ".atomic"; - - for (keys %$searchhash) { - delete $$searchhash{$_} - unless defined $$searchhash{$_}; - } - - $result = $U->storagereq( $method, %$searchhash ); - $trim = 1; - - } else { - $docache = 0; # results came FROM cache, so we don't write back - } - - return {count => 0} unless ($result && $$result[0]); - - @recs = @$result; - - my $count = ($ismeta) ? $result->[0]->[3] : $result->[0]->[2]; - - if($docache) { - # If we didn't get this data from the cache, put it into the cache - # then return the correct offset of records - $logger->debug("putting search cache $ckey\n"); - put_cache($ckey, $count, \@recs); - } - - if($trim) { - # if we have the full set of data, trim out - # the requested chunk based on limit and offset - my @t; - for ($offset..$end) { - last unless $recs[$_]; - push(@t, $recs[$_]); - } - @recs = @t; - } - - return { ids => \@recs, count => $count }; -} - - -__PACKAGE__->register_method( - method => 'staged_search', - api_name => 'open-ils.search.biblio.multiclass.staged', - signature => { - desc => 'Staged search filters out unavailable items. This means that it relies on an estimation strategy for determining ' . - 'how big a "raw" search result chunk (i.e. a "superpage") to obtain prior to filtering. See "estimation_strategy" in your SRF config.', - params => [ - { - desc => "A search hash with keys: " - . "searches, limit, offset. The others are optional, but the 'searches' key/value pair is required, with the value being a hashref. " - . "See perldoc " . __PACKAGE__ . " for more detail", - type => 'object', - }, - { - desc => "A flag to enable/disable searching and saving results in cache, including facets (default OFF)", - type => 'string', - } - ], - return => { - desc => 'Hash with keys: count, core_limit, superpage_size, superpage_summary, facet_key, ids. ' - . 'The superpage_summary value is a hashref that includes keys: estimated_hit_count, visible.', - type => 'object', - } - } -); -__PACKAGE__->register_method( - method => 'staged_search', - api_name => 'open-ils.search.biblio.multiclass.staged.staff', - signature => q/The .staff search includes hidden bibs, hidden items and bibs with no items. Otherwise, @see open-ils.search.biblio.multiclass.staged/ -); -__PACKAGE__->register_method( - method => 'staged_search', - api_name => 'open-ils.search.metabib.multiclass.staged', - signature => q/@see open-ils.search.biblio.multiclass.staged/ -); -__PACKAGE__->register_method( - method => 'staged_search', - api_name => 'open-ils.search.metabib.multiclass.staged.staff', - signature => q/The .staff search includes hidden bibs, hidden items and bibs with no items. Otherwise, @see open-ils.search.biblio.multiclass.staged/ -); - -sub staged_search { - my($self, $conn, $search_hash, $docache) = @_; - - my $IAmMetabib = ($self->api_name =~ /metabib/) ? 1 : 0; - - my $method = $IAmMetabib? - 'open-ils.storage.metabib.multiclass.staged.search_fts': - 'open-ils.storage.biblio.multiclass.staged.search_fts'; - - $method .= '.staff' if $self->api_name =~ /staff$/; - $method .= '.atomic'; - - return {count => 0} unless ( - $search_hash and - $search_hash->{searches} and - scalar( keys %{$search_hash->{searches}} )); - - my $search_duration; - my $user_offset = $search_hash->{offset} || 0; # user-specified offset - my $user_limit = $search_hash->{limit} || 10; - my $ignore_facet_classes = $search_hash->{ignore_facet_classes}; - $user_offset = ($user_offset >= 0) ? $user_offset : 0; - $user_limit = ($user_limit >= 0) ? $user_limit : 10; - - - # we're grabbing results on a per-superpage basis, which means the - # limit and offset should coincide with superpage boundaries - $search_hash->{offset} = 0; - $search_hash->{limit} = $superpage_size; - - # force a well-known check_limit - $search_hash->{check_limit} = $superpage_size; - # restrict total tested to superpage size * number of superpages - $search_hash->{core_limit} = $superpage_size * $max_superpages; - - # Set the configured estimation strategy, defaults to 'inclusion'. - my $estimation_strategy = OpenSRF::Utils::SettingsClient - ->new - ->config_value( - apps => 'open-ils.search', app_settings => 'estimation_strategy' - ) || 'inclusion'; - $search_hash->{estimation_strategy} = $estimation_strategy; - - # pull any existing results from the cache - my $key = search_cache_key($method, $search_hash); - my $facet_key = $key.'_facets'; - my $cache_data = $cache->get_cache($key) || {}; - - # keep retrieving results until we find enough to - # fulfill the user-specified limit and offset - my $all_results = []; - my $page; # current superpage - my $est_hit_count = 0; - my $current_page_summary = {}; - my $global_summary = {checked => 0, visible => 0, excluded => 0, deleted => 0, total => 0}; - my $is_real_hit_count = 0; - my $new_ids = []; - - for($page = 0; $page < $max_superpages; $page++) { - - my $data = $cache_data->{$page}; - my $results; - my $summary; - - $logger->debug("staged search: analyzing superpage $page"); - - if($data) { - # this window of results is already cached - $logger->debug("staged search: found cached results"); - $summary = $data->{summary}; - $results = $data->{results}; - - } else { - # retrieve the window of results from the database - $logger->debug("staged search: fetching results from the database"); - $search_hash->{skip_check} = $page * $superpage_size; - my $start = time; - $results = $U->storagereq($method, %$search_hash); - $search_duration = time - $start; - $logger->info("staged search: DB call took $search_duration seconds and returned ".scalar(@$results)." rows, including summary"); - $summary = shift(@$results) if $results; - - unless($summary) { - $logger->info("search timed out: duration=$search_duration: params=". - OpenSRF::Utils::JSON->perl2JSON($search_hash)); - return {count => 0}; - } - - my $hc = $summary->{estimated_hit_count} || $summary->{visible}; - if($hc == 0) { - $logger->info("search returned 0 results: duration=$search_duration: params=". - OpenSRF::Utils::JSON->perl2JSON($search_hash)); - } - - # Create backwards-compatible result structures - if($IAmMetabib) { - $results = [map {[$_->{id}, $_->{rel}, $_->{record}]} @$results]; - } else { - $results = [map {[$_->{id}]} @$results]; - } - - tag_circulated_records($search_hash->{authtoken}, $results, $IAmMetabib) - if $search_hash->{tag_circulated_records} and $search_hash->{authtoken}; - - push @$new_ids, grep {defined($_)} map {$_->[0]} @$results; - $results = [grep {defined $_->[0]} @$results]; - cache_staged_search_page($key, $page, $summary, $results) if $docache; - } - - $current_page_summary = $summary; - - # add the new set of results to the set under construction - push(@$all_results, @$results); - - my $current_count = scalar(@$all_results); - - $est_hit_count = $summary->{estimated_hit_count} || $summary->{visible} - if $page == 0; - - $logger->debug("staged search: located $current_count, with estimated hits=". - $summary->{estimated_hit_count}." : visible=".$summary->{visible}.", checked=".$summary->{checked}); - - if (defined($summary->{estimated_hit_count})) { - foreach (qw/ checked visible excluded deleted /) { - $global_summary->{$_} += $summary->{$_}; - } - $global_summary->{total} = $summary->{total}; - } - - # we've found all the possible hits - last if $current_count == $summary->{visible} - and not defined $summary->{estimated_hit_count}; - - # we've found enough results to satisfy the requested limit/offset - last if $current_count >= ($user_limit + $user_offset); - - # we've scanned all possible hits - if($summary->{checked} < $superpage_size) { - $est_hit_count = scalar(@$all_results); - # we have all possible results in hand, so we know the final hit count - $is_real_hit_count = 1; - last; - } - } - - my @results = grep {defined $_} @$all_results[$user_offset..($user_offset + $user_limit - 1)]; - - # refine the estimate if we have more than one superpage - if ($page > 0 and not $is_real_hit_count) { - if ($global_summary->{checked} >= $global_summary->{total}) { - $est_hit_count = $global_summary->{visible}; - } else { - my $updated_hit_count = $U->storagereq( - 'open-ils.storage.fts_paging_estimate', - $global_summary->{checked}, - $global_summary->{visible}, - $global_summary->{excluded}, - $global_summary->{deleted}, - $global_summary->{total} - ); - $est_hit_count = $updated_hit_count->{$estimation_strategy}; - } - } - - $conn->respond_complete( - { - count => $est_hit_count, - core_limit => $search_hash->{core_limit}, - superpage_size => $search_hash->{check_limit}, - superpage_summary => $current_page_summary, - facet_key => $facet_key, - ids => \@results - } - ); - - cache_facets($facet_key, $new_ids, $IAmMetabib, $ignore_facet_classes) if $docache; - - return undef; -} - -sub tag_circulated_records { - my ($auth, $results, $metabib) = @_; - my $e = new_editor(authtoken => $auth); - return $results unless $e->checkauth; - - my $query = { - select => { acn => [{ column => 'record', alias => 'tagme' }] }, - from => { acp => 'acn' }, - where => { id => { in => { from => ['action.usr_visible_circ_copies', $e->requestor->id] } } }, - distinct => 1 - }; - - if ($metabib) { - $query = { - select => { mmsm => [{ column => 'metarecord', alias => 'tagme' }] }, - from => 'mmsm', - where => { source => { in => $query } }, - distinct => 1 - }; - } - - # Give me the distinct set of bib records that exist in the user's visible circulation history - my $circ_recs = $e->json_query( $query ); - - # if the record appears in the circ history, push a 1 onto - # the rec array structure to indicate truthiness - for my $rec (@$results) { - push(@$rec, 1) if grep { $_->{tagme} eq $$rec[0] } @$circ_recs; - } - - $results -} - -# creates a unique token to represent the query in the cache -sub search_cache_key { - my $method = shift; - my $search_hash = shift; - my @sorted; - for my $key (sort keys %$search_hash) { - push(@sorted, ($key => $$search_hash{$key})) - unless $key eq 'limit' or - $key eq 'offset' or - $key eq 'skip_check'; - } - my $s = OpenSRF::Utils::JSON->perl2JSON(\@sorted); - return $pfx . md5_hex($method . $s); -} - -sub retrieve_cached_facets { - my $self = shift; - my $client = shift; - my $key = shift; - my $limit = shift; - - return undef unless ($key and $key =~ /_facets$/); - - my $blob = $cache->get_cache($key) || {}; - - my $facets = {}; - if ($limit) { - for my $f ( keys %$blob ) { - my @sorted = map{ { $$_[1] => $$_[0] } } sort {$$b[0] <=> $$a[0] || $$a[1] cmp $$b[1]} map { [$$blob{$f}{$_}, $_] } keys %{ $$blob{$f} }; - @sorted = @sorted[0 .. $limit - 1] if (scalar(@sorted) > $limit); - for my $s ( @sorted ) { - my ($k) = keys(%$s); - my ($v) = values(%$s); - $$facets{$f}{$k} = $v; - } - } - } else { - $facets = $blob; - } - - return $facets; -} - -__PACKAGE__->register_method( - method => "retrieve_cached_facets", - api_name => "open-ils.search.facet_cache.retrieve", - signature => { - desc => 'Returns facet data derived from a specific search based on a key '. - 'generated by open-ils.search.biblio.multiclass.staged and friends.', - params => [ - { - desc => "The facet cache key returned with the initial search as the facet_key hash value", - type => 'string', - } - ], - return => { - desc => 'Two level hash of facet values. Top level key is the facet id defined on the config.metabib_field table. '. - 'Second level key is a string facet value. Datum attached to each facet value is the number of distinct records, '. - 'or metarecords for a metarecord search, which use that facet value and are visible to the search at the time of '. - 'facet retrieval. These counts are calculated for all superpages that have been checked for visibility.', - type => 'object', - } - } -); - - -sub cache_facets { - # add facets for this search to the facet cache - my($key, $results, $metabib, $ignore) = @_; - my $data = $cache->get_cache($key); - $data ||= {}; - - if (!ref($ignore)) { - $ignore = ['identifier']; # ignore the identifier class by default - } - - return undef unless (@$results); - - # The query we're constructing - # - # select mfae.field as id, - # mfae.value, - # count(distinct mmrsm.appropriate-id-field ) - # from metabib.facet_entry mfae - # join metabib.metarecord_sourc_map mmrsm on (mfae.source = mmrsm.source) - # where mmrsm.appropriate-id-field in IDLIST - # group by 1,2; - - my $count_field = $metabib ? 'metarecord' : 'source'; - my $facets = $U->cstorereq( "open-ils.cstore.json_query.atomic", - { select => { - mfae => [ { column => 'field', alias => 'id'}, 'value' ], - mmrsm => [{ - transform => 'count', - distinct => 1, - column => $count_field, - alias => 'count', - aggregate => 1 - }] - }, - from => { - mfae => { - mmrsm => { field => 'source', fkey => 'source' }, - cmf => { field => 'id', fkey => 'field' } - } - }, - where => { - '+mmrsm' => { $count_field => $results }, - '+cmf' => { field_class => { 'not in' => $ignore } } - } - } - ); - - for my $facet (@$facets) { - next unless ($facet->{value}); - $data->{$facet->{id}}->{$facet->{value}} += $facet->{count}; - } - - $logger->info("facet compilation: cached with key=$key"); - - $cache->put_cache($key, $data, $cache_timeout); -} - -sub cache_staged_search_page { - # puts this set of results into the cache - my($key, $page, $summary, $results) = @_; - my $data = $cache->get_cache($key); - $data ||= {}; - $data->{$page} = { - summary => $summary, - results => $results - }; - - $logger->info("staged search: cached with key=$key, superpage=$page, estimated=". - $summary->{estimated_hit_count}.", visible=".$summary->{visible}); - - $cache->put_cache($key, $data, $cache_timeout); -} - -sub search_cache { - - my $key = shift; - my $offset = shift; - my $limit = shift; - my $start = $offset; - my $end = $offset + $limit - 1; - - $logger->debug("searching cache for $key : $start..$end\n"); - - return undef unless $cache; - my $data = $cache->get_cache($key); - - return undef unless $data; - - my $count = $data->[0]; - $data = $data->[1]; - - return undef unless $offset < $count; - - my @result; - for( my $i = $offset; $i <= $end; $i++ ) { - last unless my $d = $$data[$i]; - push( @result, $d ); - } - - $logger->debug("search_cache found ".scalar(@result)." items for count=$count, start=$start, end=$end"); - - return \@result; -} - - -sub put_cache { - my( $key, $count, $data ) = @_; - return undef unless $cache; - $logger->debug("search_cache putting ". - scalar(@$data)." items at key $key with timeout $cache_timeout"); - $cache->put_cache($key, [ $count, $data ], $cache_timeout); -} - - -__PACKAGE__->register_method( - method => "biblio_mrid_to_modsbatch_batch", - api_name => "open-ils.search.biblio.metarecord.mods_slim.batch.retrieve" -); - -sub biblio_mrid_to_modsbatch_batch { - my( $self, $client, $mrids) = @_; - # warn "Performing mrid_to_modsbatch_batch..."; # unconditional warn - my @mods; - my $method = $self->method_lookup("open-ils.search.biblio.metarecord.mods_slim.retrieve"); - for my $id (@$mrids) { - next unless defined $id; - my ($m) = $method->run($id); - push @mods, $m; - } - return \@mods; -} - - -foreach (qw /open-ils.search.biblio.metarecord.mods_slim.retrieve - open-ils.search.biblio.metarecord.mods_slim.retrieve.staff/) - { - __PACKAGE__->register_method( - method => "biblio_mrid_to_modsbatch", - api_name => $_, - signature => { - desc => "Returns the mvr associated with a given metarecod. If none exists, it is created. " - . "As usual, the .staff version of this method will include otherwise hidden records.", - params => [ - { desc => 'Metarecord ID', type => 'number' }, - { desc => '(Optional) Search filters hash with possible keys: format, org, depth', type => 'object' } - ], - return => { - desc => 'MVR Object, event on error', - } - } - ); -} - -sub biblio_mrid_to_modsbatch { - my( $self, $client, $mrid, $args) = @_; - - # warn "Grabbing mvr for $mrid\n"; # unconditional warn - - my ($mr, $evt) = _grab_metarecord($mrid); - return $evt unless $mr; - - my $mvr = biblio_mrid_check_mvr($self, $client, $mr) || - biblio_mrid_make_modsbatch($self, $client, $mr); - - return $mvr unless ref($args); - - # Here we find the lead record appropriate for the given filters - # and use that for the title and author of the metarecord - my $format = $$args{format}; - my $org = $$args{org}; - my $depth = $$args{depth}; - - return $mvr unless $format or $org or $depth; - - my $method = "open-ils.storage.ordered.metabib.metarecord.records"; - $method = "$method.staff" if $self->api_name =~ /staff/o; - - my $rec = $U->storagereq($method, $format, $org, $depth, 1); - - if( my $mods = $U->record_to_mvr($rec) ) { - - $mvr->title( $mods->title ); - $mvr->author($mods->author); - $logger->debug("mods_slim updating title and ". - "author in mvr with ".$mods->title." : ".$mods->author); - } - - return $mvr; -} - -# converts a metarecord to an mvr -sub _mr_to_mvr { - my $mr = shift; - my $perl = OpenSRF::Utils::JSON->JSON2perl($mr->mods()); - return Fieldmapper::metabib::virtual_record->new($perl); -} - -# checks to see if a metarecord has mods, if so returns true; - -__PACKAGE__->register_method( - method => "biblio_mrid_check_mvr", - api_name => "open-ils.search.biblio.metarecord.mods_slim.check", - notes => "Takes a metarecord ID or a metarecord object and returns true " - . "if the metarecord already has an mvr associated with it." -); - -sub biblio_mrid_check_mvr { - my( $self, $client, $mrid ) = @_; - my $mr; - - my $evt; - if(ref($mrid)) { $mr = $mrid; } - else { ($mr, $evt) = _grab_metarecord($mrid); } - return $evt if $evt; - - # warn "Checking mvr for mr " . $mr->id . "\n"; # unconditional warn - - return _mr_to_mvr($mr) if $mr->mods(); - return undef; -} - -sub _grab_metarecord { - my $mrid = shift; - #my $e = OpenILS::Utils::Editor->new; - my $e = new_editor(); - my $mr = $e->retrieve_metabib_metarecord($mrid) or return ( undef, $e->event ); - return ($mr); -} - - -__PACKAGE__->register_method( - method => "biblio_mrid_make_modsbatch", - api_name => "open-ils.search.biblio.metarecord.mods_slim.create", - notes => "Takes either a metarecord ID or a metarecord object. " - . "Forces the creations of an mvr for the given metarecord. " - . "The created mvr is returned." -); - -sub biblio_mrid_make_modsbatch { - my( $self, $client, $mrid ) = @_; - - #my $e = OpenILS::Utils::Editor->new; - my $e = new_editor(); - - my $mr; - if( ref($mrid) ) { - $mr = $mrid; - $mrid = $mr->id; - } else { - $mr = $e->retrieve_metabib_metarecord($mrid) - or return $e->event; - } - - my $masterid = $mr->master_record; - $logger->info("creating new mods batch for metarecord=$mrid, master record=$masterid"); - - my $ids = $U->storagereq( - 'open-ils.storage.ordered.metabib.metarecord.records.staff.atomic', $mrid); - return undef unless @$ids; - - my $master = $e->retrieve_biblio_record_entry($masterid) - or return $e->event; - - # start the mods batch - my $u = OpenILS::Utils::ModsParser->new(); - $u->start_mods_batch( $master->marc ); - - # grab all of the sub-records and shove them into the batch - my @ids = grep { $_ ne $masterid } @$ids; - #my $subrecs = (@ids) ? $e->batch_retrieve_biblio_record_entry(\@ids) : []; - - my $subrecs = []; - if(@$ids) { - for my $i (@$ids) { - my $r = $e->retrieve_biblio_record_entry($i); - push( @$subrecs, $r ) if $r; - } - } - - for(@$subrecs) { - $logger->debug("adding record ".$_->id." to mods batch for metarecord=$mrid"); - $u->push_mods_batch( $_->marc ) if $_->marc; - } - - - # finish up and send to the client - my $mods = $u->finish_mods_batch(); - $mods->doc_id($mrid); - $client->respond_complete($mods); - - - # now update the mods string in the db - my $string = OpenSRF::Utils::JSON->perl2JSON($mods->decast); - $mr->mods($string); - - #$e = OpenILS::Utils::Editor->new(xact => 1); - $e = new_editor(xact => 1); - $e->update_metabib_metarecord($mr) - or $logger->error("Error setting mods text on metarecord $mrid : " . Dumper($e->event)); - $e->finish; - - return undef; -} - - -# converts a mr id into a list of record ids - -foreach (qw/open-ils.search.biblio.metarecord_to_records - open-ils.search.biblio.metarecord_to_records.staff/) -{ - __PACKAGE__->register_method( - method => "biblio_mrid_to_record_ids", - api_name => $_, - signature => { - desc => "Fetch record IDs corresponding to a meta-record ID, with optional search filters. " - . "As usual, the .staff version of this method will include otherwise hidden records.", - params => [ - { desc => 'Metarecord ID', type => 'number' }, - { desc => '(Optional) Search filters hash with possible keys: format, org, depth', type => 'object' } - ], - return => { - desc => 'Results object like {count => $i, ids =>[...]}', - type => 'object' - } - - } - ); -} - -sub biblio_mrid_to_record_ids { - my( $self, $client, $mrid, $args ) = @_; - - my $format = $$args{format}; - my $org = $$args{org}; - my $depth = $$args{depth}; - - my $method = "open-ils.storage.ordered.metabib.metarecord.records.atomic"; - $method =~ s/atomic/staff\.atomic/o if $self->api_name =~ /staff/o; - my $recs = $U->storagereq($method, $mrid, $format, $org, $depth); - - return { count => scalar(@$recs), ids => $recs }; -} - - -__PACKAGE__->register_method( - method => "biblio_record_to_marc_html", - api_name => "open-ils.search.biblio.record.html" -); - -__PACKAGE__->register_method( - method => "biblio_record_to_marc_html", - api_name => "open-ils.search.authority.to_html" -); - -# Persistent parsers and setting objects -my $parser = XML::LibXML->new(); -my $xslt = XML::LibXSLT->new(); -my $marc_sheet; -my $slim_marc_sheet; -my $settings_client = OpenSRF::Utils::SettingsClient->new(); - -sub biblio_record_to_marc_html { - my($self, $client, $recordid, $slim, $marcxml) = @_; - - my $sheet; - my $dir = $settings_client->config_value("dirs", "xsl"); - - if($slim) { - unless($slim_marc_sheet) { - my $xsl = $settings_client->config_value( - "apps", "open-ils.search", "app_settings", 'marc_html_xsl_slim'); - if($xsl) { - $xsl = $parser->parse_file("$dir/$xsl"); - $slim_marc_sheet = $xslt->parse_stylesheet($xsl); - } - } - $sheet = $slim_marc_sheet; - } - - unless($sheet) { - unless($marc_sheet) { - my $xsl_key = ($slim) ? 'marc_html_xsl_slim' : 'marc_html_xsl'; - my $xsl = $settings_client->config_value( - "apps", "open-ils.search", "app_settings", 'marc_html_xsl'); - $xsl = $parser->parse_file("$dir/$xsl"); - $marc_sheet = $xslt->parse_stylesheet($xsl); - } - $sheet = $marc_sheet; - } - - my $record; - unless($marcxml) { - my $e = new_editor(); - if($self->api_name =~ /authority/) { - $record = $e->retrieve_authority_record_entry($recordid) - or return $e->event; - } else { - $record = $e->retrieve_biblio_record_entry($recordid) - or return $e->event; - } - $marcxml = $record->marc; - } - - my $xmldoc = $parser->parse_string($marcxml); - my $html = $sheet->transform($xmldoc); - return $html->documentElement->toString(); -} - -__PACKAGE__->register_method( - method => "format_biblio_record_entry", - api_name => "open-ils.search.biblio.record.print", - signature => { - desc => 'Returns a printable version of the specified bib record', - params => [ - { desc => 'Biblio record entry ID or array of IDs', type => 'number' }, - ], - return => { - desc => q/An action_trigger.event object or error event./, - type => 'object', - } - } -); -__PACKAGE__->register_method( - method => "format_biblio_record_entry", - api_name => "open-ils.search.biblio.record.email", - signature => { - desc => 'Emails an A/T templated version of the specified bib records to the authorized user', - params => [ - { desc => 'Authentication token', type => 'string'}, - { desc => 'Biblio record entry ID or array of IDs', type => 'number' }, - ], - return => { - desc => q/Undefined on success, otherwise an error event./, - type => 'object', - } - } -); - -sub format_biblio_record_entry { - my($self, $conn, $arg1, $arg2) = @_; - - my $for_print = ($self->api_name =~ /print/); - my $for_email = ($self->api_name =~ /email/); - - my $e; my $auth; my $bib_id; my $context_org; - - if ($for_print) { - $bib_id = $arg1; - $context_org = $arg2 || $U->fetch_org_tree->id; - $e = new_editor(xact => 1); - } elsif ($for_email) { - $auth = $arg1; - $bib_id = $arg2; - $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - $context_org = $e->requestor->home_ou; - } - - my $bib_ids; - if (ref $bib_id ne 'ARRAY') { - $bib_ids = [ $bib_id ]; - } else { - $bib_ids = $bib_id; - } - - my $bucket = Fieldmapper::container::biblio_record_entry_bucket->new; - $bucket->btype('temp'); - $bucket->name('format_biblio_record_entry ' . $U->create_uuid_string); - if ($for_email) { - $bucket->owner($e->requestor) - } else { - $bucket->owner(1); - } - my $bucket_obj = $e->create_container_biblio_record_entry_bucket($bucket); - - for my $id (@$bib_ids) { - - my $bib = $e->retrieve_biblio_record_entry([$id]) or return $e->die_event; - - my $bucket_entry = Fieldmapper::container::biblio_record_entry_bucket_item->new; - $bucket_entry->target_biblio_record_entry($bib); - $bucket_entry->bucket($bucket_obj->id); - $e->create_container_biblio_record_entry_bucket_item($bucket_entry); - } - - $e->commit; - - if ($for_print) { - - return $U->fire_object_event(undef, 'biblio.format.record_entry.print', [ $bucket ], $context_org); - - } elsif ($for_email) { - - $U->create_events_for_hook('biblio.format.record_entry.email', $bucket, $context_org, undef, undef, 1); - } - - return undef; -} - - -__PACKAGE__->register_method( - method => "retrieve_all_copy_statuses", - api_name => "open-ils.search.config.copy_status.retrieve.all" -); - -sub retrieve_all_copy_statuses { - my( $self, $client ) = @_; - return new_editor()->retrieve_all_config_copy_status(); -} - - -__PACKAGE__->register_method( - method => "copy_counts_per_org", - api_name => "open-ils.search.biblio.copy_counts.retrieve" -); - -__PACKAGE__->register_method( - method => "copy_counts_per_org", - api_name => "open-ils.search.biblio.copy_counts.retrieve.staff" -); - -sub copy_counts_per_org { - my( $self, $client, $record_id ) = @_; - - warn "Retreiveing copy copy counts for record $record_id and method " . $self->api_name . "\n"; - - my $method = "open-ils.storage.biblio.record_entry.global_copy_count.atomic"; - if($self->api_name =~ /staff/) { $method =~ s/atomic/staff\.atomic/; } - - my $counts = $apputils->simple_scalar_request( - "open-ils.storage", $method, $record_id ); - - $counts = [ sort {$a->[0] <=> $b->[0]} @$counts ]; - return $counts; -} - - -__PACKAGE__->register_method( - method => "copy_count_summary", - api_name => "open-ils.search.biblio.copy_counts.summary.retrieve", - notes => "returns an array of these: " - . "[ org_id, callnumber_label, , ,...] " - . "where statusx is a copy status name. The statuses are sorted by ID.", -); - - -sub copy_count_summary { - my( $self, $client, $rid, $org, $depth ) = @_; - $org ||= 1; - $depth ||= 0; - my $data = $U->storagereq( - 'open-ils.storage.biblio.record_entry.status_copy_count.atomic', $rid, $org, $depth ); - - return [ sort { $a->[1] cmp $b->[1] } @$data ]; -} - -__PACKAGE__->register_method( - method => "copy_location_count_summary", - api_name => "open-ils.search.biblio.copy_location_counts.summary.retrieve", - notes => "returns an array of these: " - . "[ org_id, callnumber_label, copy_location, , ,...] " - . "where statusx is a copy status name. The statuses are sorted by ID.", -); - -sub copy_location_count_summary { - my( $self, $client, $rid, $org, $depth ) = @_; - $org ||= 1; - $depth ||= 0; - my $data = $U->storagereq( - 'open-ils.storage.biblio.record_entry.status_copy_location_count.atomic', $rid, $org, $depth ); - - return [ sort { $a->[1] cmp $b->[1] || $a->[2] cmp $b->[2] } @$data ]; -} - -__PACKAGE__->register_method( - method => "copy_count_location_summary", - api_name => "open-ils.search.biblio.copy_counts.location.summary.retrieve", - notes => "returns an array of these: " - . "[ org_id, callnumber_label, , ,...] " - . "where statusx is a copy status name. The statuses are sorted by ID." -); - -sub copy_count_location_summary { - my( $self, $client, $rid, $org, $depth ) = @_; - $org ||= 1; - $depth ||= 0; - my $data = $U->storagereq( - 'open-ils.storage.biblio.record_entry.status_copy_location_count.atomic', $rid, $org, $depth ); - return [ sort { $a->[1] cmp $b->[1] } @$data ]; -} - - -foreach (qw/open-ils.search.biblio.marc - open-ils.search.biblio.marc.staff/) -{ -__PACKAGE__->register_method( - method => "marc_search", - api_name => $_, - signature => { - desc => 'Fetch biblio IDs based on MARC record criteria. ' - . 'As usual, the .staff version of the search includes otherwise hidden records', - params => [ - { - desc => 'Search hash (required) with possible elements: searches, limit, offset, sort, sort_dir. ' . - 'See perldoc ' . __PACKAGE__ . ' for more detail.', - type => 'object' - }, - {desc => 'limit (optional)', type => 'number'}, - {desc => 'offset (optional)', type => 'number'} - ], - return => { - desc => 'Results object like: { "count": $i, "ids": [...] }', - type => 'object' - } - } -); -} - -=head3 open-ils.search.biblio.marc (arghash, limit, offset) - -As elsewhere the arghash is the required argument, and must be a hashref. The keys are: - - searches: complex query object (required) - org_unit: The org ID to focus the search at - depth : The org depth - limit : integer search limit default: 10 - offset : integer search offset default: 0 - sort : What field to sort the results on? [ author | title | pubdate ] - sort_dir: In what direction do we sort? [ asc | desc ] - -Additional keys to refine search criteria: - - audience : Audience - language : Language (code) - lit_form : Literary form - item_form: Item form - item_type: Item type - format : The MARC format - -Please note that the specific strings to be used in the "addtional keys" will be entirely -dependent on your loaded data. - -All keys except "searches" are optional. -The "searches" value must be an arrayref of hashref elements, including keys "term" and "restrict". - -For example, an arg hash might look like: - - $arghash = { - searches => [ - { - term => "harry", - restrict => [ - { - tag => 245, - subfield => "a" - } - # ... - ] - } - # ... - ], - org_unit => 1, - limit => 5, - sort => "author", - item_type => "g" - } - -The arghash is eventually passed to the SRF call: -L - -Presently, search uses the cache unconditionally. - -=cut - -# FIXME: that example above isn't actually tested. -# TODO: docache option? -sub marc_search { - my( $self, $conn, $args, $limit, $offset ) = @_; - - my $method = 'open-ils.storage.biblio.full_rec.multi_search'; - $method .= ".staff" if $self->api_name =~ /staff/; - $method .= ".atomic"; - - $limit ||= 10; # FIXME: what about $args->{limit} ? - $offset ||= 0; # FIXME: what about $args->{offset} ? - - my @search; - push( @search, ($_ => $$args{$_}) ) for (sort keys %$args); - my $ckey = $pfx . md5_hex($method . OpenSRF::Utils::JSON->perl2JSON(\@search)); - - my $recs = search_cache($ckey, $offset, $limit); - - if(!$recs) { - $recs = $U->storagereq($method, %$args) || []; - if( $recs ) { - put_cache($ckey, scalar(@$recs), $recs); - $recs = [ @$recs[$offset..($offset + ($limit - 1))] ]; - } else { - $recs = []; - } - } - - my $count = 0; - $count = $recs->[0]->[2] if $recs->[0] and $recs->[0]->[2]; - my @recs = map { $_->[0] } @$recs; - - return { ids => \@recs, count => $count }; -} - - -__PACKAGE__->register_method( - method => "biblio_search_isbn", - api_name => "open-ils.search.biblio.isbn", - signature => { - desc => 'Retrieve biblio IDs for a given ISBN', - params => [ - {desc => 'ISBN', type => 'string'} # or number maybe? How normalized is our storage data? - ], - return => { - desc => 'Results object like: { "count": $i, "ids": [...] }', - type => 'object' - } - } -); - -sub biblio_search_isbn { - my( $self, $client, $isbn ) = @_; - $logger->debug("Searching ISBN $isbn"); - my $recs = $U->storagereq('open-ils.storage.id_list.biblio.record_entry.search.isbn.atomic', $isbn); - return { ids => $recs, count => scalar(@$recs) }; -} - -__PACKAGE__->register_method( - method => "biblio_search_isbn_batch", - api_name => "open-ils.search.biblio.isbn_list", -); - -sub biblio_search_isbn_batch { - my( $self, $client, $isbn_list ) = @_; - $logger->debug("Searching ISBNs @$isbn_list"); - my @recs = (); my %rec_set = (); - foreach my $isbn ( @$isbn_list ) { - foreach my $rec ( @{ $U->storagereq( - 'open-ils.storage.id_list.biblio.record_entry.search.isbn.atomic', $isbn ) - } ) { - if (! $rec_set{ $rec }) { - $rec_set{ $rec } = 1; - push @recs, $rec; - } - } - } - return { ids => \@recs, count => scalar(@recs) }; -} - -__PACKAGE__->register_method( - method => "biblio_search_issn", - api_name => "open-ils.search.biblio.issn", - signature => { - desc => 'Retrieve biblio IDs for a given ISSN', - params => [ - {desc => 'ISBN', type => 'string'} - ], - return => { - desc => 'Results object like: { "count": $i, "ids": [...] }', - type => 'object' - } - } -); - -sub biblio_search_issn { - my( $self, $client, $issn ) = @_; - $logger->debug("Searching ISSN $issn"); - my $e = new_editor(); - $issn =~ s/-/ /g; - my $recs = $U->storagereq( - 'open-ils.storage.id_list.biblio.record_entry.search.issn.atomic', $issn ); - return { ids => $recs, count => scalar(@$recs) }; -} - - -__PACKAGE__->register_method( - method => "fetch_mods_by_copy", - api_name => "open-ils.search.biblio.mods_from_copy", - argc => 1, - signature => { - desc => 'Retrieve MODS record given an attached copy ID', - params => [ - { desc => 'Copy ID', type => 'number' } - ], - returns => { - desc => 'MODS record, event on error or uncataloged item' - } - } -); - -sub fetch_mods_by_copy { - my( $self, $client, $copyid ) = @_; - my ($record, $evt) = $apputils->fetch_record_by_copy( $copyid ); - return $evt if $evt; - return OpenILS::Event->new('ITEM_NOT_CATALOGED') unless $record->marc; - return $apputils->record_to_mvr($record); -} - - -# ------------------------------------------------------------------------------------- - -__PACKAGE__->register_method( - method => "cn_browse", - api_name => "open-ils.search.callnumber.browse.target", - notes => "Starts a callnumber browse" -); - -__PACKAGE__->register_method( - method => "cn_browse", - api_name => "open-ils.search.callnumber.browse.page_up", - notes => "Returns the previous page of callnumbers", -); - -__PACKAGE__->register_method( - method => "cn_browse", - api_name => "open-ils.search.callnumber.browse.page_down", - notes => "Returns the next page of callnumbers", -); - - -# RETURNS array of arrays like so: label, owning_lib, record, id -sub cn_browse { - my( $self, $client, @params ) = @_; - my $method; - - $method = 'open-ils.storage.asset.call_number.browse.target.atomic' - if( $self->api_name =~ /target/ ); - $method = 'open-ils.storage.asset.call_number.browse.page_up.atomic' - if( $self->api_name =~ /page_up/ ); - $method = 'open-ils.storage.asset.call_number.browse.page_down.atomic' - if( $self->api_name =~ /page_down/ ); - - return $apputils->simplereq( 'open-ils.storage', $method, @params ); -} -# ------------------------------------------------------------------------------------- - -__PACKAGE__->register_method( - method => "fetch_cn", - api_name => "open-ils.search.callnumber.retrieve", - authoritative => 1, - notes => "retrieves a callnumber based on ID", -); - -sub fetch_cn { - my( $self, $client, $id ) = @_; - my( $cn, $evt ) = $apputils->fetch_callnumber( $id ); - return $evt if $evt; - return $cn; -} - -__PACKAGE__->register_method( - method => "fetch_copy_by_cn", - api_name => 'open-ils.search.copies_by_call_number.retrieve', - signature => q/ - Returns an array of copy ID's by callnumber ID - @param cnid The callnumber ID - @return An array of copy IDs - / -); - -sub fetch_copy_by_cn { - my( $self, $conn, $cnid ) = @_; - return $U->cstorereq( - 'open-ils.cstore.direct.asset.copy.id_list.atomic', - { call_number => $cnid, deleted => 'f' } ); -} - -__PACKAGE__->register_method( - method => 'fetch_cn_by_info', - api_name => 'open-ils.search.call_number.retrieve_by_info', - signature => q/ - @param label The callnumber label - @param record The record the cn is attached to - @param org The owning library of the cn - @return The callnumber object - / -); - - -sub fetch_cn_by_info { - my( $self, $conn, $label, $record, $org ) = @_; - return $U->cstorereq( - 'open-ils.cstore.direct.asset.call_number.search', - { label => $label, record => $record, owning_lib => $org, deleted => 'f' }); -} - - - -__PACKAGE__->register_method( - method => 'bib_extras', - api_name => 'open-ils.search.biblio.lit_form_map.retrieve.all' -); -__PACKAGE__->register_method( - method => 'bib_extras', - api_name => 'open-ils.search.biblio.item_form_map.retrieve.all' -); -__PACKAGE__->register_method( - method => 'bib_extras', - api_name => 'open-ils.search.biblio.item_type_map.retrieve.all' -); -__PACKAGE__->register_method( - method => 'bib_extras', - api_name => 'open-ils.search.biblio.bib_level_map.retrieve.all' -); -__PACKAGE__->register_method( - method => 'bib_extras', - api_name => 'open-ils.search.biblio.audience_map.retrieve.all' -); - -sub bib_extras { - my $self = shift; - - my $e = new_editor(); - - return $e->retrieve_all_config_lit_form_map() - if( $self->api_name =~ /lit_form/ ); - - return $e->retrieve_all_config_item_form_map() - if( $self->api_name =~ /item_form_map/ ); - - return $e->retrieve_all_config_item_type_map() - if( $self->api_name =~ /item_type_map/ ); - - return $e->retrieve_all_config_bib_level_map() - if( $self->api_name =~ /bib_level_map/ ); - - return $e->retrieve_all_config_audience_map() - if( $self->api_name =~ /audience_map/ ); - - return []; -} - - - -__PACKAGE__->register_method( - method => 'fetch_slim_record', - api_name => 'open-ils.search.biblio.record_entry.slim.retrieve', - signature => { - desc => "Retrieves one or more biblio.record_entry without the attached marcxml", - params => [ - { desc => 'Array of Record IDs', type => 'array' } - ], - return => { - desc => 'Array of biblio records, event on error' - } - } -); - -sub fetch_slim_record { - my( $self, $conn, $ids ) = @_; - -#my $editor = OpenILS::Utils::Editor->new; - my $editor = new_editor(); - my @res; - for( @$ids ) { - return $editor->event unless - my $r = $editor->retrieve_biblio_record_entry($_); - $r->clear_marc; - push(@res, $r); - } - return \@res; -} - - - -__PACKAGE__->register_method( - method => 'rec_to_mr_rec_descriptors', - api_name => 'open-ils.search.metabib.record_to_descriptors', - signature => q/ - specialized method... - Given a biblio record id or a metarecord id, - this returns a list of metabib.record_descriptor - objects that live within the same metarecord - @param args Object of args including: - / -); - -sub rec_to_mr_rec_descriptors { - my( $self, $conn, $args ) = @_; - - my $rec = $$args{record}; - my $mrec = $$args{metarecord}; - my $item_forms = $$args{item_forms}; - my $item_types = $$args{item_types}; - my $item_lang = $$args{item_lang}; - - my $e = new_editor(); - my $recs; - - if( !$mrec ) { - my $map = $e->search_metabib_metarecord_source_map({source => $rec}); - return $e->event unless @$map; - $mrec = $$map[0]->metarecord; - } - - $recs = $e->search_metabib_metarecord_source_map({metarecord => $mrec}); - return $e->event unless @$recs; - - my @recs = map { $_->source } @$recs; - my $search = { record => \@recs }; - $search->{item_form} = $item_forms if $item_forms and @$item_forms; - $search->{item_type} = $item_types if $item_types and @$item_types; - $search->{item_lang} = $item_lang if $item_lang; - - my $desc = $e->search_metabib_record_descriptor($search); - - return { metarecord => $mrec, descriptors => $desc }; -} - - -__PACKAGE__->register_method( - method => 'fetch_age_protect', - api_name => 'open-ils.search.copy.age_protect.retrieve.all', -); - -sub fetch_age_protect { - return new_editor()->retrieve_all_config_rule_age_hold_protect(); -} - - -__PACKAGE__->register_method( - method => 'copies_by_cn_label', - api_name => 'open-ils.search.asset.copy.retrieve_by_cn_label', -); - -__PACKAGE__->register_method( - method => 'copies_by_cn_label', - api_name => 'open-ils.search.asset.copy.retrieve_by_cn_label.staff', -); - -sub copies_by_cn_label { - my( $self, $conn, $record, $label, $circ_lib ) = @_; - my $e = new_editor(); - my $cns = $e->search_asset_call_number({record => $record, label => $label, deleted => 'f'}, {idlist=>1}); - return [] unless @$cns; - - # show all non-deleted copies in the staff client ... - if ($self->api_name =~ /staff$/o) { - return $e->search_asset_copy({call_number => $cns, circ_lib => $circ_lib, deleted => 'f'}, {idlist=>1}); - } - - # ... otherwise, grab the copies ... - my $copies = $e->search_asset_copy( - [ {call_number => $cns, circ_lib => $circ_lib, deleted => 'f', opac_visible => 't'}, - {flesh => 1, flesh_fields => { acp => [ qw/location status/] } } - ] - ); - - # ... and test for location and status visibility - return [ map { ($U->is_true($_->location->opac_visible) && $U->is_true($_->status->opac_visible)) ? ($_->id) : () } @$copies ]; -} - - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Search/CNBrowse.pm b/Open-ILS/src/perlmods/OpenILS/Application/Search/CNBrowse.pm deleted file mode 100644 index eade47a727..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Search/CNBrowse.pm +++ /dev/null @@ -1,121 +0,0 @@ -package OpenILS::Application::Search::CNBrowse; -use base qw/OpenILS::Application/; -use strict; use warnings; - -use OpenSRF::EX qw(:try); -use OpenILS::Application::AppUtils; -use Data::Dumper; -use OpenSRF::Utils::Logger qw/:logger/; -use OpenSRF::AppSession; -my $U = "OpenILS::Application::AppUtils"; - - -__PACKAGE__->register_method( - method => "cn_browse_start", - api_name => "open-ils.search.callnumber.browse.target", - notes => "Starts a callnumber browse" - ); - -__PACKAGE__->register_method( - method => "cn_browse_up", - api_name => "open-ils.search.callnumber.browse.page_up", - notes => "Returns the previous page of callnumbers", - ); - -__PACKAGE__->register_method( - method => "cn_browse_down", - api_name => "open-ils.search.callnumber.browse.page_down", - notes => "Returns the next page of callnumbers", - ); - -# XXX Deprecate me - -sub cn_browse_start { - my( $self, $client, @params ) = @_; - my $method; - $method = 'open-ils.storage.asset.call_number.browse.target.atomic' - if( $self->api_name =~ /target/ ); - $method = 'open-ils.storage.asset.call_number.browse.page_up' - if( $self->api_name =~ /page_up/ ); - $method = 'open-ils.storage.asset.call_number.browse.page_down' - if( $self->api_name =~ /page_down/ ); - - return $U->simplereq( 'open-ils.storage', $method, @params ); -} - - -__PACKAGE__->register_method( - method => "cn_browse", - api_name => "open-ils.search.callnumber.browse", - signature => { - desc => q/Paged call number browse/, - params => [ - { name => 'label', - desc => 'The target call number lable', - type => 'string' }, - { name => 'org_unit', - desc => 'The org unit shortname (or "-" or undef for global) to browse', - type => 'string' }, - { name => 'page_size', - desc => 'Count of call numbers to retrieve, default is 9', - type => 'number' }, - { name => 'offset', - desc => 'The page of call numbers to retrieve, calculated based on page_size. Can be positive, negative or 0.', - type => 'number' }, - { name => 'statuses', - desc => 'Array of statuses to filter copies by, optional and can be undef.', - type => 'array' }, - { name => 'locations', - desc => 'Array of copy locations to filter copies by, optional and can be undef.', - type => 'array' }, - ], - return => { - type => 'array', - desc => q/List of callnumber (acn) and record (mvr) objects/ - } - } -); - -sub cn_browse { - my( $self, $conn, $cn, $orgid, $size, $offset, $copy_statuses, $copy_locations ) = @_; - my $ses = OpenSRF::AppSession->create('open-ils.supercat'); - - my $tree = $U->get_slim_org_tree; - my $name = _find_shortname($orgid, $tree); - - $logger->debug("cn browse found or name $name"); - - my $data = $ses->request( - 'open-ils.supercat.call_number.browse', - $cn, $name, $size, $offset, $copy_statuses, $copy_locations )->gather(1); - - return [] unless $data; - - my @res; - for my $d (@$data) { - my $mods = $U->record_to_mvr($d->record); - $d->owning_lib( $d->owning_lib->id ); - $d->record($mods->doc_id); - push( @res, { cn => $d, mods => $mods }); - } - - return \@res; -} - - -sub _find_shortname { - my $id = shift; - my $node = shift; - return undef unless $node; - return $node->shortname if $node->id == $id; - if( $node->children ) { - for my $c (@{$node->children()}) { - my $d = _find_shortname($id, $c); - return $d if $d; - } - } - return undef; -} - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Search/Serial.pm b/Open-ILS/src/perlmods/OpenILS/Application/Search/Serial.pm deleted file mode 100644 index 06d2f63829..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Search/Serial.pm +++ /dev/null @@ -1,188 +0,0 @@ -package OpenILS::Application::Search::Serial; -use base qw/OpenILS::Application/; -use strict; use warnings; - - -use OpenSRF::Utils::JSON; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::MFHDParser; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenSRF::Utils::Cache; -use Encode; - -use OpenSRF::Utils::Logger qw/:logger/; - -use Data::Dumper; - -use OpenSRF::Utils::JSON; - -use Time::HiRes qw(time); -use OpenSRF::EX qw(:try); -use Digest::MD5 qw(md5_hex); - -use XML::LibXML; -use XML::LibXSLT; - -use OpenILS::Const qw/:const/; - -use OpenILS::Application::AppUtils; -my $apputils = "OpenILS::Application::AppUtils"; -my $U = $apputils; - -my $pfx = "open-ils.search_"; - -=over - -=item * mfhd_to_hash - -=back - -Takes an MFHD record ID and returns a hash of holdings statements - -=cut - -sub mfhd_to_hash { - my ($self, $client, $id) = @_; - - my $session = OpenSRF::AppSession->create("open-ils.cstore"); - my $request = $session->request( - "open-ils.cstore.direct.serial.record_entry.retrieve", $id )->gather(1); - - my $u = OpenILS::Utils::MFHDParser->new(); - my $mfhd_hash = $u->generate_svr( $request->id, $request->marc, $request->owning_lib ); - - $session->disconnect(); - return $mfhd_hash; -} - -__PACKAGE__->register_method( - method => "mfhd_to_hash", - api_name => "open-ils.search.serial.record.mfhd.retrieve", - argc => 1, - note => "Given a serial record ID, return MFHD holdings" -); - -=over - -=item * bib_to_mfhd_hash - -=back - -Given a bib record ID, returns a hash of holdings statements - -=cut - -# DEFUNCT ? -#sub bib_to_mfhd_hash { -# my ($self, $client, $bib) = @_; -# -# my $mfhd_hash; -# -# # XXX perhaps this? --miker -## my $e = OpenILS::Utils::CStoreEditor->new(); -## my $mfhd = $e->search_serial_record_entry({ record => $bib }); -## return $u->generate_svr( $mfhd->[0] ) if (ref $mfhd); -## return undef; -# -# my @mfhd = $U->cstorereq( "open-ils.cstore.json_query.atomic", { -# select => { sre => 'marc' }, -# from => 'sre', -# where => { record => $bib, deleted => 'f' }, -# distinct => 1 -# }); -# -# if (!@mfhd or scalar(@mfhd) == 0) { -# return undef; -# } -# -# my $u = OpenILS::Utils::MFHDParser->new(); -# $mfhd_hash = $u->generate_svr( $mfhd[0][0]->{id}, $mfhd[0][0]->{marc}, $mfhd[0][0]->{owning_lib} ); -# -# return $mfhd_hash; -#} -# -#__PACKAGE__->register_method( -# method => "bib_to_mfhd_hash", -# api_name => "open-ils.search.serial.record.bib_to_mfhd.retrieve", -# argc => 1, -# note => "Given a bibliographic record ID, return MFHD holdings" -#); - -sub bib_to_svr { - my ($self, $client, $bib) = @_; - - my $svrs = []; - - my $e = OpenILS::Utils::CStoreEditor->new(); - # TODO: 'deleted' ssub support - my $sdists = $e->search_serial_distribution([{ "+ssub" => {"record_entry" => $bib} }, { "flesh" => 1, "flesh_fields" => {'sdist' => [ "record_entry", "holding_lib", "basic_summary", "supplement_summary", "index_summary" ]}, "join" => {"ssub" => {}} }]); - my $sres = $e->search_serial_record_entry([{ record => $bib, deleted => 'f', "+sdist" => {"id" => undef} }, { "join" => {"sdist" => { 'type' => 'left' }} }]); - if (!ref $sres and !ref $sdists) { - return undef; - } - - my $mfhd_parser = OpenILS::Utils::MFHDParser->new(); - foreach (@$sdists) { - my $svr; - if (ref $_->record_entry) { - $svr = $mfhd_parser->generate_svr($_->record_entry->id, $_->record_entry->marc, $_->record_entry->owning_lib); - } else { - $svr = Fieldmapper::serial::virtual_record->new; - $svr->sre_id(-1); - $svr->location($_->holding_lib->name); - $svr->owning_lib($_->holding_lib); - $svr->basic_holdings([]); - $svr->supplement_holdings([]); - $svr->index_holdings([]); - $svr->basic_holdings_add([]); - $svr->supplement_holdings_add([]); - $svr->index_holdings_add([]); - $svr->online([]); - $svr->missing([]); - $svr->incomplete([]); - } - if (ref $_->basic_summary) { #TODO: 'show-generated' boolean on summaries - if ($_->basic_summary->generated_coverage) { - push(@{$svr->basic_holdings}, $_->basic_summary->generated_coverage); - } - if ($_->basic_summary->textual_holdings) { - push(@{$svr->basic_holdings_add}, $_->basic_summary->textual_holdings); - } - } - if (ref $_->supplement_summary) { - if ($_->supplement_summary->generated_coverage) { - push(@{$svr->supplement_holdings}, $_->supplement_summary->generated_coverage); - } - if ($_->supplement_summary->textual_holdings) { - push(@{$svr->supplement_holdings_add}, $_->supplement_summary->textual_holdings); - } - } - if (ref $_->index_summary) { - if ($_->index_summary->generated_coverage) { - push(@{$svr->index_holdings}, $_->index_summary->generated_coverage); - } - if ($_->index_summary->textual_holdings) { - push(@{$svr->index_holdings_add}, $_->index_summary->textual_holdings); - } - } - push(@$svrs, $svr); - } - foreach (@$sres) { - push(@$svrs, $mfhd_parser->generate_svr($_->id, $_->marc, $_->owning_lib)); - } - - # do a basic location sort for simple predictability - @$svrs = sort { $a->location cmp $b->location } @$svrs; - - return $svrs; -} - -__PACKAGE__->register_method( - method => "bib_to_svr", - api_name => "open-ils.search.serial.record.bib.retrieve", - argc => 1, - note => "Given a bibliographic record ID, return holdings in svr form" -); - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Search/Z3950.pm b/Open-ILS/src/perlmods/OpenILS/Application/Search/Z3950.pm deleted file mode 100644 index 18884c6e38..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Search/Z3950.pm +++ /dev/null @@ -1,459 +0,0 @@ -package OpenILS::Application::Search::Z3950; -use strict; use warnings; -use base qw/OpenILS::Application/; - -use OpenILS::Utils::ZClient; -use MARC::Record; -use MARC::File::XML; -use Unicode::Normalize; -use XML::LibXML; - -use OpenILS::Event; -use OpenSRF::EX qw(:try); -use OpenILS::Utils::ModsParser; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Application::AppUtils; -use OpenSRF::Utils::Logger qw/$logger/; -use OpenILS::Utils::CStoreEditor q/:funcs/; - -my $output = "usmarc"; -my $U = 'OpenILS::Application::AppUtils'; - -my $sclient; -my %services; -my $default_service; - - -__PACKAGE__->register_method( - method => 'do_class_search', - api_name => 'open-ils.search.z3950.search_class', - stream => 1, - signature => q/ - Performs a class based Z search. The classes available - are defined by the 'attr' fields in the config for the - requested service. - @param auth The login session key - @param shash The search hash : { attr : value, attr2: value, ...} - @param service The service to connect to - @param username The username to use when connecting to the service - @param password The password to use when connecting to the service - / -); - -__PACKAGE__->register_method( - method => 'do_service_search', - api_name => 'open-ils.search.z3950.search_service', - signature => q/ - @param auth The login session key - @param query The Z3950 search string to use - @param service The service to connect to - @param username The username to use when connecting to the service - @param password The password to use when connecting to the service - / -); - - -__PACKAGE__->register_method( - method => 'do_service_search', - api_name => 'open-ils.search.z3950.search_raw', - signature => q/ - @param auth The login session key - @param args An object of search params which must include: - host, port, db and query. - optional fields include username and password - / -); - - -__PACKAGE__->register_method( - method => "query_services", - api_name => "open-ils.search.z3950.retrieve_services", - signature => q/ - Returns a list of service names that we have config - data for - / -); - - - -# ------------------------------------------------------------------- -# What services do we have config info for? -# ------------------------------------------------------------------- -sub query_services { - my( $self, $client, $auth ) = @_; - my $e = new_editor(authtoken=>$auth); - return $e->event unless $e->checkauth; - return $e->event unless $e->allowed('REMOTE_Z3950_QUERY'); - - return fetch_service_defs(); -} - -# ------------------------------------------------------------------- -# What services do we have config info for? -# ------------------------------------------------------------------- -sub fetch_service_defs { - - my $hash = $sclient->config_value('z3950', 'services'); - - # overlay config file values with in-db values - my $e = new_editor(); - if($e->can('search_config_z3950_source')) { - - my $sources = $e->search_config_z3950_source( - [ { name => { '!=' => undef } }, - { flesh => 1, flesh_fields => { czs => ['attrs'] } } ] - ); - - for my $s ( @$sources ) { - $$hash{ $s->name } = { - name => $s->name, - label => $s->label, - host => $s->host, - port => $s->port, - db => $s->db, - record_format => $s->record_format, - transmission_format => $s->transmission_format, - auth => $s->auth, - }; - - for my $a ( @{ $s->attrs } ) { - $$hash{ $a->source }{attrs}{ $a->name } = { - name => $a->name, - label => $a->label, - code => $a->code, - format => $a->format, - source => $a->source, - truncation => $a->truncation, - }; - } - } - } - - # Define the set of native catalog services - # XXX There are i18n problems here, but let's get the staff client working first - # XXX Move into the DB? - $hash->{'native-evergreen-catalog'} = { - attrs => { - title => {code => 'title', label => 'Title'}, - author => {code => 'author', label => 'Author'}, - subject => {code => 'subject', label => 'Subject'}, - keyword => {code => 'keyword', label => 'Keyword'}, - tcn => {code => 'tcn', label => 'TCN'}, - isbn => {code => 'isbn', label => 'ISBN'}, - issn => {code => 'issn', label => 'ISSN'}, - publisher => {code => 'publisher', label => 'Publisher'}, - pubdate => {code => 'pubdate', label => 'Pub Date'}, - item_type => {code => 'item_type', label => 'Item Type'}, - } - }; - - %services = %$hash; # cache these internally so we can actually use the db-configured sources - return $hash; -} - - - -# ------------------------------------------------------------------- -# Load the pre-defined Z server configs -# ------------------------------------------------------------------- -sub child_init { - $sclient = OpenSRF::Utils::SettingsClient->new(); - $default_service = $sclient->config_value("z3950", "default" ); -} - - -# ------------------------------------------------------------------- -# High-level class based search. -# ------------------------------------------------------------------- -sub do_class_search { - - fetch_service_defs() unless (scalar(keys(%services))); - - my $self = shift; - my $conn = shift; - my $auth = shift; - my $args = shift; - - if (!ref($$args{service})) { - $$args{service} = [$$args{service}]; - $$args{username} = [$$args{username}]; - $$args{password} = [$$args{password}]; - } - - $$args{async} = 1; - - my @connections; - my @results; - my @services; - for (my $i = 0; $i < @{$$args{service}}; $i++) { - my %tmp_args = %$args; - $tmp_args{service} = $$args{service}[$i]; - $tmp_args{username} = $$args{username}[$i]; - $tmp_args{password} = $$args{password}[$i]; - - $logger->debug("z3950: service: $tmp_args{service}, async: $tmp_args{async}"); - - if ($tmp_args{service} eq 'native-evergreen-catalog') { - my $method = $self->method_lookup('open-ils.search.biblio.zstyle.staff'); - $conn->respond( - $self->method_lookup('open-ils.search.biblio.zstyle.staff')->run($auth, \%tmp_args) - ); - - } else { - - $tmp_args{query} = compile_query('and', $tmp_args{service}, $tmp_args{search}); - - my $res = do_service_search( $self, $conn, $auth, \%tmp_args ); - - if ($U->event_code($res)) { - $conn->respond($res) if $U->event_code($res); - - } else { - push @services, $tmp_args{service}; - push @results, $res->{result}; - push @connections, $res->{connection}; - } - } - - $logger->debug("z3950: Result object: $results[$i], Connection object: $connections[$i]"); - } - - $logger->debug("z3950: Connections created"); - - return undef unless (@connections); - my @records; - - # local catalog search is not processed with other z39 results; - $$args{service} = [grep {$_ ne 'native-evergreen-catalog'} @{$$args{service}}]; - - @connections = grep {defined $_} @connections; - return undef unless @connections; - - while ((my $index = OpenILS::Utils::ZClient::event( \@connections )) != 0) { - my $ev = $connections[$index - 1]->last_event(); - $logger->debug("z3950: Received event $ev"); - if ($ev == OpenILS::Utils::ZClient::EVENT_END()) { - my $munged = process_results( $results[$index - 1], $$args{limit}, $$args{offset}, $$args{service}[$index -1] ); - $$munged{service} = $$args{service}[$index - 1]; - $conn->respond($munged); - } - } - - $logger->debug("z3950: Search Complete"); - return undef; -} - - -# ------------------------------------------------------------------- -# This handles the host settings, but expects a fully formed z query -# ------------------------------------------------------------------- -sub do_service_search { - - fetch_service_defs() unless (scalar(keys(%services))); - - my $self = shift; - my $conn = shift; - my $auth = shift; - my $args = shift; - - my $info = $services{$$args{service}}; - - $$args{host} = $$info{host}; - $$args{port} = $$info{port}; - $$args{db} = $$info{db}; - $logger->debug("z3950: do_search..."); - - return do_search( $self, $conn, $auth, $args ); -} - - - -# ------------------------------------------------------------------- -# This is the low level search method. All config and query -# data must be provided to this method -# ------------------------------------------------------------------- -sub do_search { - - fetch_service_defs() unless (scalar(keys(%services))); - - my $self = shift; - my $conn = shift; - my $auth = shift; - my $args = shift; - - my $host = $$args{host} or return undef; - my $port = $$args{port} or return undef; - my $db = $$args{db} or return undef; - my $query = $$args{query} or return undef; - my $async = $$args{async} || 0; - - my $limit = $$args{limit} || 10; - my $offset = $$args{offset} || 0; - - my $username = $$args{username} || ""; - my $password = $$args{password} || ""; - - my $tformat = $services{$args->{service}}->{transmission_format} || $output; - - my $editor = new_editor(authtoken => $auth); - return $editor->event unless $editor->checkauth; - return $editor->event unless $editor->allowed('REMOTE_Z3950_QUERY'); - - $logger->info("z3950: connecting to server $host:$port:$db as $username"); - - my $connection = OpenILS::Utils::ZClient->new( - $host, $port, - databaseName => $db, - user => $username, - password => $password, - async => $async, - preferredRecordSyntax => $tformat, - ); - - if( ! $connection ) { - $logger->error("z3950: Unable to connect to Z server: ". - "$host:$port:$db:$username:$password"); - return OpenILS::Event->new('Z3950_LOGIN_FAILED') unless $connection; - } - - my $start = time; - my $results; - my $err; - - $logger->info("z3950: query => $query"); - - try { - $results = $connection->search_pqf( $query ); - } catch Error with { $err = shift; }; - - return OpenILS::Event->new( - 'Z3950_BAD_QUERY', payload => $query, debug => "$err") if $err; - - return OpenILS::Event->new('Z3950_SEARCH_FAILED', - debug => $connection->errcode." => ".$connection->errmsg." : query = $query") unless $results; - - $logger->info("z3950: search [$query] took ".(time - $start)." seconds"); - - return {result => $results, connection => $connection} if ($async); - - my $munged = process_results($results, $limit, $offset, $$args{service}); - $munged->{query} = $query; - - return $munged; -} - - -# ------------------------------------------------------------------- -# Takes a result batch and returns the hitcount and a list of xml -# and mvr objects -# ------------------------------------------------------------------- -sub process_results { - - fetch_service_defs() unless (scalar(keys(%services))); - - my $results = shift; - my $limit = shift || 10; - my $offset = shift || 0; - my $service = shift; - - my $rformat = $services{$service}->{record_format}; - my $tformat = $services{$service}->{transmission_format} || $output; - - $results->option(elementSetName => $rformat); - $results->option(preferredRecordSyntax => $tformat); - $logger->info("z3950: using record format '$rformat' and transmission format '$tformat'"); - - my @records; - my $res = {}; - my $count = $$res{count} = $results->size; - - $logger->info("z3950: search returned $count hits"); - - my $tend = $limit + $offset; - - my $end = ($tend <= $count) ? $tend : $count; - - for($offset..$end - 1) { - - my $err; - my $mods; - my $marc; - my $marcs; - my $marcxml; - - $logger->info("z3950: fetching record $_"); - - try { - - my $rec = $results->record($_); - - if ($tformat eq 'usmarc') { - $marc = MARC::Record->new_from_usmarc($rec->raw()); - } elsif ($tformat eq 'xml') { - $marc = MARC::Record->new_from_xml($rec->raw()); - } else { - die "Unsupported record transmission format $tformat" - } - - $marcs = $U->entityize($marc->as_xml_record); - $marcs = $U->strip_ctrl_chars($marcs); - my $doc = XML::LibXML->new->parse_string($marcs); - $marcxml = $U->entityize($doc->documentElement->toString); - $marcxml = $U->strip_ctrl_chars($marcxml); - - my $u = OpenILS::Utils::ModsParser->new(); - $u->start_mods_batch( $marcxml ); - $mods = $u->finish_mods_batch(); - - - } catch Error with { $err = shift; }; - - push @records, { 'mvr' => $mods, 'marcxml' => $marcxml } unless $err; - $logger->error("z3950: bad XML : $err") if $err; - - if( $err ) { - warn "\n\n$marcs\n\n"; - } - } - - $res->{records} = \@records; - return $res; -} - - - -# ------------------------------------------------------------------- -# Compiles the class based search query -# ------------------------------------------------------------------- -sub compile_query { - - fetch_service_defs() unless (scalar(keys(%services))); - - my $separator = shift; - my $service = shift; - my $hash = shift; - - my $count = scalar(keys %$hash); - - my $str = ""; - $str .= "\@$separator " for (1..$count-1); - - # ------------------------------------------------------------------- - # "code" is the bib-1 "use attribute", "format" is the bib-1 - # "structure attribute" - # ------------------------------------------------------------------- - for( keys %$hash ) { - next unless ( exists $services{$service}->{attrs}->{$_} ); - $str .= '@attr 1=' . $services{$service}->{attrs}->{$_}->{code} . # add the use attribute - ' @attr 4=' . $services{$service}->{attrs}->{$_}->{format}; # add the structure attribute - if (exists $services{$service}->{attrs}->{$_}->{truncation} - && $services{$service}->{attrs}->{$_}->{truncation} >= 0) { - $str .= ' @attr 5=' . $services{$service}->{attrs}->{$_}->{truncation}; - } - $str .= " \"" . $$hash{$_} . "\" "; # add the search term - } - return $str; -} - -1; -# vim:et:ts=4:sw=4: diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Search/Zips.pm b/Open-ILS/src/perlmods/OpenILS/Application/Search/Zips.pm deleted file mode 100644 index 0cccf4651e..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Search/Zips.pm +++ /dev/null @@ -1,71 +0,0 @@ -package OpenILS::Application::Search::Zips; -use base qw/OpenILS::Application/; -use strict; use warnings; - -use OpenSRF::EX qw(:try); -use OpenSRF::Utils::Logger qw/$logger/; -use OpenILS::Application::AppUtils; -use OpenILS::Utils::Editor; -use OpenSRF::Utils::SettingsClient; - -my %zips; - -# ----------------------------------------------------------------- -# Reads zip code information from a file. File format is : -# ID|StateAbb|City|Zip|IsDefault|StateID|County|AreaCode -# Currently, StateAbb, City, Zip, County, AreaCode are used. -# IsDefault should be set to 1 -# ----------------------------------------------------------------- - -sub initialize { - my $conf = OpenSRF::Utils::SettingsClient->new; - my $zfile = $conf->config_value( - "apps", "open-ils.search", "app_settings", "zips_file"); - return 1 unless $zfile and -f $zfile; - - $logger->info("search loaded zips file $zfile"); - open(F,$zfile); - my @data = ; - close(F); - - for(@data) { - chomp $_; - my @items = split(/\|/, "$_"); - my $items = { - state => $items[1], - city => $items[2], - zip => $items[3], - stateid => $items[5], - county => $items[6], - areacode => $items[7], - alert => $items[8] - }; - - next unless $items[4] eq '1'; - $zips{$$items{zip}} = $items; - } -} - -__PACKAGE__->register_method( - method => 'search_zip', - api_name => 'open-ils.search.zip', - signature => q/ - Given a zip code, returns address info for the zip code - @param auth the login session key - @param zip The zip code to check - @return On success, returns an object of the form: - { state=>, city=>, zip=>, stateid=>, county=>, areacode=>} - returns event on error - / -); -sub search_zip { - #my( $self, $conn, $auth, $zip ) = @_; - #my $e = OpenILS::Utils::Editor->new(authtoken=>$auth); - #return $e->event unless $e->checkauth; - #return $e->event unless $e->allowed('VIEW_ZIP_DATA'); - my( $self, $conn, $zip ) = @_; - $zip =~ s/(^\d{5}).*/$1/; # we don't care about the last 4 digits if they exist - return $zips{$zip}; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Serial.pm b/Open-ILS/src/perlmods/OpenILS/Application/Serial.pm deleted file mode 100644 index c70aefea13..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Serial.pm +++ /dev/null @@ -1,3466 +0,0 @@ -#!/usr/bin/perl - -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. - -=head1 NAME - -OpenILS::Application::Serial - Performs serials-related tasks such as receiving issues and generating predictions - -=head1 SYNOPSIS - -TBD - -=head1 DESCRIPTION - -TBD - -=head1 AUTHOR - -Dan Wells, dbw2@calvin.edu - -=cut - -package OpenILS::Application::Serial; - -use strict; -use warnings; - - -use OpenILS::Application; -use base qw/OpenILS::Application/; -use OpenILS::Application::AppUtils; -use OpenILS::Event; -use OpenSRF::AppSession; -use OpenSRF::Utils qw/:datetime/; -use OpenSRF::Utils::Logger qw/:logger/; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::MFHD; -use DateTime::Format::ISO8601; -use MARC::File::XML (BinaryEncoding => 'utf8'); -my $U = 'OpenILS::Application::AppUtils'; -my @MFHD_NAMES = ('basic','supplement','index'); -my %MFHD_NAMES_BY_TAG = ( '853' => $MFHD_NAMES[0], - '863' => $MFHD_NAMES[0], - '854' => $MFHD_NAMES[1], - '864' => $MFHD_NAMES[1], - '855' => $MFHD_NAMES[2], - '865' => $MFHD_NAMES[2] ); -my %MFHD_TAGS_BY_NAME = ( $MFHD_NAMES[0] => '853', - $MFHD_NAMES[1] => '854', - $MFHD_NAMES[2] => '855'); -my $_strp_date = new DateTime::Format::Strptime(pattern => '%F'); - -# helper method for conforming dates to ISO8601 -sub _cleanse_dates { - my $item = shift; - my $fields = shift; - - foreach my $field (@$fields) { - $item->$field(OpenSRF::Utils::clense_ISO8601($item->$field)) if $item->$field; - } - return 0; -} - -sub _get_mvr { - $U->simplereq( - "open-ils.search", - "open-ils.search.biblio.record.mods_slim.retrieve", - @_ - ); -} - - -########################################################################## -# item methods -# -__PACKAGE__->register_method( - method => "create_item_safely", - api_name => "open-ils.serial.item.create", - api_level => 1, - stream => 1, - argc => 3, - signature => { - desc => q/Creates any number of items, respecting only a few of the - submitted fields, as the user shouldn't be able to freely set certain - ones/, - params => [ - {name=> "authtoken", desc => "Authtoken for current user session", - type => "string"}, - {name => "item", desc => "serial item", - type => "object", class => "sitem"}, - {name => "count", - desc => "optional: how many items to make " . - "(default 1; 1-100 permitted)", - type => "number"} - ], - return => { - desc => "created items (a stream of them)", - type => "object", class => "sitem" - } - } -); -__PACKAGE__->register_method( - method => "update_item_safely", - api_name => "open-ils.serial.item.update", - api_level => 1, - stream => 1, - argc => 2, - signature => { - desc => q/Edit a serial item, respecting only a few of the - submitted fields, as the user shouldn't be able to freely set certain - ones/, - params => [ - {name=> "authtoken", desc => "Authtoken for current user session", - type => "string"}, - {name => "item", desc => "serial item", - type => "object", class => "sitem"}, - ], - return => { - desc => "created item", type => "object", class => "sitem" - } - } -); - -sub _set_safe_item_fields { - my $dest = shift; - my $source = shift; - my $requestor_id = shift; - # extra fields remain in @_ - - $dest->edit_date("now"); - $dest->editor($requestor_id); - - my @fields = qw/date_expected date_received status/; - - for my $field (@fields, @_) { - $dest->$field($source->$field); - } -} - -sub update_item_safely { - my ($self, $client, $auth, $item) = @_; - - my $e = new_editor("xact" => 1, "authtoken" => $auth); - $e->checkauth or return $e->die_event; - - my $orig = $e->retrieve_serial_item([ - $item->id, { - "flesh" => 2, "flesh_fields" => { - "sitem" => ["stream"], "sstr" => ["distribution"] - } - } - ]) or return $e->die_event; - - return $e->die_event unless $e->allowed( - "ADMIN_SERIAL_ITEM", $orig->stream->distribution->holding_lib - ); - - _set_safe_item_fields($orig, $item, $e->requestor->id); - $e->update_serial_item($orig) or return $e->die_event; - - $client->respond($e->retrieve_serial_item($item->id)); - $e->commit or return $e->die_event; - undef; -} - -sub create_item_safely { - my ($self, $client, $auth, $item, $count) = @_; - - $count = int $count; - $count ||= 1; - return new OpenILS::Event( - "BAD_PARAMS", note => "Count should be from 1 to 100" - ) unless $count >= 1 and $count <= 100; - - my $e = new_editor("xact" => 1, "authtoken" => $auth); - $e->checkauth or return $e->die_event; - - my $stream = $e->retrieve_serial_stream([ - $item->stream, { - "flesh" => 1, "flesh_fields" => {"sstr" => ["distribution"]} - } - ]) or return $e->die_event; - - return $e->die_event unless $e->allowed( - "ADMIN_SERIAL_ITEM", $stream->distribution->holding_lib - ); - - for (my $i = 0; $i < $count; $i++) { - my $actual = new Fieldmapper::serial::item; - $actual->creator($e->requestor->id); - _set_safe_item_fields( - $actual, $item, $e->requestor->id, "issuance", "stream" - ); - - $e->create_serial_item($actual) or return $e->die_event; - $client->respond($e->data); - } - - $e->commit or return $e->die_event; - undef; -} - -__PACKAGE__->register_method( - method => 'fleshed_item_alter', - api_name => 'open-ils.serial.item.fleshed.batch.update', - api_level => 1, - argc => 2, - signature => { - desc => 'Receives an array of one or more items and updates the database as needed', - 'params' => [ { - name => 'authtoken', - desc => 'Authtoken for current user session', - type => 'string' - }, - { - name => 'items', - desc => 'Array of fleshed items', - type => 'array' - } - - ], - 'return' => { - desc => 'Returns 1 if successful, event if failed', - type => 'mixed' - } - } -); - -sub fleshed_item_alter { - my( $self, $conn, $auth, $items ) = @_; - return 1 unless ref $items; - my( $reqr, $evt ) = $U->checkses($auth); - return $evt if $evt; - my $editor = new_editor(requestor => $reqr, xact => 1); - my $override = $self->api_name =~ /override/; - -# TODO: permission check -# return $editor->event unless -# $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy)); - - for my $item (@$items) { - - my $itemid = $item->id; - $item->editor($editor->requestor->id); - $item->edit_date('now'); - - if( $item->isdeleted ) { - $evt = _delete_sitem( $editor, $override, $item); - } elsif( $item->isnew ) { - # TODO: reconsider this - # if the item has a new issuance, create the issuance first - if (ref $item->issuance eq 'Fieldmapper::serial::issuance' and $item->issuance->isnew) { - fleshed_issuance_alter($self, $conn, $auth, [$item->issuance]); - } - _cleanse_dates($item, ['date_expected','date_received']); - $evt = _create_sitem( $editor, $item ); - } else { - _cleanse_dates($item, ['date_expected','date_received']); - $evt = _update_sitem( $editor, $override, $item ); - } - } - - if( $evt ) { - $logger->info("fleshed item-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt)); - $editor->rollback; - return $evt; - } - $logger->debug("item-alter: done updating item batch"); - $editor->commit; - $logger->info("fleshed item-alter successfully updated ".scalar(@$items)." items"); - return 1; -} - -sub _delete_sitem { - my ($editor, $override, $item) = @_; - $logger->info("item-alter: delete item ".OpenSRF::Utils::JSON->perl2JSON($item)); - return $editor->event unless $editor->delete_serial_item($item); - return 0; -} - -sub _create_sitem { - my ($editor, $item) = @_; - - $item->creator($editor->requestor->id); - $item->create_date('now'); - - $logger->info("item-alter: new item ".OpenSRF::Utils::JSON->perl2JSON($item)); - return $editor->event unless $editor->create_serial_item($item); - return 0; -} - -sub _update_sitem { - my ($editor, $override, $item) = @_; - - $logger->info("item-alter: retrieving item ".$item->id); - my $orig_item = $editor->retrieve_serial_item($item->id); - - $logger->info("item-alter: original item ".OpenSRF::Utils::JSON->perl2JSON($orig_item)); - $logger->info("item-alter: updated item ".OpenSRF::Utils::JSON->perl2JSON($item)); - return $editor->event unless $editor->update_serial_item($item); - return 0; -} - -__PACKAGE__->register_method( - method => "fleshed_serial_item_retrieve_batch", - authoritative => 1, - api_name => "open-ils.serial.item.fleshed.batch.retrieve" -); - -sub fleshed_serial_item_retrieve_batch { - my( $self, $client, $ids ) = @_; -# FIXME: permissions? - $logger->info("Fetching fleshed serial items @$ids"); - return $U->cstorereq( - "open-ils.cstore.direct.serial.item.search.atomic", - { id => $ids }, - { flesh => 2, - flesh_fields => {sitem => [ qw/issuance creator editor stream unit notes/ ], sstr => ["distribution"], sunit => ["call_number"], siss => [qw/creator editor subscription/]} - }); -} - - -########################################################################## -# issuance methods -# -__PACKAGE__->register_method( - method => 'fleshed_issuance_alter', - api_name => 'open-ils.serial.issuance.fleshed.batch.update', - api_level => 1, - argc => 2, - signature => { - desc => 'Receives an array of one or more issuances and updates the database as needed', - 'params' => [ { - name => 'authtoken', - desc => 'Authtoken for current user session', - type => 'string' - }, - { - name => 'issuances', - desc => 'Array of fleshed issuances', - type => 'array' - } - - ], - 'return' => { - desc => 'Returns 1 if successful, event if failed', - type => 'mixed' - } - } -); - -sub fleshed_issuance_alter { - my( $self, $conn, $auth, $issuances ) = @_; - return 1 unless ref $issuances; - my( $reqr, $evt ) = $U->checkses($auth); - return $evt if $evt; - my $editor = new_editor(requestor => $reqr, xact => 1); - my $override = $self->api_name =~ /override/; - -# TODO: permission support -# return $editor->event unless -# $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy)); - - for my $issuance (@$issuances) { - my $issuanceid = $issuance->id; - $issuance->editor($editor->requestor->id); - $issuance->edit_date('now'); - - if( $issuance->isdeleted ) { - $evt = _delete_siss( $editor, $override, $issuance); - } elsif( $issuance->isnew ) { - _cleanse_dates($issuance, ['date_published']); - $evt = _create_siss( $editor, $issuance ); - } else { - _cleanse_dates($issuance, ['date_published']); - $evt = _update_siss( $editor, $override, $issuance ); - } - } - - if( $evt ) { - $logger->info("fleshed issuance-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt)); - $editor->rollback; - return $evt; - } - $logger->debug("issuance-alter: done updating issuance batch"); - $editor->commit; - $logger->info("fleshed issuance-alter successfully updated ".scalar(@$issuances)." issuances"); - return 1; -} - -sub _delete_siss { - my ($editor, $override, $issuance) = @_; - $logger->info("issuance-alter: delete issuance ".OpenSRF::Utils::JSON->perl2JSON($issuance)); - return $editor->event unless $editor->delete_serial_issuance($issuance); - return 0; -} - -sub _create_siss { - my ($editor, $issuance) = @_; - - $issuance->creator($editor->requestor->id); - $issuance->create_date('now'); - - $logger->info("issuance-alter: new issuance ".OpenSRF::Utils::JSON->perl2JSON($issuance)); - return $editor->event unless $editor->create_serial_issuance($issuance); - return 0; -} - -sub _update_siss { - my ($editor, $override, $issuance) = @_; - - $logger->info("issuance-alter: retrieving issuance ".$issuance->id); - my $orig_issuance = $editor->retrieve_serial_issuance($issuance->id); - - $logger->info("issuance-alter: original issuance ".OpenSRF::Utils::JSON->perl2JSON($orig_issuance)); - $logger->info("issuance-alter: updated issuance ".OpenSRF::Utils::JSON->perl2JSON($issuance)); - return $editor->event unless $editor->update_serial_issuance($issuance); - return 0; -} - -__PACKAGE__->register_method( - method => "fleshed_serial_issuance_retrieve_batch", - authoritative => 1, - api_name => "open-ils.serial.issuance.fleshed.batch.retrieve" -); - -sub fleshed_serial_issuance_retrieve_batch { - my( $self, $client, $ids ) = @_; -# FIXME: permissions? - $logger->info("Fetching fleshed serial issuances @$ids"); - return $U->cstorereq( - "open-ils.cstore.direct.serial.issuance.search.atomic", - { id => $ids }, - { flesh => 1, - flesh_fields => {siss => [ qw/creator editor subscription/ ]} - }); -} - -__PACKAGE__->register_method( - method => "pub_fleshed_serial_issuance_retrieve_batch", - api_name => "open-ils.serial.issuance.pub_fleshed.batch.retrieve", - signature => { - desc => q/ - Public (i.e. OPAC) call for getting at the sub and - ultimately the record entry from an issuance - /, - params => [{name => 'ids', desc => 'Array of IDs', type => 'array'}], - return => { - desc => q/ - issuance objects, fleshed with subscriptions - /, - class => 'siss' - } - } -); -sub pub_fleshed_serial_issuance_retrieve_batch { - my( $self, $client, $ids ) = @_; - return [] unless $ids and @$ids; - return new_editor()->search_serial_issuance([ - { id => $ids }, - { - flesh => 1, - flesh_fields => {siss => [ qw/subscription/ ]} - } - ]); -} - -sub received_siss_by_bib { - my $self = shift; - my $client = shift; - my $bib = shift; - - my $args = shift || {}; - $$args{order} ||= 'asc'; - - my $global = $$args{global} == 0 ? 0 : 1; - - my $e = new_editor(); - my $issuances = $e->json_query({ - select => { - siss => [ - $global ? { transform => "min", column => "id", aggregate => 1 } : "id", - "label", - "date_published" - ], - "sitem" => [ - # We're not really interested in the minimum here. This is - # just a way to distinguish issuances whose items have units - # from issuances whose items have no units, without altogether - # excluding the latter type of issuances. - {"transform" => "min", "alias" => "has_units", - "column" => "unit", "aggregate" => 1} - ] - }, - from => { - ssub => { - siss => { - field => 'subscription', - fkey => 'id', - join => { - sitem => { - field => 'issuance', - fkey => 'id', - $$args{ou} ? ( join => { - sstr => { - field => 'id', - fkey => 'stream', - join => { - sdist => { - field => 'id', - fkey => 'distribution' - } - } - } - }) : () - } - } - } - } - }, - where => { - '+ssub' => { record_entry => $bib }, - $$args{type} ? ( '+siss' => { 'holding_type' => $$args{type} } ) : (), - '+sitem' => { - # XXX should we also take specific item statuses into account? - date_received => { '!=' => undef }, - $$args{status} ? ( 'status' => $$args{status} ) : () - }, - $$args{ou} ? ( '+sdist' => { - holding_lib => { - 'in' => $U->get_org_descendants($$args{ou}, $$args{depth}) - } - }) : () - }, - $$args{limit} ? ( limit => $$args{limit} ) : (), - $$args{offset} ? ( offset => $$args{offset} ) : (), - order_by => [{ class => 'siss', field => 'date_published', direction => $$args{order} }], - distinct => 1 - }); - - $client->respond({ - "issuance" => $e->retrieve_serial_issuance($_->{"id"}), - "has_units" => $_->{"has_units"} ? 1 : 0 - }) for @$issuances; - - return undef; -} -__PACKAGE__->register_method( - method => 'received_siss_by_bib', - api_name => 'open-ils.serial.received_siss.retrieve.by_bib', - api_level => 1, - argc => 1, - stream => 1, - signature => { - desc => 'Receives a Bib ID and other optional params and returns "siss" (issuance) objects', - params => [ - { name => 'bibid', - desc => 'id of the bre to which the issuances belong', - type => 'number' - }, - { name => 'args', - desc => -q/A hash of optional arguments. Valid keys and their meanings: - global := If true, return only one representative version of a conceptual issuance regardless of the number of subscriptions, otherwise return all issuance objects meeting the requested criteria, including conceptual duplicates. Valid values are 0 (false) and 1 (true, default). - order := date_published sort direction, either "asc" (chronological, default) or "desc" (reverse chronological) - limit := Number of issuances to return. Useful for paging results, or finding the oldest or newest - offset := Number of issuance to skip before returning results. Useful for paging. - orgid := OU id used to scope retrieval, based on distribution.holding_lib - depth := OU depth used to range the scope of orgid - type := Holding type filter. Valid values are "basic", "supplement" and "index". Can be a scalar (one) or arrayref (one or more). - status := Item status filter. Valid values are "Bindery", "Bound", "Claimed", "Discarded", "Expected", "Not Held", "Not Published" and "Received". Can be a scalar (one) or arrayref (one or more). -/ - } - ] - } -); - - -sub scoped_bib_holdings_summary { - my $self = shift; - my $client = shift; - my $bibid = shift; - my $args = shift || {}; - - $args->{order} = 'asc'; - - my ($issuances) = $self->method_lookup('open-ils.serial.received_siss.retrieve.by_bib.atomic')->run( $bibid => $args ); - - # split into issuance type sets - my %type_blob = (basic => [], supplement => [], index => []); - push @{ $type_blob{ $_->{"issuance"}->holding_type } }, $_->{"issuance"} - for (@$issuances); - - # generate a statement list for each type - my %statement_blob; - for my $type ( keys %type_blob ) { - my ($mfhd,$list) = _summarize_contents(new_editor(), $type_blob{$type}); - $statement_blob{$type} = $list; - } - - return \%statement_blob; -} -__PACKAGE__->register_method( - method => 'scoped_bib_holdings_summary', - api_name => 'open-ils.serial.bib.summary_statements', - api_level => 1, - argc => 1, - signature => { - desc => 'Receives a Bib ID and other optional params and returns set of holdings statements', - params => [ - { name => 'bibid', - desc => 'id of the bre to which the issuances belong', - type => 'number' - }, - { name => 'args', - desc => -q/A hash of optional arguments. Valid keys and their meanings: - orgid := OU id used to scope retrieval, based on distribution.holding_lib - depth := OU depth used to range the scope of orgid - type := Holding type filter. Valid values are "basic", "supplement" and "index". Can be a scalar (one) or arrayref (one or more). - status := Item status filter. Valid values are "Bindery", "Bound", "Claimed", "Discarded", "Expected", "Not Held", "Not Published" and "Received". Can be a scalar (one) or arrayref (one or more). -/ - } - ] - } -); - - -########################################################################## -# unit methods -# -__PACKAGE__->register_method( - method => 'fleshed_sunit_alter', - api_name => 'open-ils.serial.sunit.fleshed.batch.update', - api_level => 1, - argc => 2, - signature => { - desc => 'Receives an array of one or more Units and updates the database as needed', - 'params' => [ { - name => 'authtoken', - desc => 'Authtoken for current user session', - type => 'string' - }, - { - name => 'sunits', - desc => 'Array of fleshed Units', - type => 'array' - } - - ], - 'return' => { - desc => 'Returns 1 if successful, event if failed', - type => 'mixed' - } - } -); - -sub fleshed_sunit_alter { - my( $self, $conn, $auth, $sunits ) = @_; - return 1 unless ref $sunits; - my( $reqr, $evt ) = $U->checkses($auth); - return $evt if $evt; - my $editor = new_editor(requestor => $reqr, xact => 1); - my $override = $self->api_name =~ /override/; - -# TODO: permission support -# return $editor->event unless -# $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy)); - - for my $sunit (@$sunits) { - if( $sunit->isdeleted ) { - $evt = _delete_sunit( $editor, $override, $sunit ); - } else { - $sunit->default_location( $sunit->default_location->id ) if ref $sunit->default_location; - - if( $sunit->isnew ) { - $evt = _create_sunit( $editor, $sunit ); - } else { - $evt = _update_sunit( $editor, $override, $sunit ); - } - } - } - - if( $evt ) { - $logger->info("fleshed sunit-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt)); - $editor->rollback; - return $evt; - } - $logger->debug("sunit-alter: done updating sunit batch"); - $editor->commit; - $logger->info("fleshed sunit-alter successfully updated ".scalar(@$sunits)." Units"); - return 1; -} - -sub _delete_sunit { - my ($editor, $override, $sunit) = @_; - $logger->info("sunit-alter: delete sunit ".OpenSRF::Utils::JSON->perl2JSON($sunit)); - return $editor->event unless $editor->delete_serial_unit($sunit); - return 0; -} - -sub _create_sunit { - my ($editor, $sunit) = @_; - - $logger->info("sunit-alter: new Unit ".OpenSRF::Utils::JSON->perl2JSON($sunit)); - return $editor->event unless $editor->create_serial_unit($sunit); - return 0; -} - -sub _update_sunit { - my ($editor, $override, $sunit) = @_; - - $logger->info("sunit-alter: retrieving sunit ".$sunit->id); - my $orig_sunit = $editor->retrieve_serial_unit($sunit->id); - - $logger->info("sunit-alter: original sunit ".OpenSRF::Utils::JSON->perl2JSON($orig_sunit)); - $logger->info("sunit-alter: updated sunit ".OpenSRF::Utils::JSON->perl2JSON($sunit)); - return $editor->event unless $editor->update_serial_unit($sunit); - return 0; -} - -__PACKAGE__->register_method( - method => "retrieve_unit_list", - authoritative => 1, - api_name => "open-ils.serial.unit_list.retrieve" -); - -sub retrieve_unit_list { - - my( $self, $client, @sdist_ids ) = @_; - - if(ref($sdist_ids[0])) { @sdist_ids = @{$sdist_ids[0]}; } - - my $e = new_editor(); - - my $query = { - 'select' => - { 'sunit' => [ 'id', 'summary_contents', 'sort_key' ], - 'sitem' => ['stream'], - 'sstr' => ['distribution'], - 'sdist' => [{'column' => 'label', 'alias' => 'sdist_label'}] - }, - 'from' => - { 'sdist' => - { 'sstr' => - { 'join' => - { 'sitem' => - { 'join' => { 'sunit' => {} } } - } - } - } - }, - 'distinct' => 'true', - 'where' => { '+sdist' => {'id' => \@sdist_ids} }, - 'order_by' => [{'class' => 'sunit', 'field' => 'sort_key'}] - }; - - my $unit_list_entries = $e->json_query($query); - - my @entries; - foreach my $entry (@$unit_list_entries) { - my $value = {'sunit' => $entry->{id}, 'sstr' => $entry->{stream}, 'sdist' => $entry->{distribution}}; - my $label = $entry->{summary_contents}; - if (length($label) > 100) { - $label = substr($label, 0, 100) . '...'; # limited space in dropdown / menu - } - $label = "[$entry->{sdist_label}/$entry->{stream} #$entry->{id}] " . $label; - push (@entries, [$label, OpenSRF::Utils::JSON->perl2JSON($value)]); - } - - return \@entries; -} - - - -########################################################################## -# predict and receive methods -# -__PACKAGE__->register_method( - method => 'make_predictions', - api_name => 'open-ils.serial.make_predictions', - api_level => 1, - argc => 1, - signature => { - desc => 'Receives an ssub id and populates the issuance and item tables', - 'params' => [ { - name => 'ssub_id', - desc => 'Serial Subscription ID', - type => 'int' - } - ] - } -); - -sub make_predictions { - my ($self, $conn, $authtoken, $args) = @_; - - my $editor = OpenILS::Utils::CStoreEditor->new(); - my $ssub_id = $args->{ssub_id}; - my $mfhd = MFHD->new(MARC::Record->new()); - - my $ssub = $editor->retrieve_serial_subscription([$ssub_id]); - my $scaps = $editor->search_serial_caption_and_pattern({ subscription => $ssub_id, active => 't'}); - my $sdists = $editor->search_serial_distribution( [{ subscription => $ssub->id }, { flesh => 1, flesh_fields => {sdist => [ qw/ streams / ]} }] ); #TODO: 'deleted' support? - - my $total_streams = 0; - foreach (@$sdists) { - $total_streams += scalar(@{$_->streams}); - } - if ($total_streams < 1) { - $editor->disconnect; - # XXX TODO new event type - return new OpenILS::Event( - "BAD_PARAMS", note => - "There are no streams to direct items. Can't predict." - ); - } - - unless (@$scaps) { - $editor->disconnect; - # XXX TODO new event type - return new OpenILS::Event( - "BAD_PARAMS", note => - "There are no active caption-and-pattern objects associated " . - "with this subscription. Can't predict." - ); - } - - my @predictions; - my $link_id = 1; - foreach my $scap (@$scaps) { - my $caption_field = _revive_caption($scap); - $caption_field->update('8' => $link_id); - my $using_fake_chron = 0; - # if we have no chronology, add one for prediction puposes - if (!$caption_field->subfield('i') and !$caption_field->enumeration_is_chronology) { - $using_fake_chron = 1; - } - $mfhd->append_fields($caption_field); - my $options = { - 'caption' => $caption_field, - 'scap_id' => $scap->id, - 'num_to_predict' => $args->{num_to_predict}, - 'end_date' => defined $args->{end_date} ? - $_strp_date->parse_datetime($args->{end_date}) : undef - }; - if ($args->{base_issuance}) { # predict from a given issuance - $options->{predict_from} = _revive_holding($args->{base_issuance}->holding_code, $caption_field, 1); # fresh MFHD Record, so we simply default to 1 for seqno - $options->{faked_chron_date} = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($args->{base_issuance}->date_published)) if $using_fake_chron; - } else { # default to predicting from last published - my $last_published = $editor->search_serial_issuance([ - {'caption_and_pattern' => $scap->id, - 'subscription' => $ssub_id}, - {limit => 1, order_by => { siss => "date_published DESC" }}] - ); - if ($last_published->[0]) { - my $last_siss = $last_published->[0]; - unless ($last_siss->holding_code) { - $editor->disconnect; - # XXX TODO new event type - return new OpenILS::Event( - "BAD_PARAMS", note => - "Last issuance has no holding code. Can't predict." - ); - } - $options->{predict_from} = _revive_holding($last_siss->holding_code, $caption_field, 1); - $options->{faked_chron_date} = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($last_siss->date_published)) if $using_fake_chron; - } else { - $editor->disconnect; - # XXX TODO make a new event type instead of hijacking this one - return new OpenILS::Event( - "BAD_PARAMS", note => "No issuance from which to predict!" - ); - } - } - push( @predictions, _generate_issuance_values($mfhd, $options) ); - $link_id++; - } - - my @issuances; - foreach my $prediction (@predictions) { - my $issuance = new Fieldmapper::serial::issuance; - $issuance->isnew(1); - $issuance->label($prediction->{label}); - $issuance->date_published($prediction->{date_published}->strftime('%F')); - $issuance->holding_code(OpenSRF::Utils::JSON->perl2JSON($prediction->{holding_code})); - $issuance->holding_type($prediction->{holding_type}); - $issuance->caption_and_pattern($prediction->{caption_and_pattern}); - $issuance->subscription($ssub->id); - push (@issuances, $issuance); - } - - fleshed_issuance_alter($self, $conn, $authtoken, \@issuances); # FIXME: catch events - - my @items; - for (my $i = 0; $i < @issuances; $i++) { - my $date_expected = $predictions[$i]->{date_published}->add(seconds => interval_to_seconds($ssub->expected_date_offset))->strftime('%F'); - my $issuance = $issuances[$i]; - #$issuance->label(interval_to_seconds($ssub->expected_date_offset)); - foreach my $sdist (@$sdists) { - my $streams = $sdist->streams; - foreach my $stream (@$streams) { - my $item = new Fieldmapper::serial::item; - $item->isnew(1); - $item->stream($stream->id); - $item->date_expected($date_expected); - $item->issuance($issuance->id); - push (@items, $item); - } - } - } - fleshed_item_alter($self, $conn, $authtoken, \@items); # FIXME: catch events - return \@items; -} - -# -# _generate_issuance_values() is an initial attempt at a function which can be used -# to populate an issuance table with a list of predicted issues. It accepts -# a hash ref of options initially defined as: -# caption : the caption field to predict on -# num_to_predict : the number of issues you wish to predict -# last_rec_date : the date of the last received issue, to be used as an offset -# for predicting future issues -# faked_chron_date : if the serial does not actually have a chronology caption (but we need one for prediction's sake), base predictions on this date -# -# The basic method is to first convert to a single holding if compressed, then -# increment the holding and save the resulting values to @issuances. -# -# returns @issuance_values, an array of hashrefs containing (formatted -# label, formatted chronology date, formatted estimated arrival date, and an -# array ref of holding subfields as (key, value, key, value ...)) (not a hash -# to protect order and possible duplicate keys), and a holding type. -# -sub _generate_issuance_values { - my ($mfhd, $options) = @_; - my $caption = $options->{caption}; - my $scap_id = $options->{scap_id}; - my $num_to_predict = $options->{num_to_predict}; - my $end_date = $options->{end_date}; - my $predict_from = $options->{predict_from}; # issuance to predict from - my $faked_chron_date = $options->{faked_chron_date}; # serial does not have a chronology caption, so add one (temporarily) based on this date - #my $last_rec_date = $options->{last_rec_date}; # expected or actual - - -# Only needed for 'real' MFHD records, not our temp records -# my $link_id = $caption->link_id; -# if(!$predict_from) { -# my $htag = $caption->tag; -# $htag =~ s/^85/86/; -# my @holdings = $mfhd->holdings($htag, $link_id); -# my $last_holding = $holdings[-1]; -# -# #if ($last_holding->is_compressed) { -# # $last_holding->compressed_to_last; # convert to last in range -# #} -# $predict_from = $last_holding; -# } -# - - $predict_from->notes('public', []); -# add a note marker for system use (?) - $predict_from->notes('private', ['AUTOGEN']); - - # our basic method for dealing with 'faked' chronologies will be to add it in, do the predicting, then take it back out - my $orig_caption; - my $faked_caption; - if ($faked_chron_date) { - $orig_caption = $predict_from->caption; - # because of the way MFHD::Caption and Holding work, it is simplest - # to recreate rather than try to update - $faked_caption = new MFHD::Caption(new MARC::Field($orig_caption->tag, $orig_caption->indicator(1), $orig_caption->indicator(2), $orig_caption->subfields_list, 'i' => '(year)', 'j' => '(month)', 'k' => '(day)')); - $predict_from = new MFHD::Holding($predict_from->seqno, new MARC::Field($predict_from->tag, $predict_from->indicator(1), $predict_from->indicator(2), $predict_from->subfields_list, 'i' => $faked_chron_date->year, 'j' => $faked_chron_date->month, 'k' => $faked_chron_date->day), $faked_caption); - } - - my @predictions = $mfhd->generate_predictions({'base_holding' => $predict_from, 'num_to_predict' => $num_to_predict, 'end_date' => $end_date}); - - my $pub_date; - my @issuance_values; - foreach my $prediction (@predictions) { - $pub_date = $_strp_date->parse_datetime($prediction->chron_to_date); - if ($faked_chron_date) { # get rid of the chronology portions and restore original caption - $prediction->delete_subfield(code => ['i', 'j', 'k']); - $prediction = new MFHD::Holding($prediction->seqno, new MARC::Field($prediction->tag, $prediction->indicator(1), $prediction->indicator(2), $prediction->subfields_list), $orig_caption); - } - push( - @issuance_values, - { - #$link_id, - label => $prediction->format, - date_published => $pub_date, - #date_expected => $date_expected->strftime('%F'), - holding_code => [$prediction->indicator(1),$prediction->indicator(2),$prediction->subfields_list], - holding_type => $MFHD_NAMES_BY_TAG{$caption->tag}, - caption_and_pattern => $scap_id - } - ); - } - - return @issuance_values; -} - -sub _revive_caption { - my $scap = shift; - - my $pattern_code = $scap->pattern_code; - - # build MARC::Field - my $pattern_parts = OpenSRF::Utils::JSON->JSON2perl($pattern_code); - unshift(@$pattern_parts, $MFHD_TAGS_BY_NAME{$scap->type}); - my $pattern_field = new MARC::Field(@$pattern_parts); - - # build MFHD::Caption - return new MFHD::Caption($pattern_field); -} - -sub _revive_holding { - my $holding_code = shift; - my $caption_field = shift; - my $seqno = shift; - - # build MARC::Field - my $holding_parts = OpenSRF::Utils::JSON->JSON2perl($holding_code); - my $captag = $caption_field->tag; - $captag =~ s/^85/86/; - unshift(@$holding_parts, $captag); - my $holding_field = new MARC::Field(@$holding_parts); - - # build MFHD::Holding - return new MFHD::Holding($seqno, $holding_field, $caption_field); -} - -__PACKAGE__->register_method( - method => 'unitize_items', - api_name => 'open-ils.serial.receive_items', - api_level => 1, - argc => 1, - signature => { - desc => 'Marks an item as received, updates the shelving unit (creating a new shelving unit if needed), and updates the summaries', - 'params' => [ { - name => 'items', - desc => 'array of serial items', - type => 'array' - }, - { - name => 'barcodes', - desc => 'hash of item_ids => barcodes', - type => 'hash' - }, - { - name => 'call_numbers', - desc => 'hash of item_ids => call_numbers', - type => 'hash' - } - ], - 'return' => { - desc => 'Returns number of received items (num_items) and new unit ID, if applicable (new_unit_id)', - type => 'hashref' - } - } -); - -__PACKAGE__->register_method( - method => 'unitize_items', - api_name => 'open-ils.serial.bind_items', - api_level => 1, - argc => 1, - signature => { - desc => 'Marks an item as bound, updates the shelving unit (creating a new shelving unit if needed)', - 'params' => [ { - name => 'items', - desc => 'array of serial items', - type => 'array' - }, - { - name => 'barcodes', - desc => 'hash of item_ids => barcodes', - type => 'hash' - }, - { - name => 'call_numbers', - desc => 'hash of item_ids => call_numbers', - type => 'hash' - } - ], - 'return' => { - desc => 'Returns number of bound items (num_items) and new unit ID, if applicable (new_unit_id)', - type => 'hashref' - } - } -); - -# TODO: reset/delete claims information once implemented -# XXX: deal with emptied call numbers here? -__PACKAGE__->register_method( - method => 'unitize_items', - api_name => 'open-ils.serial.reset_items', - api_level => 1, - argc => 1, - signature => { - desc => 'Resets the items to Expected, updates the shelving unit (deleting the shelving unit if empty), and updates the summaries', - 'params' => [ { - name => 'items', - desc => 'array of serial items', - type => 'array' - } - ], - 'return' => { - desc => 'Returns number of reset items (num_items)', - type => 'hashref' - } - } -); - -sub unitize_items { - my ($self, $conn, $auth, $items, $barcodes, $call_numbers) = @_; - - my $editor = new_editor("authtoken" => $auth, "xact" => 1); - return $editor->die_event unless $editor->checkauth; - return $editor->die_event unless $editor->allowed("RECEIVE_SERIAL"); - $self->api_name =~ /serial\.(\w*)_items/; - my $mode = $1; - - my %found_unit_ids; - my %found_stream_ids; - my %found_types; - - my %stream_ids_by_unit_id; - - my %unit_map; - my %sdist_by_unit_id; - my %call_number_by_unit_id; - my %sdist_by_stream_id; - - my $new_unit_id; # id for '-2' units to share - foreach my $item (@$items) { - # for debugging only, TODO: delete - if (!ref $item) { # hopefully we got an id instead - $item = $editor->retrieve_serial_item($item); - } - # get ids - my $unit_id = ref($item->unit) ? $item->unit->id : $item->unit; - my $stream_id = ref($item->stream) ? $item->stream->id : $item->stream; - my $issuance_id = ref($item->issuance) ? $item->issuance->id : $item->issuance; - #TODO: evt on any missing ids - - if ($mode eq 'receive') { - $item->date_received('now'); - $item->status('Received'); - } elsif ($mode eq 'reset') { - # clear date_received - $item->clear_date_received; - # Set status to 'Expected' - $item->status('Expected'); - # remove from unit - $item->clear_unit; - } - - # check for types to trigger summary updates - my $scap; - if (!ref $item->issuance) { - my $scaps = $editor->search_serial_caption_and_pattern([{"+siss" => {"id" => $issuance_id}}, { "join" => {"siss" => {}} }]); - $scap = $scaps->[0]; - } elsif (!ref $item->issuance->caption_and_pattern) { - $scap = $editor->retrieve_serial_caption_and_pattern($item->issuance->caption_and_pattern); - } else { - $scap = $editor->issuance->caption_and_pattern; - } - if (!exists($found_types{$stream_id})) { - $found_types{$stream_id} = {}; - } - $found_types{$stream_id}->{$scap->type} = 1; - - # create unit if needed - if ($unit_id == -1 or (!$new_unit_id and $unit_id == -2)) { # create unit per item - my $unit; - my $sdists = $editor->search_serial_distribution([ - {"+sstr" => {"id" => $stream_id}}, - { - "join" => {"sstr" => {}}, - "flesh" => 1, - "flesh_fields" => {"sdist" => ["subscription"]} - }]); - $unit = _build_unit($editor, $sdists->[0], $mode); - # if _build_unit fails, $unit is an event, so return it - if ($U->event_code($unit)) { - $editor->rollback; - $unit->{"note"} = "Item ID: " . $item->id; - return $unit; - } - $unit->barcode($barcodes->{$item->id}) if exists($barcodes->{$item->id}); - my $evt = _create_sunit($editor, $unit); - return $evt if $evt; - if ($unit_id == -2) { - $new_unit_id = $unit->id; - $unit_id = $new_unit_id; - } else { - $unit_id = $unit->id; - } - $item->unit($unit_id); - - # get unit with 'DEFAULT's and save unit, sdist, and call number for later use - $unit = $editor->retrieve_serial_unit($unit->id); - $unit_map{$unit_id} = $unit; - $sdist_by_unit_id{$unit_id} = $sdists->[0]; - $call_number_by_unit_id{$unit_id} = $call_numbers->{$item->id}; - $sdist_by_stream_id{$stream_id} = $sdists->[0]; - } elsif ($unit_id == -2) { # create one unit for all '-2' items - $unit_id = $new_unit_id; - $item->unit($unit_id); - } - - $found_stream_ids{$stream_id} = 1; - - if (defined($unit_id)) { - $found_unit_ids{$unit_id} = 1; - # save the stream_id for this unit_id - # TODO: prevent items from different streams in same unit? (perhaps in interface) - $stream_ids_by_unit_id{$unit_id} = $stream_id; - } - - my $evt = _update_sitem($editor, undef, $item); - return $evt if $evt; - } - - # cleanup 'dead' units (units which are now emptied of their items) - my $dead_units = $editor->search_serial_unit([{'+sitem' => {'id' => undef}, 'deleted' => 'f'}, {'join' => {'sitem' => {'type' => 'left'}}}]); - foreach my $unit (@$dead_units) { - _delete_sunit($editor, undef, $unit); - delete $found_unit_ids{$unit->id}; - } - - # deal with unit level contents - foreach my $unit_id (keys %found_unit_ids) { - - # get all the needed issuances for unit - # TODO remove 'Bindery' from this search (leaving it in for now for backwards compatibility with any current test environment data) - my $issuances = $editor->search_serial_issuance([ {"+sitem" => {"unit" => $unit_id, "status" => ["Received", "Bindery"]}}, {"join" => {"sitem" => {}}, "order_by" => {"siss" => "date_published"}} ]); - #TODO: evt on search failure - - # retrieve and update unit contents - my $sunit; - my $sdist; - my $call_number_string; - my $record_id; - # if we just created the unit, we will already have it and the distribution stored, and we will need to assign the call number - if (exists $unit_map{$unit_id}) { - $sunit = $unit_map{$unit_id}; - $sdist = $sdist_by_unit_id{$unit_id}; - $call_number_string = $call_number_by_unit_id{$unit_id}; - $record_id = $sdist->subscription->record_entry; - } else { - $sunit = $editor->retrieve_serial_unit($unit_id); - $sdist = $editor->search_serial_distribution([{"+sstr" => {"id" => $stream_ids_by_unit_id{$unit_id}}}, { "join" => {"sstr" => {}} }]); - $sdist = $sdist->[0]; - } - - my $evt = _prepare_unit($editor, $sunit, $sdist, $issuances, $call_number_string, $record_id); - if ($U->event_code($evt)) { - $editor->rollback; - return $evt; - } - - $evt = _update_sunit($editor, undef, $sunit); - if ($U->event_code($evt)) { - $editor->rollback; - return $evt; - } - } - - if ($mode ne 'bind') { # the summary holdings do not change when binding - # deal with stream level summaries - # summaries will be built from the "primary" stream only, that is, the stream with the lowest ID per distribution - # (TODO: consider direct designation) - my %primary_streams_by_sdist; - my %streams_by_sdist; - - # see if we have primary streams, and if so, associate them with their distributions - foreach my $stream_id (keys %found_stream_ids) { - my $sdist; - if (exists $sdist_by_stream_id{$stream_id}) { - $sdist = $sdist_by_stream_id{$stream_id}; - } else { - $sdist = $editor->search_serial_distribution([{"+sstr" => {"id" => $stream_id}}, { "join" => {"sstr" => {}} }]); - $sdist = $sdist->[0]; - } - my $streams; - if (!exists($streams_by_sdist{$sdist->id})) { - $streams = $editor->search_serial_stream([{"distribution" => $sdist->id}, {"order_by" => {"sstr" => "id"}}]); - $streams_by_sdist{$sdist->id} = $streams; - } else { - $streams = $streams_by_sdist{$sdist->id}; - } - $primary_streams_by_sdist{$sdist->id} = $streams->[0] if ($stream_id == $streams->[0]->id); - } - - # retrieve and update summaries for each affected primary stream's distribution - foreach my $sdist_id (keys %primary_streams_by_sdist) { - my $stream = $primary_streams_by_sdist{$sdist_id}; - my $stream_id = $stream->id; - # get all the needed issuances for stream - # FIXME: search in Bindery/Bound/Not Published? as well as Received - foreach my $type (keys %{$found_types{$stream_id}}) { - my $issuances = $editor->search_serial_issuance([ {"+sitem" => {"stream" => $stream_id, "status" => "Received"}, "+scap" => {"type" => $type}}, {"join" => {"sitem" => {}, "scap" => {}}, "order_by" => {"siss" => "date_published"}} ]); - #TODO: evt on search failure - my $evt = _prepare_summaries($editor, $issuances, $sdist_id, $type); - if ($U->event_code($evt)) { - $editor->rollback; - return $evt; - } - } - } - } - - $editor->commit; - return {'num_items' => scalar @$items, 'new_unit_id' => $new_unit_id}; -} - -sub _find_or_create_call_number { - my ($e, $lib, $cn_string, $record) = @_; - - my $existing = $e->search_asset_call_number({ - "owning_lib" => $lib, - "label" => $cn_string, - "record" => $record, - "deleted" => "f" - }) or return $e->die_event; - - if (@$existing) { - return $existing->[0]->id; - } else { - return $e->die_event unless - $e->allowed("CREATE_VOLUME", $lib); - - my $acn = new Fieldmapper::asset::call_number; - - $acn->creator($e->requestor->id); - $acn->editor($e->requestor->id); - $acn->record($record); - $acn->label($cn_string); - $acn->owning_lib($lib); - - $e->create_asset_call_number($acn) or return $e->die_event; - return $e->data->id; - } -} - -sub _issuances_received { - # XXX TODO: Add some caching or something. This is getting called - # more often than it has to be. - my ($e, $sitem) = @_; - - my $results = $e->json_query({ - "select" => {"sitem" => ["issuance"]}, - "from" => {"sitem" => {"sstr" => {}, "siss" => {}}}, - "where" => { - "+sstr" => {"distribution" => $sitem->stream->distribution->id}, - "+siss" => {"holding_type" => $sitem->issuance->holding_type}, - "+sitem" => {"date_received" => {"!=" => undef}} - }, - "order_by" => { - "siss" => {"date_published" => {"direction" => "asc"}} - } - }) or return $e->die_event; - - my $uniq = +{map { $_->{"issuance"} => 1 } @$results}; - return [ map { $e->retrieve_serial_issuance($_) } keys %$uniq ]; -} - -# _prepare_unit populates the detailed_contents, summary_contents, and -# sort_key fields for a given unit based on a given set of issuances -# Also finds/creates call number as needed -sub _prepare_unit { - my ($e, $sunit, $sdist, $issuances, $call_number_string, $record_id) = @_; - - # Handle call number first if we have one - if ($call_number_string) { - my $org_unit_id = ref $sdist->holding_lib ? $sdist->holding_lib->id : $sdist->holding_lib; - my $real_cn = _find_or_create_call_number( - $e, $org_unit_id, - $call_number_string, $record_id - ); - - if ($U->event_code($real_cn)) { - return $real_cn; - } else { - $sunit->call_number($real_cn); - } - } - - my ($mfhd, $formatted_parts) = _summarize_contents($e, $issuances); - - # special case for single formatted_part (may have summarized version) - if (@$formatted_parts == 1) { - #TODO: MFHD.pm should have a 'format_summary' method for this - } - - $sunit->detailed_contents( - join( - " ", - $sdist->unit_label_prefix, - join(", ", @$formatted_parts), - $sdist->unit_label_suffix - ) - ); - - # TODO: change this when real summary contents are available - $sunit->summary_contents($sunit->detailed_contents); - - # Create sort_key by left padding numbers to 6 digits. - (my $sort_key = $sunit->detailed_contents) =~ - s/(\d+)/sprintf '%06d', $1/eg; - $sunit->sort_key($sort_key); -} - -# _prepare_summaries populates the generated_coverage field for a given summary -# type ('basic', 'index', 'supplement') for a given distribution. -# It also creates the summary if it doesn't yet exist. -sub _prepare_summaries { - my ($e, $issuances, $dist_id, $type) = @_; - - my ($mfhd, $formatted_parts) = _summarize_contents($e, $issuances); - - my $search_method = "search_serial_${type}_summary"; - my $summary = $e->$search_method([{"distribution" => $dist_id}]); - - my $cu_method = "update"; - - if (@$summary) { - $summary = $summary->[0]; - } else { - my $class = "Fieldmapper::serial::${type}_summary"; - $summary = $class->new; - $summary->distribution($dist_id); - $cu_method = "create"; - } - - $summary->generated_coverage(join(", ", @$formatted_parts)); - my $method = "${cu_method}_serial_${type}_summary"; - return $e->die_event unless $e->$method($summary); -} - -sub _unit_by_iss_and_str { - my ($e, $issuance, $stream) = @_; - - my $unit = $e->json_query({ - "select" => {"sunit" => ["id"]}, - "from" => {"sitem" => {"sunit" => {}}}, - "where" => { - "+sitem" => { - "issuance" => $issuance->id, - "stream" => $stream->id - } - } - }) or return $e->die_event; - return 0 if not @$unit; - - $e->retrieve_serial_unit($unit->[0]->{"id"}) or $e->die_event; -} - -sub move_previous_unit { - my ($e, $prev_iss, $curr_item, $new_loc) = @_; - - my $prev_unit = _unit_by_iss_and_str($e,$prev_iss,$curr_item->stream); - return $prev_unit if defined $U->event_code($prev_unit); - return 0 if not $prev_unit; - - if ($prev_unit->location != $new_loc) { - $prev_unit->location($new_loc); - $e->update_serial_unit($prev_unit) or return $e->die_event; - } - 0; -} - -# _previous_issuance() assumes $existing is an ordered array -sub _previous_issuance { - my ($existing, $issuance) = @_; - - my $last = $existing->[-1]; - return undef unless $last; - return ($last->id == $issuance->id ? $existing->[-2] : $last); -} - -__PACKAGE__->register_method( - "method" => "receive_items_one_unit_per", - "api_name" => "open-ils.serial.receive_items.one_unit_per", - "stream" => 1, - "api_level" => 1, - "argc" => 3, - "signature" => { - "desc" => "Marks items in a list as received, creates a new unit for each item if any unit is fleshed on, and updates summaries as needed", - "params" => [ - { - "name" => "auth", - "desc" => "authtoken", - "type" => "string" - }, - { - "name" => "items", - "desc" => "array of serial items, possibly fleshed with units and definitely fleshed with stream->distribution", - "type" => "array" - }, - { - "name" => "record", - "desc" => "id of bib record these items are associated with - (XXX could/should be derived from items)", - "type" => "number" - } - ], - "return" => { - "desc" => "The item ID for each item successfully received", - "type" => "int" - } - } -); - -sub receive_items_one_unit_per { - # XXX This function may be temporary, as it does some of what - # unitize_items() does, just in a different way. - my ($self, $client, $auth, $items, $record) = @_; - - my $e = new_editor("authtoken" => $auth, "xact" => 1); - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed("RECEIVE_SERIAL"); - - my $prev_loc_setting_map = {}; - my $user_id = $e->requestor->id; - - # Get a list of all the non-virtual field names in a serial::unit for - # merging given unit objects with template-built units later. - # XXX move this somewhere global so it isn't re-run all the time - my $all_unit_fields = - $Fieldmapper::fieldmap->{"Fieldmapper::serial::unit"}->{"fields"}; - my @real_unit_fields = grep { - not $all_unit_fields->{$_}->{"virtual"} - } keys %$all_unit_fields; - - foreach my $item (@$items) { - # Note that we expect a certain fleshing on the items we're getting. - my $sdist = $item->stream->distribution; - - # Fetch a list of issuances with received copies already existing - # on this distribution (and with the same holding type on the - # issuance). This will be used in up to two places: once when building - # a summary, once when changing the copy location of the previous - # issuance's copy. - my $issuances_received = _issuances_received($e, $item); - if ($U->event_code($issuances_received)) { - $e->rollback; - return $issuances_received; - } - - # Find out if we need to to deal with previous copy location changing. - my $ou = $sdist->holding_lib->id; - unless (exists $prev_loc_setting_map->{$ou}) { - $prev_loc_setting_map->{$ou} = $U->ou_ancestor_setting_value( - $ou, "serial.prev_issuance_copy_location", $e - ); - } - - # If there is a previous copy location setting, we need the previous - # issuance, from which we can in turn look up the item attached to the - # same stream we're on now. - if ($prev_loc_setting_map->{$ou}) { - if (my $prev_iss = - _previous_issuance($issuances_received, $item->issuance)) { - - # Now we can change the copy location of the previous unit, - # if needed. - return $e->event if defined $U->event_code( - move_previous_unit( - $e, $prev_iss, $item, $prev_loc_setting_map->{$ou} - ) - ); - } - } - - # Create unit if given by user - if (ref $item->unit) { - # detach from the item, as we need to create separately - my $user_unit = $item->unit; - - # get a unit based on associated template - my $template_unit = _build_unit($e, $sdist, "receive"); - if ($U->event_code($template_unit)) { - $e->rollback; - $template_unit->{"note"} = "Item ID: " . $item->id; - return $template_unit; - } - - # merge built unit with provided unit from user - foreach (@real_unit_fields) { - unless ($user_unit->$_) { - $user_unit->$_($template_unit->$_); - } - } - - # Treat call number specially: the provided value from the - # user will really be a string. - my $call_number_string; - if ($user_unit->call_number) { - $call_number_string = $user_unit->call_number; - # clear call number for now (replaced in _prepare_unit) - $user_unit->clear_call_number; - } - - my $evt = _prepare_unit( - $e, $user_unit, $sdist, [$item->issuance], - $call_number_string, $record - ); - if ($U->event_code($evt)) { - $e->rollback; - return $evt; - } - - # create/update summary objects related to this distribution - # Make sure @$issuances_received contains current item's issuance - unless (grep { $_->id == $item->issuance->id } @$issuances_received) { - push @$issuances_received, $item->issuance; - } - $evt = _prepare_summaries($e, $issuances_received, $item->stream->distribution->id, $item->issuance->holding_type); - if ($U->event_code($evt)) { - $e->rollback; - return $evt; - } - - # set the incontrovertibles on the unit - $user_unit->edit_date("now"); - $user_unit->create_date("now"); - $user_unit->editor($user_id); - $user_unit->creator($user_id); - - return $e->die_event unless $e->create_serial_unit($user_unit); - - # save reference to new unit - $item->unit($e->data->id); - } - - # Create notes if given by user - if (ref($item->notes) and @{$item->notes}) { - foreach my $note (@{$item->notes}) { - $note->creator($user_id); - $note->create_date("now"); - - return $e->die_event unless $e->create_serial_item_note($note); - } - - $item->clear_notes; # They're saved; we no longer want them here. - } - - # Set the incontrovertibles on the item - $item->status("Received"); - $item->date_received("now"); - $item->edit_date("now"); - $item->editor($user_id); - - return $e->die_event unless $e->update_serial_item($item); - - # send client a response - $client->respond($item->id); - } - - $e->commit or return $e->die_event; - undef; -} - -sub _build_unit { - my $editor = shift; - my $sdist = shift; - my $mode = shift; - #my $skip_call_number = shift; - - my $attr = $mode . '_unit_template'; - my $template = $editor->retrieve_asset_copy_template($sdist->$attr) or - return new OpenILS::Event("SERIAL_DISTRIBUTION_HAS_NO_COPY_TEMPLATE"); - - my @parts = qw( status location loan_duration fine_level age_protect circulate deposit ref holdable deposit_amount price circ_modifier circ_as_type alert_message opac_visible floating mint_condition ); - - my $unit = new Fieldmapper::serial::unit; - foreach my $part (@parts) { - my $value = $template->$part; - next if !defined($value); - $unit->$part($value); - } - - # ignore circ_lib in template, set to distribution holding_lib - $unit->circ_lib($sdist->holding_lib); - $unit->creator($editor->requestor->id); - $unit->editor($editor->requestor->id); - -# XXX: this feature has been pushed back until after 2.0 at least -# unless ($skip_call_number) { -# $attr = $mode . '_call_number'; -# my $cn = $sdist->$attr or -# return new OpenILS::Event("SERIAL_DISTRIBUTION_HAS_NO_CALL_NUMBER"); -# -# $unit->call_number($cn); -# } - $unit->call_number('-1'); # default to the dummy call number - $unit->barcode('@@PLACEHOLDER'); # generic unit will start with a generated placeholder barcode - $unit->sort_key(''); - $unit->summary_contents(''); - $unit->detailed_contents(''); - - return $unit; -} - - -sub _summarize_contents { - my $editor = shift; - my $issuances = shift; - - # create MFHD record - my $mfhd = MFHD->new(MARC::Record->new()); - my %scaps; - my %scap_fields; - my @scap_fields_ordered; - my $seqno = 1; - my $link_id = 1; - foreach my $issuance (@$issuances) { - my $scap_id = $issuance->caption_and_pattern; - next if (!$scap_id); # skip issuances with no caption/pattern - - my $scap; - my $scap_field; - # if this is the first appearance of this scap, retrieve it and add it to the temporary record - if (!exists $scaps{$issuance->caption_and_pattern}) { - $scaps{$scap_id} = $editor->retrieve_serial_caption_and_pattern($scap_id); - $scap = $scaps{$scap_id}; - $scap_field = _revive_caption($scap); - $scap_fields{$scap_id} = $scap_field; - push(@scap_fields_ordered, $scap_field); - $scap_field->update('8' => $link_id); - $mfhd->append_fields($scap_field); - $link_id++; - } else { - $scap = $scaps{$scap_id}; - $scap_field = $scap_fields{$scap_id}; - } - - $mfhd->append_fields(_revive_holding($issuance->holding_code, $scap_field, $seqno)); - $seqno++; - } - - my @formatted_parts; - foreach my $scap_field (@scap_fields_ordered) { #TODO: use generic MFHD "summarize" method, once available - my @updated_holdings = $mfhd->get_compressed_holdings($scap_field); - foreach my $holding (@updated_holdings) { - push(@formatted_parts, $holding->format); - } - } - - return ($mfhd, \@formatted_parts); -} - -########################################################################## -# note methods -# -__PACKAGE__->register_method( - method => 'fetch_notes', - api_name => 'open-ils.serial.item_note.retrieve.all', - signature => q/ - Returns an array of copy note objects. - @param args A named hash of parameters including: - authtoken : Required if viewing non-public notes - item_id : The id of the item whose notes we want to retrieve - pub : True if all the caller wants are public notes - @return An array of note objects - / -); - -__PACKAGE__->register_method( - method => 'fetch_notes', - api_name => 'open-ils.serial.subscription_note.retrieve.all', - signature => q/ - Returns an array of copy note objects. - @param args A named hash of parameters including: - authtoken : Required if viewing non-public notes - subscription_id : The id of the item whose notes we want to retrieve - pub : True if all the caller wants are public notes - @return An array of note objects - / -); - -__PACKAGE__->register_method( - method => 'fetch_notes', - api_name => 'open-ils.serial.distribution_note.retrieve.all', - signature => q/ - Returns an array of copy note objects. - @param args A named hash of parameters including: - authtoken : Required if viewing non-public notes - distribution_id : The id of the item whose notes we want to retrieve - pub : True if all the caller wants are public notes - @return An array of note objects - / -); - -# TODO: revisit this method to consider replacing cstore direct calls -sub fetch_notes { - my( $self, $connection, $args ) = @_; - - $self->api_name =~ /serial\.(\w*)_note/; - my $type = $1; - - my $id = $$args{object_id}; - my $authtoken = $$args{authtoken}; - my( $r, $evt); - - if( $$args{pub} ) { - return $U->cstorereq( - 'open-ils.cstore.direct.serial.'.$type.'_note.search.atomic', - { $type => $id, pub => 't' } ); - } else { - # FIXME: restore perm check - # ( $r, $evt ) = $U->checksesperm($authtoken, 'VIEW_COPY_NOTES'); - # return $evt if $evt; - return $U->cstorereq( - 'open-ils.cstore.direct.serial.'.$type.'_note.search.atomic', {$type => $id} ); - } - - return undef; -} - -__PACKAGE__->register_method( - method => 'create_note', - api_name => 'open-ils.serial.item_note.create', - signature => q/ - Creates a new item note - @param authtoken The login session key - @param note The note object to create - @return The id of the new note object - / -); - -__PACKAGE__->register_method( - method => 'create_note', - api_name => 'open-ils.serial.subscription_note.create', - signature => q/ - Creates a new subscription note - @param authtoken The login session key - @param note The note object to create - @return The id of the new note object - / -); - -__PACKAGE__->register_method( - method => 'create_note', - api_name => 'open-ils.serial.distribution_note.create', - signature => q/ - Creates a new distribution note - @param authtoken The login session key - @param note The note object to create - @return The id of the new note object - / -); - -sub create_note { - my( $self, $connection, $authtoken, $note ) = @_; - - $self->api_name =~ /serial\.(\w*)_note/; - my $type = $1; - - my $e = new_editor(xact=>1, authtoken=>$authtoken); - return $e->event unless $e->checkauth; - - # FIXME: restore permission support -# my $item = $e->retrieve_serial_item( -# [ -# $note->item -# ] -# ); -# -# return $e->event unless -# $e->allowed('CREATE_COPY_NOTE', $item->call_number->owning_lib); - - $note->create_date('now'); - $note->creator($e->requestor->id); - $note->pub( ($U->is_true($note->pub)) ? 't' : 'f' ); - $note->clear_id; - - my $method = "create_serial_${type}_note"; - $e->$method($note) or return $e->event; - $e->commit; - return $note->id; -} - -__PACKAGE__->register_method( - method => 'delete_note', - api_name => 'open-ils.serial.item_note.delete', - signature => q/ - Deletes an existing item note - @param authtoken The login session key - @param noteid The id of the note to delete - @return 1 on success - Event otherwise. - / -); - -__PACKAGE__->register_method( - method => 'delete_note', - api_name => 'open-ils.serial.subscription_note.delete', - signature => q/ - Deletes an existing subscription note - @param authtoken The login session key - @param noteid The id of the note to delete - @return 1 on success - Event otherwise. - / -); - -__PACKAGE__->register_method( - method => 'delete_note', - api_name => 'open-ils.serial.distribution_note.delete', - signature => q/ - Deletes an existing distribution note - @param authtoken The login session key - @param noteid The id of the note to delete - @return 1 on success - Event otherwise. - / -); - -sub delete_note { - my( $self, $conn, $authtoken, $noteid ) = @_; - - $self->api_name =~ /serial\.(\w*)_note/; - my $type = $1; - - my $e = new_editor(xact=>1, authtoken=>$authtoken); - return $e->die_event unless $e->checkauth; - - my $method = "retrieve_serial_${type}_note"; - my $note = $e->$method([ - $noteid, - ]) or return $e->die_event; - -# FIXME: restore permissions check -# if( $note->creator ne $e->requestor->id ) { -# return $e->die_event unless -# $e->allowed('DELETE_COPY_NOTE', $note->item->call_number->owning_lib); -# } - - $method = "delete_serial_${type}_note"; - $e->$method($note) or return $e->die_event; - $e->commit; - return 1; -} - - -########################################################################## -# subscription methods -# -__PACKAGE__->register_method( - method => 'fleshed_ssub_alter', - api_name => 'open-ils.serial.subscription.fleshed.batch.update', - api_level => 1, - argc => 2, - signature => { - desc => 'Receives an array of one or more subscriptions and updates the database as needed', - 'params' => [ { - name => 'authtoken', - desc => 'Authtoken for current user session', - type => 'string' - }, - { - name => 'subscriptions', - desc => 'Array of fleshed subscriptions', - type => 'array' - } - - ], - 'return' => { - desc => 'Returns 1 if successful, event if failed', - type => 'mixed' - } - } -); - -sub fleshed_ssub_alter { - my( $self, $conn, $auth, $ssubs ) = @_; - return 1 unless ref $ssubs; - my( $reqr, $evt ) = $U->checkses($auth); - return $evt if $evt; - my $editor = new_editor(requestor => $reqr, xact => 1); - my $override = $self->api_name =~ /override/; - -# TODO: permission check -# return $editor->event unless -# $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy)); - - for my $ssub (@$ssubs) { - - my $ssubid = $ssub->id; - - if( $ssub->isdeleted ) { - $evt = _delete_ssub( $editor, $override, $ssub); - } elsif( $ssub->isnew ) { - _cleanse_dates($ssub, ['start_date','end_date']); - $evt = _create_ssub( $editor, $ssub ); - } else { - _cleanse_dates($ssub, ['start_date','end_date']); - $evt = _update_ssub( $editor, $override, $ssub ); - } - } - - if( $evt ) { - $logger->info("fleshed subscription-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt)); - $editor->rollback; - return $evt; - } - $logger->debug("subscription-alter: done updating subscription batch"); - $editor->commit; - $logger->info("fleshed subscription-alter successfully updated ".scalar(@$ssubs)." subscriptions"); - return 1; -} - -sub _delete_ssub { - my ($editor, $override, $ssub) = @_; - $logger->info("subscription-alter: delete subscription ".OpenSRF::Utils::JSON->perl2JSON($ssub)); - my $sdists = $editor->search_serial_distribution( - { subscription => $ssub->id }, { limit => 1 } ); #TODO: 'deleted' support? - my $cps = $editor->search_serial_caption_and_pattern( - { subscription => $ssub->id }, { limit => 1 } ); #TODO: 'deleted' support? - my $sisses = $editor->search_serial_issuance( - { subscription => $ssub->id }, { limit => 1 } ); #TODO: 'deleted' support? - return OpenILS::Event->new( - 'SERIAL_SUBSCRIPTION_NOT_EMPTY', payload => $ssub->id ) if (@$sdists or @$cps or @$sisses); - - return $editor->event unless $editor->delete_serial_subscription($ssub); - return 0; -} - -sub _create_ssub { - my ($editor, $ssub) = @_; - - $logger->info("subscription-alter: new subscription ".OpenSRF::Utils::JSON->perl2JSON($ssub)); - return $editor->event unless $editor->create_serial_subscription($ssub); - return 0; -} - -sub _update_ssub { - my ($editor, $override, $ssub) = @_; - - $logger->info("subscription-alter: retrieving subscription ".$ssub->id); - my $orig_ssub = $editor->retrieve_serial_subscription($ssub->id); - - $logger->info("subscription-alter: original subscription ".OpenSRF::Utils::JSON->perl2JSON($orig_ssub)); - $logger->info("subscription-alter: updated subscription ".OpenSRF::Utils::JSON->perl2JSON($ssub)); - return $editor->event unless $editor->update_serial_subscription($ssub); - return 0; -} - -__PACKAGE__->register_method( - method => "fleshed_serial_subscription_retrieve_batch", - authoritative => 1, - api_name => "open-ils.serial.subscription.fleshed.batch.retrieve" -); - -sub fleshed_serial_subscription_retrieve_batch { - my( $self, $client, $ids ) = @_; -# FIXME: permissions? - $logger->info("Fetching fleshed subscriptions @$ids"); - return $U->cstorereq( - "open-ils.cstore.direct.serial.subscription.search.atomic", - { id => $ids }, - { flesh => 1, - flesh_fields => {ssub => [ qw/owning_lib notes/ ]} - }); -} - -__PACKAGE__->register_method( - method => "retrieve_sub_tree", - authoritative => 1, - api_name => "open-ils.serial.subscription_tree.retrieve" -); - -__PACKAGE__->register_method( - method => "retrieve_sub_tree", - api_name => "open-ils.serial.subscription_tree.global.retrieve" -); - -sub retrieve_sub_tree { - - my( $self, $client, $user_session, $docid, @org_ids ) = @_; - - if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; } - - $docid = "$docid"; - - # TODO: permission support - if(!@org_ids and $user_session) { - my $user_obj = - OpenILS::Application::AppUtils->check_user_session( $user_session ); #throws EX on error - @org_ids = ($user_obj->home_ou); - } - - if( $self->api_name =~ /global/ ) { - return _build_subs_list( { record_entry => $docid } ); # TODO: filter for !deleted, or active? - - } else { - - my @all_subs; - for my $orgid (@org_ids) { - my $subs = _build_subs_list( - { record_entry => $docid, owning_lib => $orgid } );# TODO: filter for !deleted, or active? - push( @all_subs, @$subs ); - } - - return \@all_subs; - } - - return undef; -} - -sub _build_subs_list { - my $search_hash = shift; - - #$search_hash->{deleted} = 'f'; - my $e = new_editor(); - - my $subs = $e->search_serial_subscription([$search_hash, { 'order_by' => {'ssub' => 'id'} }]); - - my @built_subs; - - for my $sub (@$subs) { - - # TODO: filter on !deleted? - my $dists = $e->search_serial_distribution( - [{ subscription => $sub->id }, { 'order_by' => {'sdist' => 'label'} }] - ); - - #$dists = [ sort { $a->label cmp $b->label } @$dists ]; - - $sub->distributions($dists); - - # TODO: filter on !deleted? - my $issuances = $e->search_serial_issuance( - [{ subscription => $sub->id }, { 'order_by' => {'siss' => 'label'} }] - ); - - #$issuances = [ sort { $a->label cmp $b->label } @$issuances ]; - $sub->issuances($issuances); - - # TODO: filter on !deleted? - my $scaps = $e->search_serial_caption_and_pattern( - [{ subscription => $sub->id }, { 'order_by' => {'scap' => 'id'} }] - ); - - #$scaps = [ sort { $a->id cmp $b->id } @$scaps ]; - $sub->scaps($scaps); - push( @built_subs, $sub ); - } - - return \@built_subs; - -} - -__PACKAGE__->register_method( - method => "subscription_orgs_for_title", - authoritative => 1, - api_name => "open-ils.serial.subscription.retrieve_orgs_by_title" -); - -sub subscription_orgs_for_title { - my( $self, $client, $record_id ) = @_; - - my $subs = $U->simple_scalar_request( - "open-ils.cstore", - "open-ils.cstore.direct.serial.subscription.search.atomic", - { record_entry => $record_id }); # TODO: filter on !deleted? - - my $orgs = { map {$_->owning_lib => 1 } @$subs }; - return [ keys %$orgs ]; -} - - -########################################################################## -# distribution methods -# -__PACKAGE__->register_method( - method => 'fleshed_sdist_alter', - api_name => 'open-ils.serial.distribution.fleshed.batch.update', - api_level => 1, - argc => 2, - signature => { - desc => 'Receives an array of one or more distributions and updates the database as needed', - 'params' => [ { - name => 'authtoken', - desc => 'Authtoken for current user session', - type => 'string' - }, - { - name => 'distributions', - desc => 'Array of fleshed distributions', - type => 'array' - } - - ], - 'return' => { - desc => 'Returns 1 if successful, event if failed', - type => 'mixed' - } - } -); - -sub fleshed_sdist_alter { - my( $self, $conn, $auth, $sdists ) = @_; - return 1 unless ref $sdists; - my( $reqr, $evt ) = $U->checkses($auth); - return $evt if $evt; - my $editor = new_editor(requestor => $reqr, xact => 1); - my $override = $self->api_name =~ /override/; - -# TODO: permission check -# return $editor->event unless -# $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy)); - - for my $sdist (@$sdists) { - my $sdistid = $sdist->id; - - if( $sdist->isdeleted ) { - $evt = _delete_sdist( $editor, $override, $sdist); - } elsif( $sdist->isnew ) { - $evt = _create_sdist( $editor, $sdist ); - } else { - $evt = _update_sdist( $editor, $override, $sdist ); - } - } - - if( $evt ) { - $logger->info("fleshed distribution-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt)); - $editor->rollback; - return $evt; - } - $logger->debug("distribution-alter: done updating distribution batch"); - $editor->commit; - $logger->info("fleshed distribution-alter successfully updated ".scalar(@$sdists)." distributions"); - return 1; -} - -sub _delete_sdist { - my ($editor, $override, $sdist) = @_; - $logger->info("distribution-alter: delete distribution ".OpenSRF::Utils::JSON->perl2JSON($sdist)); - return $editor->event unless $editor->delete_serial_distribution($sdist); - return 0; -} - -sub _create_sdist { - my ($editor, $sdist) = @_; - - $logger->info("distribution-alter: new distribution ".OpenSRF::Utils::JSON->perl2JSON($sdist)); - return $editor->event unless $editor->create_serial_distribution($sdist); - - # create summaries too - my $summary = new Fieldmapper::serial::basic_summary; - $summary->distribution($sdist->id); - $summary->generated_coverage(''); - return $editor->event unless $editor->create_serial_basic_summary($summary); - $summary = new Fieldmapper::serial::supplement_summary; - $summary->distribution($sdist->id); - $summary->generated_coverage(''); - return $editor->event unless $editor->create_serial_supplement_summary($summary); - $summary = new Fieldmapper::serial::index_summary; - $summary->distribution($sdist->id); - $summary->generated_coverage(''); - return $editor->event unless $editor->create_serial_index_summary($summary); - - # create a starter stream (TODO: reconsider this) - my $stream = new Fieldmapper::serial::stream; - $stream->distribution($sdist->id); - return $editor->event unless $editor->create_serial_stream($stream); - - return 0; -} - -sub _update_sdist { - my ($editor, $override, $sdist) = @_; - - $logger->info("distribution-alter: retrieving distribution ".$sdist->id); - my $orig_sdist = $editor->retrieve_serial_distribution($sdist->id); - - $logger->info("distribution-alter: original distribution ".OpenSRF::Utils::JSON->perl2JSON($orig_sdist)); - $logger->info("distribution-alter: updated distribution ".OpenSRF::Utils::JSON->perl2JSON($sdist)); - return $editor->event unless $editor->update_serial_distribution($sdist); - return 0; -} - -__PACKAGE__->register_method( - method => "fleshed_serial_distribution_retrieve_batch", - authoritative => 1, - api_name => "open-ils.serial.distribution.fleshed.batch.retrieve" -); - -sub fleshed_serial_distribution_retrieve_batch { - my( $self, $client, $ids ) = @_; -# FIXME: permissions? - $logger->info("Fetching fleshed distributions @$ids"); - return $U->cstorereq( - "open-ils.cstore.direct.serial.distribution.search.atomic", - { id => $ids }, - { flesh => 1, - flesh_fields => {sdist => [ qw/ holding_lib receive_call_number receive_unit_template bind_call_number bind_unit_template streams / ]} - }); -} - -__PACKAGE__->register_method( - method => "retrieve_dist_tree", - authoritative => 1, - api_name => "open-ils.serial.distribution_tree.retrieve" -); - -__PACKAGE__->register_method( - method => "retrieve_dist_tree", - api_name => "open-ils.serial.distribution_tree.global.retrieve" -); - -sub retrieve_dist_tree { - my( $self, $client, $user_session, $docid, @org_ids ) = @_; - - if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; } - - $docid = "$docid"; - - # TODO: permission support - if(!@org_ids and $user_session) { - my $user_obj = - OpenILS::Application::AppUtils->check_user_session( $user_session ); #throws EX on error - @org_ids = ($user_obj->home_ou); - } - - my $e = new_editor(); - - if( $self->api_name =~ /global/ ) { - return $e->search_serial_distribution([{'+ssub' => { record_entry => $docid }}, - { flesh => 1, - flesh_fields => {sdist => [ qw/ holding_lib receive_call_number receive_unit_template bind_call_number bind_unit_template streams basic_summary supplement_summary index_summary / ]}, - order_by => {'sdist' => 'id'}, - 'join' => {'ssub' => {}} - } - ]); # TODO: filter for !deleted? - - } else { - my @all_dists; - for my $orgid (@org_ids) { - my $dists = $e->search_serial_distribution([{'+ssub' => { record_entry => $docid }, holding_lib => $orgid}, - { flesh => 1, - flesh_fields => {sdist => [ qw/ holding_lib receive_call_number receive_unit_template bind_call_number bind_unit_template streams basic_summary supplement_summary index_summary / ]}, - order_by => {'sdist' => 'id'}, - 'join' => {'ssub' => {}} - } - ]); # TODO: filter for !deleted? - push( @all_dists, @$dists ) if $dists; - } - - return \@all_dists; - } - - return undef; -} - - -__PACKAGE__->register_method( - method => "distribution_orgs_for_title", - authoritative => 1, - api_name => "open-ils.serial.distribution.retrieve_orgs_by_title" -); - -sub distribution_orgs_for_title { - my( $self, $client, $record_id ) = @_; - - my $dists = $U->cstorereq( - "open-ils.cstore.direct.serial.distribution.search.atomic", - { '+ssub' => { record_entry => $record_id } }, - { 'join' => {'ssub' => {}} }); # TODO: filter on !deleted? - - my $orgs = { map {$_->holding_lib => 1 } @$dists }; - return [ keys %$orgs ]; -} - - -########################################################################## -# caption and pattern methods -# -__PACKAGE__->register_method( - method => 'scap_alter', - api_name => 'open-ils.serial.caption_and_pattern.batch.update', - api_level => 1, - argc => 2, - signature => { - desc => 'Receives an array of one or more caption and patterns and updates the database as needed', - 'params' => [ { - name => 'authtoken', - desc => 'Authtoken for current user session', - type => 'string' - }, - { - name => 'scaps', - desc => 'Array of caption and patterns', - type => 'array' - } - - ], - 'return' => { - desc => 'Returns 1 if successful, event if failed', - type => 'mixed' - } - } -); - -sub scap_alter { - my( $self, $conn, $auth, $scaps ) = @_; - return 1 unless ref $scaps; - my( $reqr, $evt ) = $U->checkses($auth); - return $evt if $evt; - my $editor = new_editor(requestor => $reqr, xact => 1); - my $override = $self->api_name =~ /override/; - -# TODO: permission check -# return $editor->event unless -# $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy)); - - for my $scap (@$scaps) { - my $scapid = $scap->id; - - if( $scap->isdeleted ) { - $evt = _delete_scap( $editor, $override, $scap); - } elsif( $scap->isnew ) { - $evt = _create_scap( $editor, $scap ); - } else { - $evt = _update_scap( $editor, $override, $scap ); - } - } - - if( $evt ) { - $logger->info("caption_and_pattern-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt)); - $editor->rollback; - return $evt; - } - $logger->debug("caption_and_pattern-alter: done updating caption_and_pattern batch"); - $editor->commit; - $logger->info("caption_and_pattern-alter successfully updated ".scalar(@$scaps)." caption_and_patterns"); - return 1; -} - -sub _delete_scap { - my ($editor, $override, $scap) = @_; - $logger->info("caption_and_pattern-alter: delete caption_and_pattern ".OpenSRF::Utils::JSON->perl2JSON($scap)); - my $sisses = $editor->search_serial_issuance( - { caption_and_pattern => $scap->id }, { limit => 1 } ); #TODO: 'deleted' support? - return OpenILS::Event->new( - 'SERIAL_CAPTION_AND_PATTERN_HAS_ISSUANCES', payload => $scap->id ) if (@$sisses); - - return $editor->event unless $editor->delete_serial_caption_and_pattern($scap); - return 0; -} - -sub _create_scap { - my ($editor, $scap) = @_; - - $logger->info("caption_and_pattern-alter: new caption_and_pattern ".OpenSRF::Utils::JSON->perl2JSON($scap)); - return $editor->event unless $editor->create_serial_caption_and_pattern($scap); - return 0; -} - -sub _update_scap { - my ($editor, $override, $scap) = @_; - - $logger->info("caption_and_pattern-alter: retrieving caption_and_pattern ".$scap->id); - my $orig_scap = $editor->retrieve_serial_caption_and_pattern($scap->id); - - $logger->info("caption_and_pattern-alter: original caption_and_pattern ".OpenSRF::Utils::JSON->perl2JSON($orig_scap)); - $logger->info("caption_and_pattern-alter: updated caption_and_pattern ".OpenSRF::Utils::JSON->perl2JSON($scap)); - return $editor->event unless $editor->update_serial_caption_and_pattern($scap); - return 0; -} - -__PACKAGE__->register_method( - method => "serial_caption_and_pattern_retrieve_batch", - authoritative => 1, - api_name => "open-ils.serial.caption_and_pattern.batch.retrieve" -); - -sub serial_caption_and_pattern_retrieve_batch { - my( $self, $client, $ids ) = @_; - $logger->info("Fetching caption_and_patterns @$ids"); - return $U->cstorereq( - "open-ils.cstore.direct.serial.caption_and_pattern.search.atomic", - { id => $ids } - ); -} - -########################################################################## -# stream methods -# -__PACKAGE__->register_method( - method => 'sstr_alter', - api_name => 'open-ils.serial.stream.batch.update', - api_level => 1, - argc => 2, - signature => { - desc => 'Receives an array of one or more streams and updates the database as needed', - 'params' => [ { - name => 'authtoken', - desc => 'Authtoken for current user session', - type => 'string' - }, - { - name => 'sstrs', - desc => 'Array of streams', - type => 'array' - } - - ], - 'return' => { - desc => 'Returns 1 if successful, event if failed', - type => 'mixed' - } - } -); - -sub sstr_alter { - my( $self, $conn, $auth, $sstrs ) = @_; - return 1 unless ref $sstrs; - my( $reqr, $evt ) = $U->checkses($auth); - return $evt if $evt; - my $editor = new_editor(requestor => $reqr, xact => 1); - my $override = $self->api_name =~ /override/; - -# TODO: permission check -# return $editor->event unless -# $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy)); - - for my $sstr (@$sstrs) { - my $sstrid = $sstr->id; - - if( $sstr->isdeleted ) { - $evt = _delete_sstr( $editor, $override, $sstr); - } elsif( $sstr->isnew ) { - $evt = _create_sstr( $editor, $sstr ); - } else { - $evt = _update_sstr( $editor, $override, $sstr ); - } - } - - if( $evt ) { - $logger->info("stream-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt)); - $editor->rollback; - return $evt; - } - $logger->debug("stream-alter: done updating stream batch"); - $editor->commit; - $logger->info("stream-alter successfully updated ".scalar(@$sstrs)." streams"); - return 1; -} - -sub _delete_sstr { - my ($editor, $override, $sstr) = @_; - $logger->info("stream-alter: delete stream ".OpenSRF::Utils::JSON->perl2JSON($sstr)); - my $sitems = $editor->search_serial_item( - { stream => $sstr->id }, { limit => 1 } ); #TODO: 'deleted' support? - return OpenILS::Event->new( - 'SERIAL_STREAM_HAS_ITEMS', payload => $sstr->id ) if (@$sitems); - - return $editor->event unless $editor->delete_serial_stream($sstr); - return 0; -} - -sub _create_sstr { - my ($editor, $sstr) = @_; - - $logger->info("stream-alter: new stream ".OpenSRF::Utils::JSON->perl2JSON($sstr)); - return $editor->event unless $editor->create_serial_stream($sstr); - return 0; -} - -sub _update_sstr { - my ($editor, $override, $sstr) = @_; - - $logger->info("stream-alter: retrieving stream ".$sstr->id); - my $orig_sstr = $editor->retrieve_serial_stream($sstr->id); - - $logger->info("stream-alter: original stream ".OpenSRF::Utils::JSON->perl2JSON($orig_sstr)); - $logger->info("stream-alter: updated stream ".OpenSRF::Utils::JSON->perl2JSON($sstr)); - return $editor->event unless $editor->update_serial_stream($sstr); - return 0; -} - -__PACKAGE__->register_method( - method => "serial_stream_retrieve_batch", - authoritative => 1, - api_name => "open-ils.serial.stream.batch.retrieve" -); - -sub serial_stream_retrieve_batch { - my( $self, $client, $ids ) = @_; - $logger->info("Fetching streams @$ids"); - return $U->cstorereq( - "open-ils.cstore.direct.serial.stream.search.atomic", - { id => $ids } - ); -} - - -########################################################################## -# summary methods -# -__PACKAGE__->register_method( - method => 'sum_alter', - api_name => 'open-ils.serial.basic_summary.batch.update', - api_level => 1, - argc => 2, - signature => { - desc => 'Receives an array of one or more summaries and updates the database as needed', - 'params' => [ { - name => 'authtoken', - desc => 'Authtoken for current user session', - type => 'string' - }, - { - name => 'sbsums', - desc => 'Array of basic summaries', - type => 'array' - } - - ], - 'return' => { - desc => 'Returns 1 if successful, event if failed', - type => 'mixed' - } - } -); - -__PACKAGE__->register_method( - method => 'sum_alter', - api_name => 'open-ils.serial.supplement_summary.batch.update', - api_level => 1, - argc => 2, - signature => { - desc => 'Receives an array of one or more summaries and updates the database as needed', - 'params' => [ { - name => 'authtoken', - desc => 'Authtoken for current user session', - type => 'string' - }, - { - name => 'sbsums', - desc => 'Array of supplement summaries', - type => 'array' - } - - ], - 'return' => { - desc => 'Returns 1 if successful, event if failed', - type => 'mixed' - } - } -); - -__PACKAGE__->register_method( - method => 'sum_alter', - api_name => 'open-ils.serial.index_summary.batch.update', - api_level => 1, - argc => 2, - signature => { - desc => 'Receives an array of one or more summaries and updates the database as needed', - 'params' => [ { - name => 'authtoken', - desc => 'Authtoken for current user session', - type => 'string' - }, - { - name => 'sbsums', - desc => 'Array of index summaries', - type => 'array' - } - - ], - 'return' => { - desc => 'Returns 1 if successful, event if failed', - type => 'mixed' - } - } -); - -sub sum_alter { - my( $self, $conn, $auth, $sums ) = @_; - return 1 unless ref $sums; - - $self->api_name =~ /serial\.(\w*)_summary/; - my $type = $1; - - my( $reqr, $evt ) = $U->checkses($auth); - return $evt if $evt; - my $editor = new_editor(requestor => $reqr, xact => 1); - my $override = $self->api_name =~ /override/; - -# TODO: permission check -# return $editor->event unless -# $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy)); - - for my $sum (@$sums) { - my $sumid = $sum->id; - - # XXX: (for now, at least) summaries should be created/deleted by the distribution functions - if( $sum->isdeleted ) { - $evt = OpenILS::Event->new('SERIAL_SUMMARIES_NOT_INDEPENDENT'); - } elsif( $sum->isnew ) { - $evt = OpenILS::Event->new('SERIAL_SUMMARIES_NOT_INDEPENDENT'); - } else { - $evt = _update_sum( $editor, $override, $sum, $type ); - } - } - - if( $evt ) { - $logger->info("${type}_summary-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt)); - $editor->rollback; - return $evt; - } - $logger->debug("${type}_summary-alter: done updating ${type}_summary batch"); - $editor->commit; - $logger->info("${type}_summary-alter successfully updated ".scalar(@$sums)." ${type}_summaries"); - return 1; -} - -sub _update_sum { - my ($editor, $override, $sum, $type) = @_; - - $logger->info("${type}_summary-alter: retrieving ${type}_summary ".$sum->id); - my $retrieve_method = "retrieve_serial_${type}_summary"; - my $orig_sum = $editor->$retrieve_method($sum->id); - - $logger->info("${type}_summary-alter: original ${type}_summary ".OpenSRF::Utils::JSON->perl2JSON($orig_sum)); - $logger->info("${type}_summary-alter: updated ${type}_summary ".OpenSRF::Utils::JSON->perl2JSON($sum)); - my $update_method = "update_serial_${type}_summary"; - return $editor->event unless $editor->$update_method($sum); - return 0; -} - -__PACKAGE__->register_method( - method => "serial_summary_retrieve_batch", - authoritative => 1, - api_name => "open-ils.serial.basic_summary.batch.retrieve" -); - -__PACKAGE__->register_method( - method => "serial_summary_retrieve_batch", - authoritative => 1, - api_name => "open-ils.serial.supplement_summary.batch.retrieve" -); - -__PACKAGE__->register_method( - method => "serial_summary_retrieve_batch", - authoritative => 1, - api_name => "open-ils.serial.index_summary.batch.retrieve" -); - -sub serial_summary_retrieve_batch { - my( $self, $client, $ids ) = @_; - - $self->api_name =~ /serial\.(\w*)_summary/; - my $type = $1; - - $logger->info("Fetching ${type}_summaries @$ids"); - return $U->cstorereq( - "open-ils.cstore.direct.serial.".$type."_summary.search.atomic", - { id => $ids } - ); -} - - -########################################################################## -# other methods -# -__PACKAGE__->register_method( - "method" => "bre_by_identifier", - "api_name" => "open-ils.serial.biblio.record_entry.by_identifier", - "stream" => 1, - "signature" => { - "desc" => "Find instances of biblio.record_entry given a search token" . - " that could be a value for any identifier defined in " . - "config.metabib_field", - "params" => [ - {"desc" => "Search token", "type" => "string"}, - {"desc" => "Options: require_subscriptions, add_mvr, is_actual_id" . - ", id_list (all boolean)", "type" => "object"} - ], - "return" => { - "desc" => "Any matching BREs, or if the add_mvr option is true, " . - "objects with a 'bre' key/value pair, and an 'mvr' " . - "key-value pair. BREs have subscriptions fleshed on.", - "type" => "object" - } - } -); - -sub bre_by_identifier { - my ($self, $client, $term, $options) = @_; - - return new OpenILS::Event("BAD_PARAMS") unless $term; - - $options ||= {}; - my $e = new_editor(); - - my @ids; - - if ($options->{"is_actual_id"}) { - @ids = ($term); - } else { - my $cmf = - $e->search_config_metabib_field({"field_class" => "identifier"}) - or return $e->die_event; - - my @identifiers = map { $_->name } @$cmf; - my $query = join(" || ", map { "id|$_: $term" } @identifiers); - - my $search = create OpenSRF::AppSession("open-ils.search"); - my $search_result = $search->request( - "open-ils.search.biblio.multiclass.query.staff", {}, $query - )->gather(1); - $search->disconnect; - - # Un-nest results. They tend to look like [[1],[2],[3]] for some reason. - @ids = map { @{$_} } @{$search_result->{"ids"}}; - - unless (@ids) { - $e->disconnect; - return undef; - } - - if ($options->{"id_list"}) { - $e->disconnect; - $client->respond($_) foreach (@ids); - return undef; - } - } - - my $bre = $e->search_biblio_record_entry([ - {"id" => \@ids}, { - "flesh" => 2, "flesh_fields" => { - "bre" => ["subscriptions"], - "ssub" => ["owning_lib"] - } - } - ]) or return $e->die_event; - - if (@$bre && $options->{"require_subscriptions"}) { - $bre = [ grep { @{$_->subscriptions} } @$bre ]; - } - - $e->disconnect; - - if (@$bre) { # re-evaluate after possible grep - if ($options->{"add_mvr"}) { - $client->respond( - {"bre" => $_, "mvr" => _get_mvr($_->id)} - ) foreach (@$bre); - } else { - $client->respond($_) foreach (@$bre); - } - } - - undef; -} - -__PACKAGE__->register_method( - "method" => "get_items_by", - "api_name" => "open-ils.serial.items.receivable.by_subscription", - "stream" => 1, - "signature" => { - "desc" => "Return all receivable items under a given subscription", - "params" => [ - {"desc" => "Authtoken", "type" => "string"}, - {"desc" => "Subscription ID", "type" => "number"}, - ], - "return" => { - "desc" => "All receivable items under a given subscription", - "type" => "object", "class" => "sitem" - } - } -); - -__PACKAGE__->register_method( - "method" => "get_items_by", - "api_name" => "open-ils.serial.items.receivable.by_issuance", - "stream" => 1, - "signature" => { - "desc" => "Return all receivable items under a given issuance", - "params" => [ - {"desc" => "Authtoken", "type" => "string"}, - {"desc" => "Issuance ID", "type" => "number"}, - ], - "return" => { - "desc" => "All receivable items under a given issuance", - "type" => "object", "class" => "sitem" - } - } -); - -__PACKAGE__->register_method( - "method" => "get_items_by", - "api_name" => "open-ils.serial.items.by_issuance", - "stream" => 1, - "signature" => { - "desc" => "Return all items under a given issuance", - "params" => [ - {"desc" => "Authtoken", "type" => "string"}, - {"desc" => "Issuance ID", "type" => "number"}, - ], - "return" => { - "desc" => "All items under a given issuance", - "type" => "object", "class" => "sitem" - } - } -); - -sub get_items_by { - my ($self, $client, $auth, $term, $opts) = @_; - - # Not to be used in the json_query, but after limiting by perm check. - $opts = {} unless ref $opts eq "HASH"; - $opts->{"limit"} ||= 10000; # some existing users may want all results - $opts->{"offset"} ||= 0; - $opts->{"limit"} = int($opts->{"limit"}); - $opts->{"offset"} = int($opts->{"offset"}); - - my $e = new_editor("authtoken" => $auth); - return $e->die_event unless $e->checkauth; - - my $by = ($self->api_name =~ /by_(\w+)$/)[0]; - my $receivable = ($self->api_name =~ /receivable/); - - my %where = ( - "issuance" => {"issuance" => $term}, - "subscription" => {"+siss" => {"subscription" => $term}} - ); - - my $item_rows = $e->json_query( - { - "select" => {"sitem" => ["id"], "sdist" => ["holding_lib"]}, - "from" => { - "sitem" => { - "siss" => {}, - "sstr" => {"join" => {"sdist" => {}}} - } - }, - "where" => { - %{$where{$by}}, $receivable ? ("date_received" => undef) : () - }, - "order_by" => {"sitem" => ["id"]} - } - ) or return $e->die_event; - - return undef unless @$item_rows; - - my $skipped = 0; - my $returned = 0; - foreach (@$item_rows) { - last if $returned >= $opts->{"limit"}; - next unless $e->allowed("RECEIVE_SERIAL", $_->{"holding_lib"}); - if ($skipped < $opts->{"offset"}) { - $skipped++; - next; - } - - $client->respond( - $e->retrieve_serial_item([ - $_->{"id"}, { - "flesh" => 3, - "flesh_fields" => { - "sitem" => [qw/stream issuance unit creator editor/], - "sstr" => ["distribution"], - "sdist" => ["holding_lib"] - } - } - ]) - ); - $returned++; - } - - $e->disconnect; - undef; -} - -__PACKAGE__->register_method( - "method" => "get_receivable_issuances", - "api_name" => "open-ils.serial.issuances.receivable", - "stream" => 1, - "signature" => { - "desc" => "Return all issuances with receivable items given " . - "a subscription ID", - "params" => [ - {"desc" => "Authtoken", "type" => "string"}, - {"desc" => "Subscription ID", "type" => "number"}, - ], - "return" => { - "desc" => "All issuances with receivable items " . - "(but not the items themselves)", "type" => "object" - } - } -); - -sub get_receivable_issuances { - my ($self, $client, $auth, $sub_id) = @_; - - my $e = new_editor("authtoken" => $auth); - return $e->die_event unless $e->checkauth; - - # XXX permissions - - my $issuance_ids = $e->json_query({ - "select" => { - "siss" => [ - {"transform" => "distinct", "column" => "id"}, - "date_published" - ] - }, - "from" => {"siss" => "sitem"}, - "where" => { - "subscription" => $sub_id, - "+sitem" => {"date_received" => undef} - }, - "order_by" => { - "siss" => {"date_published" => {"direction" => "asc"}} - } - - }) or return $e->die_event; - - $client->respond($e->retrieve_serial_issuance($_->{"id"})) - foreach (@$issuance_ids); - - $e->disconnect; - undef; -} - - -__PACKAGE__->register_method( - "method" => "get_routing_list_users", - "api_name" => "open-ils.serial.routing_list_users.fleshed_and_ordered", - "stream" => 1, - "signature" => { - "desc" => "Return all routing list users with reader fleshed " . - "(with card and home_ou) for a given stream ID, sorted by pos", - "params" => [ - {"desc" => "Authtoken", "type" => "string"}, - {"desc" => "Stream ID (int or array of ints)", "type" => "mixed"}, - ], - "return" => { - "desc" => "Stream of routing list users", "type" => "object", - "class" => "srlu" - } - } -); - -sub get_routing_list_users { - my ($self, $client, $auth, $stream_id) = @_; - - my $e = new_editor("authtoken" => $auth); - return $e->die_event unless $e->checkauth; - - my $users = $e->search_serial_routing_list_user([ - {"stream" => $stream_id}, { - "order_by" => {"srlu" => "pos"}, - "flesh" => 2, - "flesh_fields" => { - "srlu" => [qw/reader stream/], - "au" => [qw/card home_ou/], - "sstr" => ["distribution"] - } - } - ]) or return $e->die_event; - - return undef unless @$users; - - # The ADMIN_SERIAL_STREAM permission is used simply to avoid the - # need for any new permission. The context OU will be the same - # for every result of the above query, so we need only check once. - return $e->die_event unless $e->allowed( - "ADMIN_SERIAL_STREAM", $users->[0]->stream->distribution->holding_lib - ); - - $e->disconnect; - - my @users = map { $_->stream($_->stream->id); $_ } @$users; - @users = sort { $a->stream cmp $b->stream } @users if - ref $stream_id eq "ARRAY"; - - $client->respond($_) for @users; - - undef; -} - - -__PACKAGE__->register_method( - "method" => "replace_routing_list_users", - "api_name" => "open-ils.serial.routing_list_users.replace", - "signature" => { - "desc" => "Replace all routing list users on the specified streams " . - "with those in the list argument", - "params" => [ - {"desc" => "Authtoken", "type" => "string"}, - {"desc" => "List of srlu objects", "type" => "array"}, - ], - "return" => { - "desc" => "event on failure, undef on success" - } - } -); - -sub replace_routing_list_users { - my ($self, $client, $auth, $users) = @_; - - return undef unless ref $users eq "ARRAY"; - - if (grep { ref $_ ne "Fieldmapper::serial::routing_list_user" } @$users) { - return new OpenILS::Event("BAD_PARAMS", "note" => "Only srlu objects"); - } - - my $e = new_editor("authtoken" => $auth, "xact" => 1); - return $e->die_event unless $e->checkauth; - - my %streams_ok = (); - my $pos = 0; - - foreach my $user (@$users) { - unless (exists $streams_ok{$user->stream}) { - my $stream = $e->retrieve_serial_stream([ - $user->stream, { - "flesh" => 1, - "flesh_fields" => {"sstr" => ["distribution"]} - } - ]) or return $e->die_event; - $e->allowed( - "ADMIN_SERIAL_STREAM", $stream->distribution->holding_lib - ) or return $e->die_event; - - my $to_delete = $e->search_serial_routing_list_user( - {"stream" => $user->stream} - ) or return $e->die_event; - - $logger->info( - "Deleting srlu: [" . - join(", ", map { $_->id; } @$to_delete) . - "]" - ); - - foreach (@$to_delete) { - $e->delete_serial_routing_list_user($_) or - return $e->die_event; - } - - $streams_ok{$user->stream} = 1; - } - - next if $user->isdeleted; - - $user->clear_id; - $user->pos($pos++); - $e->create_serial_routing_list_user($user) or return $e->die_event; - } - - $e->commit or return $e->die_event; - undef; -} - -__PACKAGE__->register_method( - "method" => "get_records_with_marc_85x", - "api_name"=>"open-ils.serial.caption_and_pattern.find_legacy_by_bib_record", - "stream" => 1, - "signature" => { - "desc" => "Return the specified BRE itself and/or any related SRE ". - "whenever they have 853-855 tags", - "params" => [ - {"desc" => "Authtoken", "type" => "string"}, - {"desc" => "bib record ID", "type" => "number"}, - ], - "return" => { - "desc" => "objects, either bre or sre", "type" => "object" - } - } -); - -sub get_records_with_marc_85x { # specifically, 853-855 - my ($self, $client, $auth, $bre_id) = @_; - - my $e = new_editor("authtoken" => $auth); - return $e->die_event unless $e->checkauth; - - my $bre = $e->search_biblio_record_entry([ - {"id" => $bre_id, "deleted" => "f"}, { - "flesh" => 1, - "flesh_fields" => {"bre" => [qw/creator editor owner/]} - } - ]) or return $e->die_event; - - return undef unless @$bre; - $bre = $bre->[0]; - - my $record = MARC::Record->new_from_xml($bre->marc); - $client->respond($bre) if $record->field("85[3-5]"); - # XXX Is passing a regex to ->field() an abuse of MARC::Record ? - - my $sres = $e->search_serial_record_entry([ - {"record" => $bre_id, "deleted" => "f"}, { - "flesh" => 1, - "flesh_fields" => {"sre" => [qw/creator editor owning_lib/]} - } - ]) or return $e->die_event; - - $e->disconnect; - - foreach my $sre (@$sres) { - $client->respond($sre) if - MARC::Record->new_from_xml($sre->marc)->field("85[3-5]"); - } - - undef; -} - -__PACKAGE__->register_method( - "method" => "create_scaps_from_marcxml", - "api_name" => "open-ils.serial.caption_and_pattern.create_from_records", - "stream" => 1, - "signature" => { - "desc" => "Create caption and pattern objects from 853-855 tags " . - "in MARCXML documents", - "params" => [ - {"desc" => "Authtoken", "type" => "string"}, - {"desc" => "Subscription ID", "type" => "number"}, - {"desc" => "list of MARCXML documents as strings", - "type" => "array"}, - ], - "return" => { - "desc" => "Newly created caption and pattern objects", - "type" => "object", "class" => "scap" - } - } -); - -sub create_scaps_from_marcxml { - my ($self, $client, $auth, $sub_id, $docs) = @_; - - return undef unless ref $docs eq "ARRAY"; - - my $e = new_editor("authtoken" => $auth, "xact" => 1); - return $e->die_event unless $e->checkauth; - - # Retrieve the subscription just for perm checking (whether we can create - # scaps at the owning lib). - my $sub = $e->retrieve_serial_subscription($sub_id) or return $e->die_event; - return $e->die_event unless - $e->allowed("ADMIN_SERIAL_CAPTION_PATTERN", $sub->owning_lib); - - foreach my $record (map { MARC::Record->new_from_xml($_) } @$docs) { - foreach my $field ($record->field("85[3-5]")) { - my $scap = new Fieldmapper::serial::caption_and_pattern; - $scap->subscription($sub_id); - $scap->type($MFHD_NAMES_BY_TAG{$field->tag}); - $scap->pattern_code( - OpenSRF::Utils::JSON->perl2JSON( - [ $field->indicator(1), $field->indicator(2), - map { @$_ } $field->subfields ] # flattens nested array - ) - ); - $e->create_serial_caption_and_pattern($scap) or - return $e->die_event; - $client->respond($e->data); - } - } - - $e->commit or return $e->die_event; - undef; -} - -# All these _clone_foo() functions could possibly have been consolidated into -# one clever function, but it's faster to get things working this way. -sub _clone_subscription { - my ($sub, $bib_id, $e) = @_; - - # clone sub itself - my $new_sub = $sub->clone; - $new_sub->record_entry(int $bib_id) if $bib_id; - $new_sub->clear_id; - $new_sub->clear_distributions; - $new_sub->clear_notes; - $new_sub->clear_scaps; - - $e->create_serial_subscription($new_sub) or return $e->die_event; - - my $new_sub_id = $e->data->id; - # clone dists - foreach my $dist (@{$sub->distributions}) { - my $r = _clone_distribution($dist, $new_sub_id, $e); - return $r if $U->event_code($r); - } - - # clone sub notes - foreach my $note (@{$sub->notes}) { - my $r = _clone_subscription_note($note, $new_sub_id, $e); - return $r if $U->event_code($r); - } - - # clone scaps - foreach my $scap (@{$sub->scaps}) { - my $r = _clone_caption_and_pattern($scap, $new_sub_id, $e); - return $r if $U->event_code($r); - } - - return $new_sub_id; -} - -sub _clone_distribution { - my ($dist, $sub_id, $e) = @_; - - my $new_dist = $dist->clone; - $new_dist->clear_id; - $new_dist->clear_notes; - $new_dist->clear_streams; - $new_dist->subscription($sub_id); - - $e->create_serial_distribution($new_dist) or return $e->die_event; - my $new_dist_id = $e->data->id; - - # clone streams - foreach my $stream (@{$dist->streams}) { - my $r = _clone_stream($stream, $new_dist_id, $e); - return $r if $U->event_code($r); - } - - # clone distribution notes - foreach my $note (@{$dist->notes}) { - my $r = _clone_distribution_note($note, $new_dist_id, $e); - return $r if $U->event_code($r); - } - - return $new_dist_id; -} - -sub _clone_subscription_note { - my ($note, $sub_id, $e) = @_; - - my $new_note = $note->clone; - $new_note->clear_id; - $new_note->creator($e->requestor->id); - $new_note->create_date("now"); - $new_note->subscription($sub_id); - - $e->create_serial_subscription_note($new_note) or return $e->die_event; - return $e->data->id; -} - -sub _clone_caption_and_pattern { - my ($scap, $sub_id, $e) = @_; - - my $new_scap = $scap->clone; - $new_scap->clear_id; - $new_scap->subscription($sub_id); - - $e->create_serial_caption_and_pattern($new_scap) or return $e->die_event; - return $e->data->id; -} - -sub _clone_distribution_note { - my ($note, $dist_id, $e) = @_; - - my $new_note = $note->clone; - $new_note->clear_id; - $new_note->creator($e->requestor->id); - $new_note->create_date("now"); - $new_note->distribution($dist_id); - - $e->create_serial_distribution_note($new_note) or return $e->die_event; - return $e->data->id; -} - -sub _clone_stream { - my ($stream, $dist_id, $e) = @_; - - my $new_stream = $stream->clone; - $new_stream->clear_id; - $new_stream->clear_routing_list_users; - $new_stream->distribution($dist_id); - - $e->create_serial_stream($new_stream) or return $e->die_event; - my $new_stream_id = $e->data->id; - - # clone routing list users - foreach my $user (@{$stream->routing_list_users}) { - my $r = _clone_routing_list_user($user, $new_stream_id, $e); - return $r if $U->event_code($r); - } - - return $new_stream_id; -} - -sub _clone_routing_list_user { - my ($user, $stream_id, $e) = @_; - - my $new_user = $user->clone; - $new_user->clear_id; - $new_user->stream($stream_id); - - $e->create_serial_routing_list_user($new_user) or return $e->die_event; - return $e->data->id; -} - -__PACKAGE__->register_method( - "method" => "clone_subscription", - "api_name" => "open-ils.serial.subscription.clone", - "signature" => { - "desc" => q{Clone a subscription, including its attending distributions, - streams, captions and patterns, routing list users, distribution - notes and subscription notes. Do not include holdings-specific - things, like issuances, items, units, summaries. Attach the - clone either to the same bib record as the original, or to one - specified by ID.}, - "params" => [ - {"desc" => "Authtoken", "type" => "string"}, - {"desc" => "Subscription ID", "type" => "number"}, - {"desc" => "Bib Record ID (optional)", "type" => "number"} - ], - "return" => { - "desc" => "ID of the new subscription", "type" => "number" - } - } -); - -sub clone_subscription { - my ($self, $client, $auth, $sub_id, $bib_id) = @_; - - my $e = new_editor("authtoken" => $auth, "xact" => 1); - return $e->die_event unless $e->checkauth; - - my $sub = $e->retrieve_serial_subscription([ - int $sub_id, { - "flesh" => 3, - "flesh_fields" => { - "ssub" => [qw/distributions notes scaps/], - "sdist" => [qw/streams notes/], - "sstr" => ["routing_list_users"] - } - } - ]) or return $e->die_event; - - # ADMIN_SERIAL_SUBSCRIPTION will have to be good enough as a - # catch-all permisison for this operation. - return $e->die_event unless - $e->allowed("ADMIN_SERIAL_SUBSCRIPTION", $sub->owning_lib); - - my $result = _clone_subscription($sub, $bib_id, $e); - - return $e->die_event($result) if $U->event_code($result); - - $e->commit or return $e->die_event; - return $result; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage.pm deleted file mode 100644 index b57a71820e..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage.pm +++ /dev/null @@ -1,200 +0,0 @@ -package OpenILS::Application::Storage; -use OpenILS::Application; -use base qw/OpenILS::Application/; - -use OpenSRF::EX qw/:try/; -use OpenSRF::Utils::Logger qw/:level/; - -# Pull this in so we can adjust it's @ISA -use OpenILS::Application::Storage::CDBI (1); -use OpenILS::Application::Storage::FTS; - - -# the easy way to get to the logger... -my $log = "OpenSRF::Utils::Logger"; - -our $QParser; -our $WRITE = 0; -our $IGNORE_XACT_ID_FAILURE = 0; - -sub DESTROY {}; - -sub initialize { - - my $conf = OpenSRF::Utils::SettingsClient->new; - - $log->debug('Initializing ' . __PACKAGE__ . '...', DEBUG); - - my $db_driver = $conf->config_value( apps => 'open-ils.storage' => app_settings => databases => 'driver'); - my $driver = "OpenILS::Application::Storage::Driver::$db_driver"; - - $log->debug("Attempting to load $driver ...", DEBUG); - - $driver->use; - if ($@) { - $log->debug( "Can't load $driver! : $@", ERROR ); - $log->error( "Can't load $driver! : $@"); - throw OpenSRF::EX::PANIC ( "Can't load $driver! : $@" ); - } - - $log->debug("$driver loaded successfully", DEBUG); - - # Suck in the method publishing modules - @OpenILS::Application::Storage::CDBI::ISA = ( $driver ); - - OpenILS::Application::Storage::Publisher->use; - if ($@) { - $log->debug("FAILURE LOADING Publisher! $@", ERROR); - throw OpenSRF::EX::PANIC ( "FAILURE LOADING Publisher! : $@" ); - } - - $log->debug("We seem to be OK...",DEBUG); -} - -sub child_init { - - $log->debug('Running child_init for ' . __PACKAGE__ . '...', DEBUG); - - my $conf = OpenSRF::Utils::SettingsClient->new; - - $log->debug('Calling the Driver child_init', DEBUG); - OpenILS::Application::Storage::CDBI->child_init( - $conf->config_value( apps => 'open-ils.storage' => app_settings => databases => 'database') - ); - - if (OpenILS::Application::Storage::CDBI->db_Main()) { - $log->debug("Success initializing driver!", DEBUG); - - my $db_driver = $conf->config_value( apps => 'open-ils.storage' => app_settings => databases => 'driver'); - $QParser = 'OpenILS::Application::Storage::Driver::'.$db_driver.'::QueryParser'; - $QParser->use; - - if($@) { - $log->debug( "Can't load $QParser! : $@", ERROR ); - $log->error( "Can't load $QParser! : $@"); - } else { - return 1; - } - } - - $log->debug("FAILURE initializing driver!", ERROR); - return 0; -} - -sub begin_xaction { - my $self = shift; - my $client = shift; - - local $WRITE = 1; - - $log->debug(" XACT --> 'BEGIN'ing transaction for session ".$client->session->session_id,DEBUG); - try { - OpenILS::Application::Storage::CDBI->db_Main->begin_work; - $client->session->session_data( xact_id => $client->session->session_id ); - } catch Error with { - throw OpenSRF::DomainObject::oilsException->new( - statusCode => 500, - status => "Could not BEGIN transaction!", - ); - }; - return 1; - -} -__PACKAGE__->register_method( - method => 'begin_xaction', - api_name => 'open-ils.storage.transaction.begin', - api_level => 1, - argc => 0, -); - -sub savepoint_placeholder { - return 1; -} -__PACKAGE__->register_method( - method => 'savepoint_placeholder', - api_name => 'open-ils.storage.savepoint.set', - api_level => 1, - argc => 1, -); -__PACKAGE__->register_method( - method => 'savepoint_placeholder', - api_name => 'open-ils.storage.savepoint.release', - api_level => 1, - argc => 1, -); -__PACKAGE__->register_method( - method => 'savepoint_placeholder', - api_name => 'open-ils.storage.savepoint.rollback', - api_level => 1, - argc => 1, -); - -sub commit_xaction { - my $self = shift; - my $client = shift; - - local $WRITE = 1; - - try { - OpenILS::Application::Storage::CDBI->db_Main->commit; - $client->session->session_data( xact_id => '' ); - } catch Error with { - throw OpenSRF::DomainObject::oilsException->new( - statusCode => 500, - status => "Could not COMMIT transaction!", - ); - }; - return 1; -} -__PACKAGE__->register_method( - method => 'commit_xaction', - api_name => 'open-ils.storage.transaction.commit', - api_level => 1, - argc => 0, -); - - -sub current_xact { - my $self = shift; - my $client = shift; - - return $client->session->session_data( 'xact_id' ); -} -__PACKAGE__->register_method( - method => 'current_xact', - api_name => 'open-ils.storage.transaction.current', - api_level => 1, - argc => 0, -); - -sub rollback_xaction { - my $self = shift; - my $client = shift; - - local $WRITE = 1; - - $log->debug(" XACT --> 'ROLLBACK'ing transaction for session ".$client->session->session_id,DEBUG); - $client->session->session_data( xact_id => '' ); - return OpenILS::Application::Storage::CDBI->db_Main->rollback; -} -__PACKAGE__->register_method( - method => 'rollback_xaction', - api_name => 'open-ils.storage.transaction.rollback', - api_level => 1, - argc => 0, -); - - -sub _cdbi2Hash { - my $self = shift; - my $obj = shift; - return { map { ( $_ => $obj->$_ ) } ($obj->columns('All')) }; -} - -sub _cdbi_list2AoH { - my $self = shift; - my @objs = @_; - return [ map { $self->_cdbi2Hash($_) } @objs ]; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI.pm deleted file mode 100644 index d004f3898d..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI.pm +++ /dev/null @@ -1,781 +0,0 @@ -package OpenILS::Application::Storage::CDBI; -use UNIVERSAL::require; -BEGIN { - 'Class::DBI::Frozen::301'->use or 'Class::DBI'->use or die $@; -} -use base qw/Class::DBI/; -use Class::DBI::AbstractSearch; - -use OpenILS::Application::Storage::CDBI::actor; -use OpenILS::Application::Storage::CDBI::action; -use OpenILS::Application::Storage::CDBI::booking; -use OpenILS::Application::Storage::CDBI::asset; -use OpenILS::Application::Storage::CDBI::serial; -use OpenILS::Application::Storage::CDBI::authority; -use OpenILS::Application::Storage::CDBI::biblio; -use OpenILS::Application::Storage::CDBI::config; -use OpenILS::Application::Storage::CDBI::metabib; -use OpenILS::Application::Storage::CDBI::money; -use OpenILS::Application::Storage::CDBI::permission; -use OpenILS::Application::Storage::CDBI::container; - -use OpenSRF::Utils::JSON; -use OpenSRF::Utils::Logger qw(:level); -use OpenSRF::EX qw/:try/; - -our $VERSION = 1; -my $log = 'OpenSRF::Utils::Logger'; - -if ($Class::DBI::VERSION gt '3.0.1') { - $log->error("Your version of Class::DBI, $Class::DBI::VERSION, is too new and incompatible with Evergreen. You will need to downgrade to version 3.0.1 or install Class::DBI::Frozen::301"); - die("Your version of Class::DBI, $Class::DBI::VERSION, is too new and incompatible with Evergreen. You will need to downgrade to version 3.0.1 or install Class::DBI::Frozen::301"); -} - -sub child_init { - my $self = shift; - - $log->debug("Creating ImaDBI Querys", DEBUG); - __PACKAGE__->set_sql( 'OILSFastSearch', <<" SQL", 'Main'); - SELECT %s - FROM %s - WHERE %s = ? - SQL - - __PACKAGE__->set_sql( 'OILSFastOrderedSearchLike', <<" SQL", 'Main'); - SELECT %s - FROM %s - WHERE %s LIKE ? - ORDER BY %s - SQL - - __PACKAGE__->set_sql( 'OILSFastOrderedSearch', <<" SQL", 'Main'); - SELECT %s - FROM %s - WHERE %s = ? - ORDER BY %s - SQL - - $log->debug("Calling Driver child_init", DEBUG); - $self->SUPER::child_init(@_); - -} - -sub fast_flesh_sth { - my $class = shift; - $class = ref($class) || $class; - - my $field = shift; - my $value = shift; - my $order = shift; - my $like = shift; - - - if (!(defined($order) and ref($order) and ref($order) eq 'HASH')) { - if (defined($value) and ref($value) and ref($value) eq 'HASH') { - $order = $value; - $value = undef; - } else { - $order = { order_by => $class->columns('Primary') } - } - } - - unless (defined $value) { - $value = $field; - ($field) = $class->columns('Primary'); - } - - unless (defined $field) { - ($field) = $class->columns('Primary'); - } - - unless ($order->{order_by}) { - $order = { order_by => $class->columns('Primary') } - } - - my $fm_class = 'Fieldmapper::'.$class; - my $field_list = join ',', $class->columns('Essential'); - - my $sth; - if (!$like) { - $sth = $class->sql_OILSFastOrderedSearch( $field_list, $class->table, $field, $order->{order_by}); - } else { - $sth = $class->sql_OILSFastOrderedSearchLike( $field_list, $class->table, $field, $order->{order_by}); - } - $sth->execute($value); - return $sth; -} - -sub fast_flesh { - my $self = shift; - return map $class->construct($_), $self->fast_flesh_sth(@_)->fetchall_hash; -} - -sub fast_fieldmapper { - my $self = shift; - my $id = shift; - my $col = shift; - my $like = shift; - my $options = shift; - my $class = ref($self) || $self; - my $fm_class = 'Fieldmapper::'.$class; - my @fms; - $log->debug("fast_fieldmapper() ==> Retrieving $fm_class", INTERNAL); - if ($like < 2) { - for my $hash ($self->fast_flesh_sth( $col, "$id", { order_by => $col }, $like )->fetchall_hash) { - my $fm = $fm_class->new; - for my $field ( $fm_class->real_fields ) { - $fm->$field( $$hash{$field} ); - } - push @fms, $fm; - } - } else { - my $search_type = 'search'; - if ($like == 2) { - $search_type = 'search_fts' - } elsif ($like == 3) { - $search_type = 'search_regex' - } - - for my $obj ($class->$search_type({ $col => $id}, $options)) { - push @fms, $obj->to_fieldmapper; - } - } - return @fms; -} - -sub retrieve { - my $self = shift; - my $arg = shift; - if (ref($arg) && - (UNIVERSAL::isa($arg => 'Fieldmapper') || - UNIVERSAL::isa($arg => 'Class::DBI')) ) { - my ($col) = $self->primary_column; - $log->debug("Using field $col as the primary key", INTERNAL); - $arg = $arg->$col; - } elsif (ref $arg) { - my ($col) = $self->primary_column; - $log->debug("Using field $col as the primary key", INTERNAL); - $arg = $arg->{$col}; - } - - $log->debug("Retrieving $self with $arg", INTERNAL); - my $rec; - try { - $rec = $self->SUPER::retrieve("$arg"); - } catch Error with { - $log->debug("Could not retrieve $self with $arg! -- ".shift(), DEBUG); - return undef; - }; - return $rec; -} - -sub to_fieldmapper { - my $obj = shift; - my $class = ref($obj) || $obj; - - my $fm_class = 'Fieldmapper::'.$class; - my $fm = $fm_class->new; - - if (ref($obj)) { - for my $field ( $fm->real_fields ) { - $fm->$field( ''.$obj->$field ); - } - } - - return $fm; -} - -sub merge { - my $self = shift; - my $search = shift; - my $arg = shift; - - delete $$arg{$_} for (keys %$search); - - $log->debug("CDBI->merge: \$search is $search (".ref($search)." : ".join(',',map{"$_ => $$search{$_}"}keys(%$search)).")",DEBUG); - $log->debug("CDBI->merge: \$arg is $arg (".ref($arg)." : ".join(',',map{"$_ => $$arg{$_}"}keys(%$arg)).")",DEBUG); - - my @objs = ($self); - @objs = $self->search_where($search) unless (ref $self); - - if (@objs == 1) { - $objs[0]->update($arg); - return $objs[0]; - } elsif (@objs == 0) { - return $self->create({%$search,%$arg}); - } else { - throw OpenSRF::EX::WARN ("Non-unique search key for merge. Perhaps you meant to use remote_update?"); - } -} - -sub remote_update { - my $self = shift; - my $search = shift; - my $arg = shift; - - delete $$arg{$_} for (keys %$search); - - $log->debug("CDBI->remote_update: \$search is $search (".ref($search)." : ".join(',',map{"$_ => $$search{$_}"}keys(%$search)).")",DEBUG); - $log->debug("CDBI->remote_update: \$arg is $arg (".ref($arg)." : ".join(',',map{"$_ => $$arg{$_}"}keys(%$arg)).")",DEBUG); - -# my @objs = $self->search_where($search); -# throw OpenSRF::EX::WARN ("No objects found for remote_update. Perhaps you meant to use merge?") -# if (@objs == 0); - -# $_->update($arg) for (@objs); -# return scalar(@objs); - - my @finds = sort keys %$search; - my @sets = sort keys %$arg; - - my @find_vals = @$search{@finds}; - my @set_vals = @$arg{@sets}; - - my $sql = 'UPDATE %s SET %s WHERE %s'; - - my $table = $self->table; - my $set = join(', ', map { "$_=?" } @sets); - my $where = join(', ', map { "$_=?" } @finds); - - my $sth = $self->db_Main->prepare(sprintf($sql, $table, $set, $where)); - $sth->execute(@set_vals,@find_vals); - return $sth->rows; - -} - -sub create { - my $self = shift; - my $arg = shift; - - $log->debug("CDBI->create: \$arg is $arg (".ref($arg)." : ".OpenSRF::Utils::JSON->perl2JSON($arg).")",DEBUG); - - if (ref($arg) && UNIVERSAL::isa($arg => 'Fieldmapper')) { - return $self->create_from_fieldmapper($arg,@_); - } - - return $self->SUPER::create($arg,@_); -} - -sub create_from_fieldmapper { - my $obj = shift; - my $fm = shift; - my @params = @_; - - $log->debug("Creating node of type ".ref($fm), DEBUG); - - my $class = ref($obj) || $obj; - my ($primary) = $class->columns('Primary'); - - if (ref($fm) &&UNIVERSAL::isa($fm => 'Fieldmapper')) { - my %hash = map { defined $fm->$_ ? - ($_ => $fm->$_) : - () - } grep { $_ ne $primary } $class->columns('Essential'); - - if ($class->find_column( 'last_xact_id' )) { - if ($OpenILS::Application::Storage::IGNORE_XACT_ID_FAILURE) { - $hash{last_xact_id} = 'unknown.'.time.'.'.$$.'.'.rand($$); - } else { - my $xact_id = $class->current_xact_id; - throw Error unless ($xact_id); - $hash{last_xact_id} = $xact_id; - } - } - - return $class->create( \%hash, @params ); - } else { - return undef; - } -} - -sub delete { - my $self = shift; - my $arg = shift; - my $orig = $self; - - my $class = ref($self) || $self; - - $self = $self->retrieve($arg) if (!ref($self)); - unless (defined $self) { - $log->debug("ARG! Couldn't retrieve record ".$arg->id, DEBUG); - throw OpenSRF::EX::WARN ("ARG! Couldn't retrieve record "); - } - - if ($class->find_column( 'last_xact_id' )) { - my $xact_id = $self->current_xact_id; - - throw Error ("Deleting from $class requires a transaction be established") - unless ($xact_id); - - throw Error ("The row you are attempting to delete has been changed since you read it") - unless ( $orig->last_xact_id eq $self->last_xact_id); - - $self->last_xact_id( $class->current_xact_id ); - $self->SUPER::update; - } - - $self->SUPER::delete; - - return 1; -} - -sub debug_object { - my $obj = shift; - my $string = ''; - - $string .= "Object type:\t".ref($obj)."\n"; - $string .= "Object string:\t$obj\n"; - - if (ref($obj) && UNIVERSAL::isa($obj => 'Fieldmapper')) { - $string .= "Object fields:\n"; - for my $col ($obj->real_fields()) { - $string .= "\t$col\t=> ".$obj->$col."\n"; - } - } elsif (ref($obj) && UNIVERSAL::isa($obj => 'Class::DBI')) { - $string .= "Object cols:\n"; - for my $col ($obj->columns('All')) { - $string .= "\t$col\t=> ".$obj->$col."\n"; - } - } elsif (ref($obj) && UNIVERSAL::isa($obj => 'HASH')) { - $string .= "Object keys and vals:\n"; - for my $col (keys %$obj) { - $string .= "\t$col\t=> $$obj{$col}\n"; - } - } - - $string .= "\n"; - - $log->debug($string,DEBUG); -} - - -sub update { - my $self = shift; - my $arg = shift; - - $log->debug("Attempting to update using $arg", DEBUG) if ($arg); - - if (ref($arg)) { - $self = $self->modify_from_fieldmapper($arg); - unless (defined $self) { - $log->debug("Modification of $arg seems to have failed....", DEBUG); - return undef; - } - } - - $log->debug("Calling Class::DBI->update on modified object $self", DEBUG); - - #debug_object($self); - - return $self->SUPER::update if ($self->is_changed); - return 0; -} - -sub modify_from_fieldmapper { - my $obj = shift; - my $fm = shift; - my $orig = $obj; - - #debug_object($obj); - #debug_object($fm); - - $log->debug("Modifying object using fieldmapper", DEBUG); - - my $class = ref($obj) || $obj; - my ($primary) = $class->columns('Primary'); - - - if (!ref($obj)) { - $obj = $class->retrieve($fm); - #debug_object($obj); - unless ($obj) { - $log->debug("Retrieve of $class using $fm (".$fm->id.") failed! -- ".shift(), ERROR); - throw OpenSRF::EX::WARN ("No $class with id of ".$fm->id."!!"); - } - } - - my %hash; - - if (ref($fm) and UNIVERSAL::isa($fm => 'Fieldmapper')) { - %hash = map { ($_ => $fm->$_) } grep { $_ ne $primary } $class->columns('Essential'); - delete $hash{passwd} if ($fm->isa('Fieldmapper::actor::user')); - } else { - %hash = %{$fm}; - } - - my $au = $obj->autoupdate; - $obj->autoupdate(0); - - #debug_object($obj); - - for my $field ( keys %hash ) { - $obj->$field( $hash{$field} ) if ($obj->$field ne $hash{$field}); - $log->debug("Setting field $field on $obj to $hash{$field}",INTERNAL); - } - - if ($class->find_column( 'last_xact_id' ) and $obj->is_changed) { - my ($xact_id) = OpenILS::Application::Storage->method_lookup('open-ils.storage.transaction.current')->run(); - throw Error ("Updating $class requires a transaction be established") - unless ($xact_id); - throw Error ("The row you are attempting to delete has been changed since you read it") - unless ( $fm->last_xact_id eq $obj->last_xact_id); - $obj->last_xact_id( $xact_id ); - } else { - $obj->autoupdate($au) - } - - return $obj; -} - - - - #------------------------------------------------------------------------------- - actor::user->has_a( home_ou => 'actor::org_unit' ); - actor::user->has_a( card => 'actor::card' ); - actor::user->has_a( standing => 'config::standing' ); - actor::user->has_a( profile => 'permission::grp_tree' ); - actor::user->has_a( mailing_address => 'actor::user_address' ); - actor::user->has_a( billing_address => 'actor::user_address' ); - actor::user->has_a( ident_type => 'config::identification_type' ); - actor::user->has_a( ident_type2 => 'config::identification_type' ); - actor::user->has_a( net_access_level => 'config::net_access_level' ); - - actor::user_address->has_a( usr => 'actor::user' ); - - actor::card->has_a( usr => 'actor::user' ); - - actor::workstation->has_a( owning_lib => 'actor::org_unit' ); - actor::org_unit::closed_date->has_a( org_unit => 'actor::org_unit' ); - actor::org_unit_setting->has_a( org_unit => 'actor::org_unit' ); - - actor::usr_note->has_a( usr => 'actor::user' ); - actor::user->has_many( notes => 'actor::usr_note' ); - - actor::user_standing_penalty->has_a( usr => 'actor::user' ); - actor::user->has_many( standing_penalties => 'actor::user_standing_penalty' ); - - actor::org_unit->has_a( parent_ou => 'actor::org_unit' ); - actor::org_unit->has_a( ou_type => 'actor::org_unit_type' ); - actor::org_unit->has_a( ill_address => 'actor::org_address' ); - actor::org_unit->has_a( holds_address => 'actor::org_address' ); - actor::org_unit->has_a( mailing_address => 'actor::org_address' ); - actor::org_unit->has_a( billing_address => 'actor::org_address' ); - actor::org_unit->has_many( children => 'actor::org_unit' => 'parent_ou' ); - actor::org_unit->has_many( workstations => 'actor::workstation' ); - actor::org_unit->has_many( closed_dates => 'actor::org_unit::closed_date' ); - actor::org_unit->has_many( settings => 'actor::org_unit_setting' ); - #actor::org_unit->might_have( hours_of_operation => 'actor::org_unit::hours_of_operation' ); - - actor::org_unit_type->has_a( parent => 'actor::org_unit_type' ); - actor::org_unit_type->has_many( children => 'actor::org_unit_type' => 'parent' ); - - actor::org_address->has_a( org_unit => 'actor::org_unit' ); - actor::org_unit->has_many( addresses => 'actor::org_address' ); - - action::transit_copy->has_a( source => 'actor::org_unit' ); - action::transit_copy->has_a( dest => 'actor::org_unit' ); - action::transit_copy->has_a( copy_status => 'config::copy_status' ); - - action::hold_transit_copy->has_a( source => 'actor::org_unit' ); - action::hold_transit_copy->has_a( dest => 'actor::org_unit' ); - action::hold_transit_copy->has_a( copy_status => 'config::copy_status' ); - action::hold_transit_copy->has_a( hold => 'action::hold_request' ); - - action::hold_request->has_many( transits => 'action::hold_transit_copy' ); - - actor::stat_cat_entry->has_a( stat_cat => 'actor::stat_cat' ); - actor::stat_cat->has_a( owner => 'actor::org_unit' ); - actor::stat_cat->has_many( entries => 'actor::stat_cat_entry' ); - actor::stat_cat_entry_user_map->has_a( stat_cat => 'actor::stat_cat' ); - actor::stat_cat_entry_user_map->has_a( stat_cat_entry => 'actor::stat_cat_entry' ); - actor::stat_cat_entry_user_map->has_a( target_usr => 'actor::user' ); - - asset::stat_cat_entry->has_a( stat_cat => 'asset::stat_cat' ); - asset::stat_cat->has_a( owner => 'actor::org_unit' ); - asset::stat_cat->has_many( entries => 'asset::stat_cat_entry' ); - asset::stat_cat_entry_copy_map->has_a( stat_cat => 'asset::stat_cat' ); - asset::stat_cat_entry_copy_map->has_a( stat_cat_entry => 'asset::stat_cat_entry' ); - asset::stat_cat_entry_copy_map->has_a( owning_copy => 'asset::copy' ); - - action::survey_response->has_a( usr => 'actor::user' ); - action::survey_response->has_a( survey => 'action::survey' ); - action::survey_response->has_a( question => 'action::survey_question' ); - action::survey_response->has_a( answer => 'action::survey_answer' ); - - action::survey_question->has_a( survey => 'action::survey' ); - - action::survey_answer->has_a( question => 'action::survey_question' ); - - asset::copy_note->has_a( owning_copy => 'asset::copy' ); - asset::copy_note->has_a( creator => 'actor::user' ); - - actor::user->has_many( stat_cat_entries => [ 'actor::stat_cat_entry_user_map' => 'stat_cat_entry' ] ); - actor::user->has_many( stat_cat_entry_user_maps => 'actor::stat_cat_entry_user_map' ); - - asset::copy->has_many( stat_cat_entries => [ 'asset::stat_cat_entry_copy_map' => 'stat_cat_entry' ] ); - asset::copy->has_many( stat_cat_entry_copy_maps => 'asset::stat_cat_entry_copy_map' ); - - asset::copy->has_a( call_number => 'asset::call_number' ); - asset::copy->has_a( creator => 'actor::user' ); - asset::copy->has_a( editor => 'actor::user' ); - asset::copy->has_a( status => 'config::copy_status' ); - asset::copy->has_a( location => 'asset::copy_location' ); - asset::copy->has_a( circ_lib => 'actor::org_unit' ); - - serial::unit->has_a( call_number => 'asset::call_number' ); - serial::unit->has_a( creator => 'actor::user' ); - serial::unit->has_a( editor => 'actor::user' ); - serial::unit->has_a( status => 'config::copy_status' ); - serial::unit->has_a( location => 'asset::copy_location' ); - serial::unit->has_a( circ_lib => 'actor::org_unit' ); - - serial::item->has_a( unit => 'serial::unit' ); - serial::item->has_a( issuance => 'serial::issuance' ); - serial::item->has_a( uri => 'asset::uri' ); - - serial::unit->has_many( items => 'serial::item' ); - - serial::issuance->has_a( subscription => 'serial::subscription' ); - serial::issuance->has_many( items => 'serial::item' ); - - serial::subscription->has_a( record_entry => 'biblio::record_entry' ); - serial::subscription->has_many( issuances => 'serial::issuance' ); - - asset::call_number_note->has_a( call_number => 'asset::call_number' ); - - asset::call_number->has_a( record => 'biblio::record_entry' ); - asset::call_number->has_a( creator => 'actor::user' ); - asset::call_number->has_a( editor => 'actor::user' ); - asset::call_number->has_a( owning_lib => 'actor::org_unit' ); - - authority::record_note->has_a( record => 'authority::record_entry' ); - biblio::record_note->has_a( record => 'biblio::record_entry' ); - - authority::record_entry->has_a( creator => 'actor::user' ); - authority::record_entry->has_a( editor => 'actor::user' ); - biblio::record_entry->has_a( creator => 'actor::user' ); - biblio::record_entry->has_a( editor => 'actor::user' ); - - metabib::metarecord->has_a( master_record => 'biblio::record_entry' ); - - authority::record_descriptor->has_a( record => 'authority::record_entry' ); - metabib::record_descriptor->has_a( record => 'biblio::record_entry' ); - - authority::full_rec->has_a( record => 'authority::record_entry' ); - metabib::full_rec->has_a( record => 'biblio::record_entry' ); - - metabib::title_field_entry->has_a( source => 'biblio::record_entry' ); - metabib::title_field_entry->has_a( field => 'config::metabib_field' ); - - metabib::identifier_field_entry->has_a( source => 'biblio::record_entry' ); - metabib::identifier_field_entry->has_a( field => 'config::metabib_field' ); - - metabib::author_field_entry->has_a( source => 'biblio::record_entry' ); - metabib::author_field_entry->has_a( field => 'config::metabib_field' ); - - metabib::subject_field_entry->has_a( source => 'biblio::record_entry' ); - metabib::subject_field_entry->has_a( field => 'config::metabib_field' ); - - metabib::keyword_field_entry->has_a( source => 'biblio::record_entry' ); - metabib::keyword_field_entry->has_a( field => 'config::metabib_field' ); - - metabib::series_field_entry->has_a( source => 'biblio::record_entry' ); - metabib::series_field_entry->has_a( field => 'config::metabib_field' ); - - metabib::metarecord_source_map->has_a( metarecord => 'metabib::metarecord' ); - metabib::metarecord_source_map->has_a( source => 'biblio::record_entry' ); - - action::circulation->has_a( usr => 'actor::user' ); - actor::user->has_many( circulations => 'action::circulation' => 'usr' ); - - booking::resource_attr_map->has_a( resource => 'booking::resource' ); - - booking::resource->has_a( owner => 'actor::org_unit' ); - booking::resource->has_a( type => 'booking::resource_type' ); - booking::resource_type->has_a( owner => 'actor::org_unit' ); - - booking::reservation->has_a( usr => 'actor::user' ); - actor::user->has_many( reservations => 'booking::reservation' => 'usr' ); - - action::circulation->has_a( circ_staff => 'actor::user' ); - actor::user->has_many( performed_circulations => 'action::circulation' => 'circ_staff' ); - - action::circulation->has_a( checkin_staff => 'actor::user' ); - actor::user->has_many( checkins => 'action::circulation' => 'checkin_staff' ); - - action::circulation->has_a( target_copy => 'asset::copy' ); - asset::copy->has_many( circulations => 'action::circulation' => 'target_copy' ); - serial::unit->has_many( circulations => 'action::circulation' => 'target_copy' ); - - booking::reservation->has_a( pickup_lib => 'actor::org_unit' ); - - action::circulation->has_a( circ_lib => 'actor::org_unit' ); - actor::org_unit->has_many( circulations => 'action::circulation' => 'circ_lib' ); - - action::circulation->has_a( checkin_lib => 'actor::org_unit' ); - actor::org_unit->has_many( checkins => 'action::circulation' => 'checkin_lib' ); - - money::billable_transaction->has_a( usr => 'actor::user' ); - #money::billable_transaction->might_have( circulation => 'action::circulation' ); - #money::billable_transaction->might_have( grocery => 'money::grocery' ); - actor::user->has_many( billable_transactions => 'action::circulation' => 'usr' ); - - - #------------------------------------------------------------------------------- - actor::user->has_many( survey_responses => 'action::survey_response' ); - actor::user->has_many( addresses => 'actor::user_address' ); - actor::user->has_many( cards => 'actor::card' ); - - actor::org_unit->has_many( users => 'actor::user' ); - - action::survey->has_many( questions => 'action::survey_question' ); - action::survey->has_many( responses => 'action::survey_response' ); - - action::survey_question->has_many( answers => 'action::survey_answer' ); - action::survey_question->has_many( responses => 'action::survey_response' ); - - action::survey_answer->has_many( responses => 'action::survey_response' ); - - asset::copy->has_many( notes => 'asset::copy_note' ); - asset::call_number->has_many( copies => 'asset::copy' ); - asset::call_number->has_many( notes => 'asset::call_number_note' ); - - authority::record_entry->has_many( record_descriptor => 'authority::record_descriptor' ); - authority::record_entry->has_many( notes => 'authority::record_note' ); - - biblio::record_entry->has_many( record_descriptor => 'metabib::record_descriptor' ); - biblio::record_entry->has_many( notes => 'biblio::record_note' ); - biblio::record_entry->has_many( call_numbers => 'asset::call_number' ); - biblio::record_entry->has_many( full_record_entries => 'metabib::full_rec' ); - biblio::record_entry->has_many( title_field_entries => 'metabib::title_field_entry' ); - biblio::record_entry->has_many( identifier_field_entries => 'metabib::identifier_field_entry' ); - biblio::record_entry->has_many( author_field_entries => 'metabib::author_field_entry' ); - biblio::record_entry->has_many( subject_field_entries => 'metabib::subject_field_entry' ); - biblio::record_entry->has_many( keyword_field_entries => 'metabib::keyword_field_entry' ); - biblio::record_entry->has_many( series_field_entries => 'metabib::series_field_entry' ); - - metabib::metarecord->has_many( source_records => [ 'metabib::metarecord_source_map' => 'source'] ); - biblio::record_entry->has_many( metarecords => [ 'metabib::metarecord_source_map' => 'metarecord'] ); - - money::billing->has_a( xact => 'money::billable_transaction' ); - money::payment->has_a( xact => 'money::billable_transaction' ); - - money::billable_transaction->has_many( billings => 'money::billing' ); - money::billable_transaction->has_many( payments => 'money::payment' ); - - action::circulation->has_many( billings => 'money::billing' => 'xact' ); - action::circulation->has_many( payments => 'money::payment' => 'xact' ); - #action::circulation->might_have( billable_transaction => 'money::billable_transaction' ); - #action::open_circulation->might_have( circulation => 'action::circulation' ); - - booking::reservation->has_many( billings => 'money::billing' => 'xact' ); - booking::reservation->has_many( payments => 'money::payment' => 'xact' ); - - action::in_house_use->has_a( org_unit => 'actor::org_unit' ); - action::in_house_use->has_a( staff => 'actor::user' ); - action::in_house_use->has_a( item => 'asset::copy' ); - - action::non_cataloged_circulation->has_a( circ_lib => 'actor::org_unit' ); - action::non_cataloged_circulation->has_a( item_type => 'config::non_cataloged_type' ); - action::non_cataloged_circulation->has_a( patron => 'actor::user' ); - action::non_cataloged_circulation->has_a( staff => 'actor::user' ); - - money::grocery->has_many( billings => 'money::billing' => 'xact' ); - money::grocery->has_many( payments => 'money::payment' => 'xact' ); - #money::grocery->might_have( billable_transaction => 'money::billable_transaction' ); - - #money::payment->might_have( cash_payment => 'money::cash_payment' ); - #money::payment->might_have( check_payment => 'money::check_payment' ); - #money::payment->might_have( credit_card_payment => 'money::credit_card_payment' ); - #money::payment->might_have( forgive_payment => 'money::forgive_payment' ); - #money::payment->might_have( work_payment => 'money::work_payment' ); - #money::payment->might_have( credit_payment => 'money::credit_payment' ); - - money::cash_payment->has_a( xact => 'money::billable_transaction' ); - money::cash_payment->has_a( accepting_usr => 'actor::user' ); - #money::cash_payment->might_have( payment => 'money::payment' ); - - money::check_payment->has_a( xact => 'money::billable_transaction' ); - money::check_payment->has_a( accepting_usr => 'actor::user' ); - #money::check_payment->might_have( payment => 'money::payment' ); - - money::credit_card_payment->has_a( xact => 'money::billable_transaction' ); - money::credit_card_payment->has_a( accepting_usr => 'actor::user' ); - #money::credit_card_payment->might_have( payment => 'money::payment' ); - - money::forgive_payment->has_a( xact => 'money::billable_transaction' ); - money::forgive_payment->has_a( accepting_usr => 'actor::user' ); - #money::forgive_payment->might_have( payment => 'money::payment' ); - - money::work_payment->has_a( xact => 'money::billable_transaction' ); - money::work_payment->has_a( accepting_usr => 'actor::user' ); - #money::work_payment->might_have( payment => 'money::payment' ); - - money::goods_payment->has_a( xact => 'money::billable_transaction' ); - money::goods_payment->has_a( accepting_usr => 'actor::user' ); - #money::goods_payment->might_have( payment => 'money::payment' ); - - money::credit_payment->has_a( xact => 'money::billable_transaction' ); - money::credit_payment->has_a( accepting_usr => 'actor::user' ); - #money::credit_payment->might_have( payment => 'money::payment' ); - - permission::grp_tree->has_a( parent => 'permission::grp_tree' ); - permission::grp_tree->has_many( children => 'permission::grp_tree' => 'parent' ); - - permission::grp_perm_map->has_a( grp => 'permission::grp_tree' ); - permission::grp_perm_map->has_a( perm => 'permission::perm_list' ); - permission::grp_perm_map->has_a( depth => 'actor::org_unit_type' ); - - permission::usr_perm_map->has_a( usr => 'actor::user' ); - permission::usr_perm_map->has_a( perm => 'permission::perm_list' ); - permission::usr_perm_map->has_a( depth => 'actor::org_unit_type' ); - - permission::usr_grp_map->has_a( usr => 'actor::user' ); - permission::usr_grp_map->has_a( grp => 'permission::grp_tree' ); - - action::hold_notification->has_a( hold => 'action::hold_request' ); - - action::hold_copy_map->has_a( hold => 'action::hold_request' ); - action::hold_copy_map->has_a( target_copy => 'asset::copy' ); - - action::unfulfilled_hold_list->has_a( current_copy => 'asset::copy' ); - action::unfulfilled_hold_list->has_a( hold => 'action::hold_request' ); - action::unfulfilled_hold_list->has_a( circ_lib => 'actor::org_unit' ); - - action::hold_request->has_a( current_copy => 'asset::copy' ); - action::hold_request->has_a( requestor => 'actor::user' ); - action::hold_request->has_a( usr => 'actor::user' ); - action::hold_request->has_a( fulfillment_staff => 'actor::user' ); - action::hold_request->has_a( pickup_lib => 'actor::org_unit' ); - action::hold_request->has_a( request_lib => 'actor::org_unit' ); - action::hold_request->has_a( fulfillment_lib => 'actor::org_unit' ); - action::hold_request->has_a( selection_ou => 'actor::org_unit' ); - - action::hold_request->has_many( notifications => 'action::hold_notification' ); - action::hold_request->has_many( eligible_copies => [ 'action::hold_copy_map' => 'target_copy' ] ); - - asset::copy->has_many( holds => [ 'action::hold_copy_map' => 'hold' ] ); - serial::unit->has_many( holds => [ 'action::hold_copy_map' => 'hold' ] ); - - container::biblio_record_entry_bucket->has_a( owner => 'actor::user' ); - container::biblio_record_entry_bucket_item->has_a( bucket => 'container::biblio_record_entry_bucket' ); - container::biblio_record_entry_bucket_item->has_a( target_biblio_record_entry => 'biblio::record_entry' ); - container::biblio_record_entry_bucket->has_many( items => 'container::biblio_record_entry_bucket_item' ); - - container::user_bucket->has_a( owner => 'actor::user' ); - container::user_bucket_item->has_a( bucket => 'container::user_bucket' ); - container::user_bucket_item->has_a( target_user => 'actor::user' ); - container::user_bucket->has_many( items => 'container::user_bucket_item' ); - - container::call_number_bucket->has_a( owner => 'actor::user' ); - container::call_number_bucket_item->has_a( bucket => 'container::call_number_bucket' ); - container::call_number_bucket_item->has_a( target_call_number => 'asset::call_number' ); - container::call_number_bucket->has_many( items => 'container::call_number_bucket_item' ); - - container::copy_bucket->has_a( owner => 'actor::user' ); - container::copy_bucket_item->has_a( bucket => 'container::copy_bucket' ); - container::copy_bucket_item->has_a( target_copy => 'asset::copy' ); - container::copy_bucket->has_many( items => 'container::copy_bucket_item' ); - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/action.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/action.pm deleted file mode 100644 index 8346ea4658..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/action.pm +++ /dev/null @@ -1,159 +0,0 @@ -package OpenILS::Application::Storage::CDBI::action; -our $VERSION = 1; - -#------------------------------------------------------------------------------- -package action; -use base qw/OpenILS::Application::Storage::CDBI/; -#------------------------------------------------------------------------------- - -package action::in_house_use; -use base qw/action/; -__PACKAGE__->table('action_in_house_use'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/item staff org_unit use_time/); -#------------------------------------------------------------------------------- - -package action::non_cat_in_house_use; -use base qw/action/; -__PACKAGE__->table('action_non_cat_in_house_use'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/item_type staff org_unit use_time/); -#------------------------------------------------------------------------------- - -package action::non_cataloged_circulation; -use base qw/action/; -__PACKAGE__->table('action_non_cataloged_circulation'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/patron staff circ_lib item_type circ_time/); -#------------------------------------------------------------------------------- - -package action::survey; -use base qw/action/; -__PACKAGE__->table('action_survey'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/name description owner start_date - end_date usr_summary opac poll required/); -#------------------------------------------------------------------------------- - -package action::survey_question; -use base qw/action/; -__PACKAGE__->table('action_survey_question'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/survey question/); -#------------------------------------------------------------------------------- - - -package action::survey_answer; -use base qw/action/; -__PACKAGE__->table('action_survey_answer'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/question answer/); -#------------------------------------------------------------------------------- - -package action::survey_response; -use base qw/action/; -__PACKAGE__->table('action_survey_response'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/response_group_id usr survey question - answer answer_date effective_date/); -#------------------------------------------------------------------------------- - -package action::circulation; -use base qw/action/; -__PACKAGE__->table('action_circulation'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/xact_start usr target_copy circ_lib - duration duration_rule renewal_remaining - recurring_fine_rule recurring_fine stop_fines - max_fine max_fine_rule fine_interval - stop_fines xact_finish due_date opac_renewal - checkin_staff circ_staff circ_lib checkin_lib - stop_fines_time checkin_time desk_renewal - phone_renewal create_time/); - -#------------------------------------------------------------------------------- - -package action::open_circulation; -use base qw/action/; -__PACKAGE__->table('action_open_circulation'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/xact_start usr target_copy circ_lib - duration duration_rule renewal_remaining - recurring_fine_rule recurring_fine stop_fines - max_fine max_fine_rule fine_interval - stop_fines xact_finish due_date opac_renewal - checkin_staff circ_staff circ_lib checkin_lib - stop_fines_time checkin_time desk_renewal - phone_renewal/); - -#------------------------------------------------------------------------------- - -package action::hold_request; -use base qw/action/; -__PACKAGE__->table('action_hold_request'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/request_time capture_time fulfillment_time - prev_check_time expire_time requestor usr cancel_cause - hold_type holdable_formats target cancel_time shelf_time - phone_notify email_notify selection_depth cancel_note - pickup_lib current_copy request_lib frozen thaw_date mint_condition - fulfillment_staff fulfillment_lib selection_ou cut_in_line/); - -#------------------------------------------------------------------------------- - -package action::hold_notification; -use base qw/action/; -__PACKAGE__->table('action_hold_notification'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/hold method notify_time note notify_staff/); - -#------------------------------------------------------------------------------- - -package action::hold_copy_map; -use base qw/action/; -__PACKAGE__->table('action_hold_copy_map'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/hold target_copy/); - -#------------------------------------------------------------------------------- - -package action::hold_transit_copy; -use base qw/action/; -__PACKAGE__->table('action_hold_transit_copy'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/source dest persistant_transfer target_copy - source_send_time dest_recv_time prev_hop prev_dest - copy_status hold/); - -#------------------------------------------------------------------------------- - -package action::reservation_transit_copy; -use base qw/action/; -__PACKAGE__->table('action_reservation_transit_copy'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/source dest persistant_transfer target_copy - source_send_time dest_recv_time prev_hop prev_dest - copy_status reservation/); - -#------------------------------------------------------------------------------- - -package action::transit_copy; -use base qw/action/; -__PACKAGE__->table('action_transit_copy'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/source dest persistant_transfer target_copy - source_send_time dest_recv_time prev_hop prev_dest - copy_status/); - -#------------------------------------------------------------------------------- - -package action::unfulfilled_hold_list; -use base qw/action/; -__PACKAGE__->table('action_unfulfilled_hold_list'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/hold current_copy circ_lib fail_time /); - -#------------------------------------------------------------------------------- - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/actor.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/actor.pm deleted file mode 100644 index 598fba9afa..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/actor.pm +++ /dev/null @@ -1,182 +0,0 @@ -package OpenILS::Application::Storage::CDBI::actor; -our $VERSION = 1; - -#------------------------------------------------------------------------------- -package actor; -use base qw/OpenILS::Application::Storage::CDBI/; -#------------------------------------------------------------------------------- -package actor::user; -use base qw/actor/; - -__PACKAGE__->table( 'actor_usr' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/usrname email first_given_name - second_given_name family_name billing_address - claims_returned_count home_ou dob deleted juvenile - active master_account ident_type ident_value - ident_type2 ident_value2 net_access_level alias - photo_url create_date expire_date credit_forward_balance - super_user usrgroup passwd card last_xact_id - standing barred profile prefix suffix alert_message - day_phone evening_phone other_phone mailing_address/ ); - -#------------------------------------------------------------------------------- -package actor::usr_org_unit_opt_in; -use base qw/actor/; -__PACKAGE__->table( 'actor_usr_org_unit_opt_in' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/org_unit usr staff opt_in_ts opt_in_ws/ ); - -#------------------------------------------------------------------------------- -package actor::org_unit_proximity; -use base qw/actor/; -__PACKAGE__->table( 'actor_org_unit_proximity' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/from_org to_org prox/ ); - -#------------------------------------------------------------------------------- -package actor::usr_note; -use base qw/actor/; - -__PACKAGE__->table( 'actor_usr_note' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/usr title creator create_date value pub/ ); - -#------------------------------------------------------------------------------- -package actor::workstation; -use base qw/actor/; - -__PACKAGE__->table( 'actor_workstation' ); -__PACKAGE__->columns( Primary => qw/id/); -__PACKAGE__->columns( Essential => qw/name owning_lib/); - -#------------------------------------------------------------------------------- -package actor::user_standing_penalty; -use base qw/actor/; - -__PACKAGE__->table( 'actor_user_standing_penalty' ); -__PACKAGE__->columns( Primary => qw/id/); -__PACKAGE__->columns( Essential => qw/usr penalty_type/); - -#------------------------------------------------------------------------------- -package actor::user_setting; -use base qw/actor/; - -__PACKAGE__->table( 'actor_user_setting' ); -__PACKAGE__->columns( Primary => qw/id/); -__PACKAGE__->columns( Essential => qw/usr name value/); - -#------------------------------------------------------------------------------- -package actor::org_unit_type; -use base qw/actor/; - -__PACKAGE__->table( 'actor_org_unit_type' ); -__PACKAGE__->columns( Primary => qw/id/); -__PACKAGE__->columns( Essential => qw/name opac_label depth parent can_have_vols can_have_users/); - -#------------------------------------------------------------------------------- -package actor::org_unit; -use base qw/actor/; - -__PACKAGE__->table( 'actor_org_unit' ); -__PACKAGE__->columns( Primary => qw/id/); -__PACKAGE__->columns( Essential => qw/parent_ou ou_type mailing_address billing_address - ill_address holds_address shortname name email phone opac_visible fiscal_calendar/); - -#------------------------------------------------------------------------------- -package actor::org_unit::hours_of_operation; -use base qw/actor/; - -__PACKAGE__->table( 'actor_hours_of_operation' ); -__PACKAGE__->columns( Primary => qw/id/); -__PACKAGE__->columns( Essential => qw/dow_0_open dow_0_close dow_1_open dow_1_close dow_2_open dow_2_close - dow_3_open dow_3_close dow_4_open dow_4_close dow_5_open dow_5_close - dow_6_open dow_6_close/); - -#------------------------------------------------------------------------------- -package actor::org_unit::closed_date; -use base qw/actor/; - -__PACKAGE__->table( 'actor_org_unit_closed' ); -__PACKAGE__->columns( Primary => qw/id/); -__PACKAGE__->columns( Essential => qw/org_unit close_start close_end reason/); - - -#------------------------------------------------------------------------------- -package actor::org_unit_setting; -use base qw/actor/; - -__PACKAGE__->table( 'actor_org_unit_setting' ); -__PACKAGE__->columns( Primary => qw/id/); -__PACKAGE__->columns( Essential => qw/org_unit name value/); - - -#------------------------------------------------------------------------------- -package actor::stat_cat; -use base qw/actor/; - -__PACKAGE__->table( 'actor_stat_cat' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/owner name opac_visible usr_summary/ ); - -#------------------------------------------------------------------------------- -package actor::stat_cat_entry; -use base qw/actor/; - -__PACKAGE__->table( 'actor_stat_cat_entry' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/stat_cat owner value/ ); - -#------------------------------------------------------------------------------- -package actor::stat_cat_entry_user_map; -use base qw/actor/; - -__PACKAGE__->table( 'actor_stat_cat_entry_usr_map' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/stat_cat stat_cat_entry target_usr/ ); - -#------------------------------------------------------------------------------- -package actor::card; -use base qw/actor/; - -__PACKAGE__->table( 'actor_card' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/usr barcode active/ ); - -#------------------------------------------------------------------------------- -package actor::user_access_entry; -use base qw/actor/; -#------------------------------------------------------------------------------- -package actor::perm_group; -use base qw/actor/; -#------------------------------------------------------------------------------- -package actor::permission; -use base qw/actor/; -#------------------------------------------------------------------------------- -package actor::perm_group_permission_map; -use base qw/actor/; -#------------------------------------------------------------------------------- -package actor::perm_group_user_map; -use base qw/actor/; -#------------------------------------------------------------------------------- -package actor::user_address; -use base qw/actor/; - -__PACKAGE__->table( 'actor_usr_address' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/valid address_type usr street1 street2 - city county state country post_code - within_city_limits/ ); - -#------------------------------------------------------------------------------- -package actor::org_address; -use base qw/actor/; - -__PACKAGE__->table( 'actor_org_address' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/valid address_type org_unit street1 street2 - city county state country post_code/ ); - -#------------------------------------------------------------------------------- -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/asset.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/asset.pm deleted file mode 100644 index 39eb01b2ad..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/asset.pm +++ /dev/null @@ -1,97 +0,0 @@ -package OpenILS::Application::Storage::CDBI::asset; -our $VERSION = 1; - -#------------------------------------------------------------------------------- -package asset; -use base qw/OpenILS::Application::Storage::CDBI/; -#------------------------------------------------------------------------------- -package asset::copy_location; -use base qw/asset/; - -__PACKAGE__->table( 'asset_copy_location' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/name owning_lib holdable hold_verify opac_visible circulate label_prefix label_suffix/ ); - -#------------------------------------------------------------------------------- -package asset::copy_location_order; -use base qw/asset/; - -__PACKAGE__->table( 'asset_copy_location_order' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/location org position/ ); - -#------------------------------------------------------------------------------- -package asset::call_number_class; -use base qw/asset/; - -__PACKAGE__->table( 'asset_call_number_class' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/name normalizer field/ ); - -#------------------------------------------------------------------------------- -package asset::call_number; -use base qw/asset/; - -__PACKAGE__->table( 'asset_call_number' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/record label creator create_date editor - edit_date record label owning_lib deleted label_class label_sortkey/ ); - -#------------------------------------------------------------------------------- -package asset::call_number_note; -use base qw/asset/; - -__PACKAGE__->table( 'asset_call_number_note' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/call_number title creator create_date value pub/ ); - -#------------------------------------------------------------------------------- -package asset::copy; -use base qw/asset/; - -__PACKAGE__->table( 'asset_copy' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/call_number barcode creator create_date editor - edit_date copy_number status loan_duration circ_lib dummy_isbn - fine_level circulate deposit price ref opac_visible - circ_as_type circ_modifier deposit_amount location mint_condition - holdable dummy_title dummy_author deleted alert_message - age_protect floating cost status_changed_time/ ); - -#------------------------------------------------------------------------------- -package asset::stat_cat; -use base qw/asset/; - -__PACKAGE__->table( 'asset_stat_cat' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/owner name opac_visible required/ ); - -#------------------------------------------------------------------------------- -package asset::stat_cat_entry; -use base qw/asset/; - -__PACKAGE__->table( 'asset_stat_cat_entry' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/stat_cat owner value/ ); - -#------------------------------------------------------------------------------- -package asset::stat_cat_entry_copy_map; -use base qw/asset/; - -__PACKAGE__->table( 'asset_stat_cat_entry_copy_map' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/stat_cat stat_cat_entry owning_copy/ ); - -#------------------------------------------------------------------------------- -package asset::copy_note; -use base qw/asset/; - -__PACKAGE__->table( 'asset_copy_note' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/owning_copy title creator create_date value pub/ ); - -#------------------------------------------------------------------------------- - - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/authority.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/authority.pm deleted file mode 100644 index 64a035032c..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/authority.pm +++ /dev/null @@ -1,47 +0,0 @@ -package OpenILS::Application::Storage::CDBI::authority; -our $VERSION = 1; - -#------------------------------------------------------------------------------- -package authority; -use base qw/OpenILS::Application::Storage::CDBI/; -#------------------------------------------------------------------------------- -package authority::record_entry; -use base qw/authority/; - -authority::record_entry->table( 'authority_record_entry' ); -authority::record_entry->columns( Primary => qw/id/ ); -authority::record_entry->columns( Essential => qw/creator editor - create_date edit_date source active - deleted marc last_xact_id/ ); - -#------------------------------------------------------------------------------- -package authority::record_note; -use base qw/authority/; - -authority::record_note->table( 'authority_record_note' ); -authority::record_note->columns( Primary => qw/id/ ); -authority::record_note->columns( Essential => qw/record value creator - editor create_date edit_date/ ); -#------------------------------------------------------------------------------- -package authority::full_rec; -use base qw/authority/; - -authority::full_rec->table( 'authority_full_rec' ); -authority::full_rec->columns( Primary => qw/id/ ); -authority::full_rec->columns( Essential => qw/record tag ind1 ind2 subfield value/ ); - -#------------------------------------------------------------------------------- -package authority::record_descriptor; -use base qw/authority/; -#use OpenILS::Application::Storage::CDBI::asset; - -authority::record_descriptor->table( 'authority_rec_descriptor' ); -authority::record_descriptor->columns( Primary => qw/id/ ); -authority::record_descriptor->columns( Essential => qw/record record_status - char_encoding/ ); - -#------------------------------------------------------------------------------- - - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/biblio.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/biblio.pm deleted file mode 100644 index 46fefaab6e..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/biblio.pm +++ /dev/null @@ -1,26 +0,0 @@ -package OpenILS::Application::Storage::CDBI::biblio; -our $VERSION = 1; - -#------------------------------------------------------------------------------- -package biblio; -use base qw/OpenILS::Application::Storage::CDBI/; -#------------------------------------------------------------------------------- -package biblio::record_entry; -use base qw/biblio/; - -biblio::record_entry->table( 'biblio_record_entry' ); -biblio::record_entry->columns( Essential => qw/id tcn_source tcn_value creator editor - create_date edit_date source active quality owner share_depth - deleted marc last_xact_id fingerprint/ ); - -#------------------------------------------------------------------------------- -package biblio::record_note; -use base qw/biblio/; - -biblio::record_note->table( 'biblio_record_note' ); -biblio::record_note->columns( Essential => qw/id record value creator - editor create_date edit_date pub/ ); -#------------------------------------------------------------------------------- - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/booking.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/booking.pm deleted file mode 100644 index e2b60fa5e1..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/booking.pm +++ /dev/null @@ -1,57 +0,0 @@ -package OpenILS::Application::Storage::CDBI::booking; -our $VERSION = 1; - -#------------------------------------------------------------------------------- -package booking; -use base qw/OpenILS::Application::Storage::CDBI/; -#------------------------------------------------------------------------------- - -package booking::resource_type; -use base qw/booking/; -__PACKAGE__->table('booking_resource_type'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/name fine_interval fine_amount - max_fine owner catalog_item record transferable elbow_room/); - -#------------------------------------------------------------------------------- - -package booking::resource; -use base qw/booking/; -__PACKAGE__->table('booking_resource'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/owner type overbook barcode deposit - deposit_amount user_fee/); - -#------------------------------------------------------------------------------- - -package booking::reservation; -use base qw/booking/; -__PACKAGE__->table('booking_reservation'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/xact_start usr current_resource - fine_amount max_fine fine_interval xact_finish - capture_staff pickup_lib request_time start_time end_time - capture_time cancel_time pickup_time return_time - booking_interval target_resource_type target_resource - current_resource request_lib/); - -#------------------------------------------------------------------------------- - -package booking::resource_attr_map; -use base qw/booking/; -__PACKAGE__->table('booking_resource_attr_map'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/resource resource_attr value/); - -#------------------------------------------------------------------------------- - -package booking::reservation_attr_value_map; -use base qw/booking/; -__PACKAGE__->table('booking_reservation_attr_value_map'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/reservation attr_value/); - -#------------------------------------------------------------------------------- - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/config.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/config.pm deleted file mode 100644 index bde4372981..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/config.pm +++ /dev/null @@ -1,137 +0,0 @@ -package OpenILS::Application::Storage::CDBI::config; -our $VERSION = 1; - -#------------------------------------------------------------------------------- -package config; -use base qw/OpenILS::Application::Storage::CDBI/; -#------------------------------------------------------------------------------- - -package config::non_cataloged_type; -use base qw/config/; -__PACKAGE__->table('config_non_cataloged_type'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/owning_lib name circ_duration in_house/); -#------------------------------------------------------------------------------- - -package config::standing; -use base qw/config/; -__PACKAGE__->table('config_standing'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/value/); -#------------------------------------------------------------------------------- - -package config::bib_source; -use base qw/config/; -__PACKAGE__->table('config_bib_source'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/quality source transcendant/); -#------------------------------------------------------------------------------- - -package config::metabib_field; -use base qw/config/; -__PACKAGE__->table('config_metabib_field'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/field_class name xpath weight format search_field facet_field/); -#------------------------------------------------------------------------------- - -package config::identification_type; -use base qw/config/; -__PACKAGE__->table('config_identification_type'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/name/); -#------------------------------------------------------------------------------- - -package config::rules::circ_duration; -use base qw/config/; -__PACKAGE__->table('config_rule_circ_duration'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/name extended normal shrt max_renewals/); -#------------------------------------------------------------------------------- - -package config::rules::max_fine; -use base qw/config/; -__PACKAGE__->table('config_rule_max_fine'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/name amount is_percent/); -#------------------------------------------------------------------------------- - -package config::rules::recurring_fine; -use base qw/config/; -__PACKAGE__->table('config_rule_recurring_fine'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/name high normal low recurrence_interval/); -#------------------------------------------------------------------------------- - -package config::rules::age_hold_protect; -use base qw/config/; -__PACKAGE__->table('config_rule_age_hold_protect'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/name age prox/); -#------------------------------------------------------------------------------- - -package config::copy_status; -use base qw/config/; -__PACKAGE__->table('config_copy_status'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/name holdable opac_visible/); -#------------------------------------------------------------------------------- - -package config::net_access_level; -use base qw/config/; -__PACKAGE__->table('config_net_access_level'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/name/); -#------------------------------------------------------------------------------- - -package config::audience_map; -use base qw/config/; -__PACKAGE__->table('config_audience_map'); -__PACKAGE__->columns(Primary => 'code'); -__PACKAGE__->columns(Essential => qw/value description/); -#------------------------------------------------------------------------------- - -package config::lit_form_map; -use base qw/config/; -__PACKAGE__->table('config_lit_form_map'); -__PACKAGE__->columns(Primary => 'code'); -__PACKAGE__->columns(Essential => qw/value description/); -#------------------------------------------------------------------------------- - -package config::item_form_map; -use base qw/config/; -__PACKAGE__->table('config_lit_form_map'); -__PACKAGE__->columns(Primary => 'code'); -__PACKAGE__->columns(Essential => qw/value/); -#------------------------------------------------------------------------------- - -package config::item_type_map; -use base qw/config/; -__PACKAGE__->table('config_lit_form_map'); -__PACKAGE__->columns(Primary => 'code'); -__PACKAGE__->columns(Essential => qw/value/); -#------------------------------------------------------------------------------- - -package config::language_map; -use base qw/config/; -__PACKAGE__->table('config_language_map'); -__PACKAGE__->columns(Primary => 'code'); -__PACKAGE__->columns(Essential => qw/value/); -#------------------------------------------------------------------------------- - -package config::i18n_locale; -use base qw/config/; -__PACKAGE__->table('config_i18n_locale'); -__PACKAGE__->columns(Primary => 'code'); -__PACKAGE__->columns(Essential => qw/marc_code name description/); -#------------------------------------------------------------------------------- - -package config::i18n_core; -use base qw/config/; -__PACKAGE__->table('config_i18n_core'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/fq_field identity_value translation string/); -#------------------------------------------------------------------------------- - - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/container.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/container.pm deleted file mode 100644 index c26d7ae5f0..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/container.pm +++ /dev/null @@ -1,73 +0,0 @@ -package OpenILS::Application::Storage::CDBI::container; -our $VERSION = 1; - -#------------------------------------------------------------------------------- -package container; -use base qw/OpenILS::Application::Storage::CDBI/; -#------------------------------------------------------------------------------- -package container::user_bucket; -use base qw/container/; - -container::user_bucket->table( 'container_user_bucket' ); -container::user_bucket->columns( Primary => qw/id/ ); -container::user_bucket->columns( Essential => qw/owner name btype pub/ ); - -#------------------------------------------------------------------------------- -package container::user_bucket_item; -use base qw/container/; - -container::user_bucket_item->table( 'container_user_bucket_item' ); -container::user_bucket_item->columns( Primary => qw/id/ ); -container::user_bucket_item->columns( Essential => qw/bucket target_user/ ); - -#------------------------------------------------------------------------------- -package container::copy_bucket; -use base qw/container/; - -container::copy_bucket->table( 'container_copy_bucket' ); -container::copy_bucket->columns( Primary => qw/id/ ); -container::copy_bucket->columns( Essential => qw/owner name btype pub/ ); - -#------------------------------------------------------------------------------- -package container::copy_bucket_item; -use base qw/container/; - -container::copy_bucket_item->table( 'container_copy_bucket_item' ); -container::copy_bucket_item->columns( Primary => qw/id/ ); -container::copy_bucket_item->columns( Essential => qw/bucket target_copy/ ); - -#------------------------------------------------------------------------------- -package container::biblio_record_entry_bucket; -use base qw/container/; - -container::biblio_record_entry_bucket->table( 'container_biblio_record_entry_bucket' ); -container::biblio_record_entry_bucket->columns( Primary => qw/id/ ); -container::biblio_record_entry_bucket->columns( Essential => qw/owner name btype pub/ ); - -#------------------------------------------------------------------------------- -package container::biblio_record_entry_bucket_item; -use base qw/container/; - -container::biblio_record_entry_bucket_item->table( 'container_biblio_record_entry_bucket_item' ); -container::biblio_record_entry_bucket_item->columns( Primary => qw/id/ ); -container::biblio_record_entry_bucket_item->columns( Essential => qw/bucket target_biblio_record_entry/ ); - -#------------------------------------------------------------------------------- -package container::call_number_bucket; -use base qw/container/; - -container::call_number_bucket->table( 'container_call_number_bucket' ); -container::call_number_bucket->columns( Primary => qw/id/ ); -container::call_number_bucket->columns( Essential => qw/owner name btype pub/ ); - -#------------------------------------------------------------------------------- -package container::call_number_bucket_item; -use base qw/container/; - -container::call_number_bucket_item->table( 'container_call_number_bucket_item' ); -container::call_number_bucket_item->columns( Primary => qw/id/ ); -container::call_number_bucket_item->columns( Essential => qw/bucket target_call_number/ ); - - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/metabib.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/metabib.pm deleted file mode 100644 index 1316e93279..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/metabib.pm +++ /dev/null @@ -1,97 +0,0 @@ -package OpenILS::Application::Storage::CDBI::metabib; -our $VERSION = 1; - -#------------------------------------------------------------------------------- -package metabib; -use base qw/OpenILS::Application::Storage::CDBI/; -#------------------------------------------------------------------------------- -package metabib::metarecord; -use base qw/metabib/; - -metabib::metarecord->table( 'metabib_metarecord' ); -metabib::metarecord->columns( Primary => qw/id/ ); -metabib::metarecord->columns( Essential => qw/fingerprint master_record mods/ ); - -#------------------------------------------------------------------------------- -package metabib::identifier_field_entry; -use base qw/metabib/; - -metabib::identifier_field_entry->table( 'metabib_identifier_field_entry' ); -metabib::identifier_field_entry->columns( Primary => qw/id/ ); -metabib::identifier_field_entry->columns( Essential => qw/field value source/ ); - - -#------------------------------------------------------------------------------- -package metabib::title_field_entry; -use base qw/metabib/; - -metabib::title_field_entry->table( 'metabib_title_field_entry' ); -metabib::title_field_entry->columns( Primary => qw/id/ ); -metabib::title_field_entry->columns( Essential => qw/field value source/ ); - - -#------------------------------------------------------------------------------- -package metabib::author_field_entry; -use base qw/metabib/; - -metabib::author_field_entry->table( 'metabib_author_field_entry' ); -metabib::author_field_entry->columns( Primary => qw/id/ ); -metabib::author_field_entry->columns( Essential => qw/field value source/ ); - - -#------------------------------------------------------------------------------- -package metabib::subject_field_entry; -use base qw/metabib/; - -metabib::subject_field_entry->table( 'metabib_subject_field_entry' ); -metabib::subject_field_entry->columns( Primary => qw/id/ ); -metabib::subject_field_entry->columns( Essential => qw/field value source/ ); - - -#------------------------------------------------------------------------------- -package metabib::keyword_field_entry; -use base qw/metabib/; - -metabib::keyword_field_entry->table( 'metabib_keyword_field_entry' ); -metabib::keyword_field_entry->columns( Primary => qw/id/ ); -metabib::keyword_field_entry->columns( Essential => qw/field value source/ ); - -#------------------------------------------------------------------------------- -package metabib::series_field_entry; -use base qw/metabib/; - -metabib::series_field_entry->table( 'metabib_series_field_entry' ); -metabib::series_field_entry->columns( Primary => qw/id/ ); -metabib::series_field_entry->columns( Essential => qw/field value source/ ); - -#------------------------------------------------------------------------------- -package metabib::metarecord_source_map; -use base qw/metabib/; - -metabib::metarecord_source_map->table( 'metabib_metarecord_source_map' ); -metabib::metarecord_source_map->columns( Primary => qw/id/ ); -metabib::metarecord_source_map->columns( Essential => qw/metarecord source/ ); - -#------------------------------------------------------------------------------- -package metabib::full_rec; -use base qw/metabib/; - -metabib::full_rec->table( 'metabib_full_rec' ); -metabib::full_rec->columns( Primary => qw/id/ ); -metabib::full_rec->columns( Essential => qw/record tag ind1 ind2 subfield value/ ); - -#------------------------------------------------------------------------------- -package metabib::record_descriptor; -use base qw/metabib/; -#use OpenILS::Application::Storage::CDBI::asset; - -metabib::record_descriptor->table( 'metabib_rec_descriptor' ); -metabib::record_descriptor->columns( Primary => qw/id/ ); -metabib::record_descriptor->columns( Essential => qw/record item_type item_form bib_level - control_type char_encoding enc_level lit_form vr_format - cat_form pub_status item_lang audience type_mat date1 date2/ ); - -#------------------------------------------------------------------------------- - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/money.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/money.pm deleted file mode 100644 index ab21f8495d..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/money.pm +++ /dev/null @@ -1,148 +0,0 @@ -package OpenILS::Application::Storage::CDBI::money; -our $VERSION = 1; - -#------------------------------------------------------------------------------- -package money; -use base qw/OpenILS::Application::Storage::CDBI/; -#------------------------------------------------------------------------------- - -package money::collections_tracker; -use base qw/money/; -__PACKAGE__->table('money_collections_tracker'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/usr collector location enter_time/); -#------------------------------------------------------------------------------- - -package money::billable_transaction; -use base qw/money/; -__PACKAGE__->table('money_billable_xact'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/xact_start usr xact_finish unrecovered/); -#------------------------------------------------------------------------------- - -package money::grocery; -use base qw/money/; -__PACKAGE__->table('money_grocery'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/xact_start usr billing_location note xact_finish/); -#------------------------------------------------------------------------------- - -package money::open_user_summary; -use base qw/money/; -__PACKAGE__->table('money_open_user_summary'); -__PACKAGE__->columns(Primary => 'usr'); -__PACKAGE__->columns(Essential => qw/total_paid total_owed balance_owed/); -#------------------------------------------------------------------------------- - -package money::user_summary; -use base qw/money/; -__PACKAGE__->table('money_user_summary'); -__PACKAGE__->columns(Primary => 'usr'); -__PACKAGE__->columns(Essential => qw/total_paid total_owed balance_owed/); -#------------------------------------------------------------------------------- - -package money::open_user_circulation_summary; -use base qw/money/; -__PACKAGE__->table('money_open_user_circulation_summary'); -__PACKAGE__->columns(Primary => 'usr'); -__PACKAGE__->columns(Essential => qw/total_paid total_owed balance_owed/); -#------------------------------------------------------------------------------- - -package money::user_circulation_summary; -use base qw/money/; -__PACKAGE__->table('money_user_circulation_summary'); -__PACKAGE__->columns(Primary => 'usr'); -__PACKAGE__->columns(Essential => qw/total_paid total_owed balance_owed/); -#------------------------------------------------------------------------------- - -package money::open_billable_transaction_summary; -use base qw/money/; -__PACKAGE__->table('money_open_billable_transaction_summary'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/xact_start usr xact_finish total_paid - last_payment_ts total_owed last_billing_ts - balance_owed xact_type last_billing_note last_billing_type - last_payment_note last_payment_type/); -#------------------------------------------------------------------------------- - -package money::billable_transaction_summary; -use base qw/money/; -__PACKAGE__->table('money_billable_transaction_summary'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/xact_start usr xact_finish total_paid - last_payment_ts total_owed last_billing_ts - balance_owed xact_type last_billing_note last_billing_type - last_payment_note last_payment_type/); -#------------------------------------------------------------------------------- - -package money::billing; -use base qw/money/; -__PACKAGE__->table('money_billing'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/xact amount billing_ts billing_type note - voided voider void_time btype/); -#------------------------------------------------------------------------------- - -package money::payment; -use base qw/money/; -__PACKAGE__->table('money_payment'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/xact amount payment_ts payment_type note voided/); -#------------------------------------------------------------------------------- - -package money::desk_payment; -use base qw/money/; -__PACKAGE__->table('money_desk_payment'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/xact amount payment_ts voided amount_collected accepting_usr cash_drawer payment_type note/); -#------------------------------------------------------------------------------- - -package money::cash_payment; -use base qw/money/; -__PACKAGE__->table('money_cash_payment'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/xact amount payment_ts cash_drawer accepting_usr amount_collected note/); -#------------------------------------------------------------------------------- - -package money::check_payment; -use base qw/money/; -__PACKAGE__->table('money_check_payment'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/xact amount payment_ts cash_drawer check_number accepting_usr amount_collected note/); -#------------------------------------------------------------------------------- - -package money::credit_card_payment; -use base qw/money/; -__PACKAGE__->table('money_credit_card_payment'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/xact amount payment_ts cash_drawer - accepting_usr amount_collected cc_type - cc_number expire_month expire_year - approval_code note/); -#------------------------------------------------------------------------------- - -package money::forgive_payment; -use base qw/money/; -__PACKAGE__->table('money_forgive_payment'); -__PACKAGE__->columns(Primary => 'id'); -__PACKAGE__->columns(Essential => qw/xact amount payment_ts accepting_usr amount_collected note/); -#------------------------------------------------------------------------------- - -package money::work_payment; -use base qw/money::forgive_payment/; -__PACKAGE__->table('money_work_payment'); -#------------------------------------------------------------------------------- - -package money::goods_payment; -use base qw/money::forgive_payment/; -__PACKAGE__->table('money_goods_payment'); -#------------------------------------------------------------------------------- - -package money::credit_payment; -use base qw/money::forgive_payment/; -__PACKAGE__->table('money_credit_payment'); - -#------------------------------------------------------------------------------- - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/permission.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/permission.pm deleted file mode 100644 index f56e1e585e..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/permission.pm +++ /dev/null @@ -1,46 +0,0 @@ -package OpenILS::Application::Storage::CDBI::permission; -our $VERSION = 1; - -#------------------------------------------------------------------------------- -package permission; -use base qw/OpenILS::Application::Storage::CDBI/; -#------------------------------------------------------------------------------- -package permission::perm_list; -use base qw/permission/; -__PACKAGE__->table('permission_perm_list'); -__PACKAGE__->columns(Primary => qw/id/); -__PACKAGE__->columns(Essential => qw/code description/); -#------------------------------------------------------------------------------- -package permission::grp_tree; -use base qw/permission/; -__PACKAGE__->table('permission_grp_tree'); -__PACKAGE__->columns(Primary => qw/id/); -__PACKAGE__->columns(Essential => qw/name parent description perm_interval - application_perm usergroup hold_priority/); -#------------------------------------------------------------------------------- -package permission::usr_grp_map; -use base qw/permission/; -__PACKAGE__->table('permission_usr_grp_map'); -__PACKAGE__->columns(Primary => qw/id/); -__PACKAGE__->columns(Essential => qw/usr grp/); -#------------------------------------------------------------------------------- -package permission::usr_perm_map; -use base qw/permission/; -__PACKAGE__->table('permission_usr_perm_map'); -__PACKAGE__->columns(Primary => qw/id/); -__PACKAGE__->columns(Essential => qw/usr perm depth grantable/); -#------------------------------------------------------------------------------- -package permission::grp_perm_map; -use base qw/permission/; -__PACKAGE__->table('permission_grp_perm_map'); -__PACKAGE__->columns(Primary => qw/id/); -__PACKAGE__->columns(Essential => qw/grp perm depth grantable/); -#------------------------------------------------------------------------------- -package permission::usr_work_ou_map; -use base qw/permission/; -__PACKAGE__->table('permission_usr_work_ou_map'); -__PACKAGE__->columns(Primary => qw/id/); -__PACKAGE__->columns(Essential => qw/usr work_ou/); -#------------------------------------------------------------------------------- -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/serial.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/serial.pm deleted file mode 100644 index 431c6729e8..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/CDBI/serial.pm +++ /dev/null @@ -1,62 +0,0 @@ -package OpenILS::Application::Storage::CDBI::serial; -our $VERSION = 1; - -#------------------------------------------------------------------------------- -package serial; -use base qw/OpenILS::Application::Storage::CDBI/; -#------------------------------------------------------------------------------- -package serial::subscription; -use base qw/serial/; - -__PACKAGE__->table( 'serial_subscription' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/record_entry start_date end_date - expected_date_offset owning_lib/ ); - -#------------------------------------------------------------------------------- -package serial::issuance; -use base qw/serial/; - -__PACKAGE__->table( 'serial_issuance' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/creator editor create_date edit_date - subscription label date_published - caption_and_pattern holding_code - holding_type holding_link_id/ ); - -#------------------------------------------------------------------------------- -package serial::item; -use base qw/serial/; - -__PACKAGE__->table( 'serial_item' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/creator editor create_date edit_date - issuance stream unit uri date_expected - date_received/ ); - -#------------------------------------------------------------------------------- -package serial::unit; -use base qw/serial/; - -__PACKAGE__->table( 'serial_unit' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/call_number barcode creator create_date editor - edit_date copy_number status loan_duration circ_lib - fine_level circulate deposit price ref opac_visible dummy_isbn - circ_as_type circ_modifier deposit_amount location mint_condition - holdable dummy_title dummy_author deleted alert_message - age_protect floating summary_contents detailed_contents/ ); - -#------------------------------------------------------------------------------- -package serial::record_entry; -use base qw/serial/; - -__PACKAGE__->table( 'serial_record_entry' ); -__PACKAGE__->columns( Primary => qw/id/ ); -__PACKAGE__->columns( Essential => qw/active record create_date creator - deleted edit_date editor id last_xact_id marc source - owning_lib/ ); - - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg.pm deleted file mode 100644 index 8fd85155d3..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg.pm +++ /dev/null @@ -1,195 +0,0 @@ - -{ # The driver package itself just needs a db_Main method (or db_Slaves if - #Class::DBI::Replication is in use) for Class::DBI to call. - # - # Any other fixups can go in here too... Also, the drivers should subclass the - # DBI driver that they are wrapping, or provide a 'quote()' method that calls - # the DBD::xxx::quote() method on FTI's behalf. - # - # The dirver MUST be a subclass of Class::DBI(::Replication) and - # OpenILS::Application::Storage. - #------------------------------------------------------------------------------- - package OpenILS::Application::Storage::Driver::Pg; - use OpenILS::Application::Storage::Driver::Pg::cdbi; - use OpenILS::Application::Storage::Driver::Pg::fts; - use OpenILS::Application::Storage::Driver::Pg::storage; - use OpenILS::Application::Storage::Driver::Pg::dbi; - use UNIVERSAL::require; - BEGIN { - 'Class::DBI::Frozen::301'->use or 'Class::DBI'->use or die $@; - } - use base qw/Class::DBI OpenILS::Application::Storage/; - use DBI; - use OpenSRF::EX qw/:try/; - use OpenSRF::DomainObject::oilsResponse; - use OpenSRF::Utils::Logger qw/:level/; - my $log = 'OpenSRF::Utils::Logger'; - - __PACKAGE__->set_sql( retrieve_limited => 'SELECT * FROM __TABLE__ ORDER BY id LIMIT ?' ); - __PACKAGE__->set_sql( copy_start => 'COPY %s (%s) FROM STDIN;' ); - __PACKAGE__->set_sql( copy_end => '\.' ); - - my $master_db; - my @slave_dbs; - my $_db_params; - - sub db_Handles { - return ($master_db, @slave_dbs); - } - - sub child_init { - my $self = shift; - $_db_params = shift; - - $log->debug("Running child_init inside ".__PACKAGE__, INTERNAL); - - $_db_params = [ $_db_params ] unless (ref($_db_params) eq 'ARRAY'); - - my %attrs = ( %{$self->_default_attributes}, - RootClass => 'DBIx::ContextualFetch', - ShowErrorStatement => 1, - RaiseError => 1, - AutoCommit => 1, - PrintError => 1, - Taint => 1, - #TraceLevel => "1|SQL", - pg_enable_utf8 => 1, - pg_server_prepare => 0, - FetchHashKeyName => 'NAME_lc', - ChopBlanks => 1, - ); - - my $master = shift @$_db_params; - $$master{port} ||= '5432'; - $$master{host} ||= 'localhost'; - $$master{db} ||= 'openils'; - - $log->debug("Attempting to connect to $$master{db} at $$master{host}", INFO); - - try { - $master_db = DBI->connect( - "dbi:Pg:". - "host=$$master{host};". - "port=$$master{port};". - "dbname=$$master{db}", - $$master{user}, - $$master{pw}, - \%attrs) - || do { sleep(1); - DBI->connect( - "dbi:Pg:". - "host=$$master{host};". - "port=$$master{port};". - "dbname=$$master{db}", - $$master{user}, - $$master{pw}, - \%attrs) } - || throw OpenSRF::EX::ERROR - ("Couldn't connect to $$master{db}". - " on $$master{host}::$$master{port}". - " as $$master{user}!!"); - } catch Error with { - my $e = shift; - $log->debug("Error connecting to database:\n\t$e\n\t$DBI::errstr", ERROR); - throw $e; - }; - - $log->debug("Connected to MASTER db $$master{db} at $$master{host}", INFO); - - $master_db->do("SET NAMES '$$master{client_encoding}';") if ($$master{client_encoding}); - - for my $db (@$_db_params) { - try { - push @slave_dbs, DBI->connect("dbi:Pg:host=$$db{host};port=$$db{port};dbname=$$db{db}",$$db{user},$$db{pw}, \%attrs) - || do { sleep(1); DBI->connect("dbi:Pg:host=$$db{host};port=$$db{port};dbname=$$db{db}",$$db{user},$$db{pw}, \%attrs) } - || throw OpenSRF::EX::ERROR - ("Couldn't connect to $$db{db}". - " on $$db{host}::$$db{port}". - " as $$db{user}!!"); - } catch Error with { - my $e = shift; - $log->debug("Error connecting to database:\n\t$e\n\t$DBI::errstr", ERROR); - throw $e; - }; - - $slave_dbs[-1]->do("SET NAMES '$$db{client_encoding}';") if ($$master{client_encoding}); - - $log->debug("Connected to MASTER db '$$master{db} at $$master{host}", INFO); - } - - $log->debug("All is well on the western front", INTERNAL); - } - - sub db_Main { - my $self = shift; - return $master_db if ($self->current_xact_session || $OpenILS::Application::Storage::WRITE); - return $master_db unless (@slave_dbs); - return ($master_db, @slave_dbs)[rand(scalar(@slave_dbs))]; - } - - sub quote { - my $self = shift; - return $self->db_Main->quote(@_) - } - -# sub tsearch2_trigger { -# my $self = shift; -# return unless ($self->value); -# $self->index_vector( -# $self->db_Slaves->selectrow_array( -# "SELECT to_tsvector('default',?);", -# {}, -# $self->value -# ) -# ); -# } - - my $_xact_session; - - sub current_xact_session { - my $self = shift; - if (defined($_xact_session)) { - return $_xact_session; - } - return undef; - } - - sub current_xact_is_auto { - my $self = shift; - my $auto = shift; - if (defined($_xact_session) and ref($_xact_session)) { - if (defined $auto) { - $_xact_session->session_data(autocommit => $auto); - } - return $_xact_session->session_data('autocommit'); - } - } - - sub current_xact_id { - my $self = shift; - if (defined($_xact_session) and ref($_xact_session)) { - return $_xact_session->session_id; - } - return undef; - } - - sub set_xact_session { - my $self = shift; - my $ses = shift; - if (!defined($ses)) { - return undef; - } - $_xact_session = $ses; - return $_xact_session; - } - - sub unset_xact_session { - my $self = shift; - my $ses = $_xact_session; - undef $_xact_session; - return $ses; - } - -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm deleted file mode 100644 index a27081e1d0..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm +++ /dev/null @@ -1,837 +0,0 @@ -package OpenILS::Application::Storage::Driver::Pg::QueryParser; -use OpenILS::Application::Storage::QueryParser; -use base 'QueryParser'; -use OpenSRF::Utils::JSON; -use OpenILS::Application::AppUtils; -my $U = 'OpenILS::Application::AppUtils'; - -sub quote_value { - my $self = shift; - my $value = shift; - - if ($value =~ /^\d/) { # may have to use non-$ quoting - $value =~ s/'/''/g; - $value =~ s/\\/\\\\/g; - return "E'$value'"; - } - return "\$_$$\$$value\$_$$\$"; -} - -sub quote_phrase_value { - my $self = shift; - my $value = shift; - - my $left_anchored = $value =~ m/^\^/; - my $right_anchored = $value =~ m/\$$/; - $value =~ s/\^// if $left_anchored; - $value =~ s/\$$// if $right_anchored; - $value =~ quotemeta($value); - $value = '^' . $value if $left_anchored; - $value = "$value\$" if $right_anchored; - return $self->quote_value($value); -} - -sub init { - my $class = shift; - -} - -sub default_preferred_language { - my $self = shift; - my $lang = shift; - - $self->custom_data->{default_preferred_language} = $lang if ($lang); - return $self->custom_data->{default_preferred_language}; -} - -sub default_preferred_language_multiplier { - my $self = shift; - my $lang = shift; - - $self->custom_data->{default_preferred_language_multiplier} = $lang if ($lang); - return $self->custom_data->{default_preferred_language_multiplier}; -} - -sub simple_plan { - my $self = shift; - - return 0 unless $self->parse_tree; - return 0 if @{$self->parse_tree->filters}; - return 0 if @{$self->parse_tree->modifiers}; - for my $node ( @{ $self->parse_tree->query_nodes } ) { - return 0 if (!ref($node) && $node eq '|'); - next unless (ref($node)); - return 0 if ($node->isa('QueryParser::query_plan')); - } - - return 1; -} - -sub toSQL { - my $self = shift; - return $self->parse_tree->toSQL; -} - -sub facet_field_id_map { - my $self = shift; - my $map = shift; - - $self->custom_data->{facet_field_id_map} ||= {}; - $self->custom_data->{facet_field_id_map} = $map if ($map); - return $self->custom_data->{facet_field_id_map}; -} - -sub add_facet_field_id_map { - my $self = shift; - my $class = shift; - my $field = shift; - my $id = shift; - my $weight = shift; - - $self->add_facet_field( $class => $field ); - $self->facet_field_id_map->{by_id}{$id} = { classname => $class, field => $field, weight => $weight }; - $self->facet_field_id_map->{by_class}{$class}{$field} = $id; - - return { - by_id => { $id => { classname => $class, field => $field, weight => $weight } }, - by_class => { $class => { $field => $id } } - }; -} - -sub facet_field_class_by_id { - my $self = shift; - my $id = shift; - - return $self->facet_field_id_map->{by_id}{$id}; -} - -sub facet_field_ids_by_class { - my $self = shift; - my $class = shift; - my $field = shift; - - return undef unless ($class); - - if ($field) { - return [$self->facet_field_id_map->{by_class}{$class}{$field}]; - } - - return [values( %{ $self->facet_field_id_map->{by_class}{$class} } )]; -} - -sub search_field_id_map { - my $self = shift; - my $map = shift; - - $self->custom_data->{search_field_id_map} ||= {}; - $self->custom_data->{search_field_id_map} = $map if ($map); - return $self->custom_data->{search_field_id_map}; -} - -sub add_search_field_id_map { - my $self = shift; - my $class = shift; - my $field = shift; - my $id = shift; - my $weight = shift; - - $self->add_search_field( $class => $field ); - $self->search_field_id_map->{by_id}{$id} = { classname => $class, field => $field, weight => $weight }; - $self->search_field_id_map->{by_class}{$class}{$field} = $id; - - return { - by_id => { $id => { classname => $class, field => $field, weight => $weight } }, - by_class => { $class => { $field => $id } } - }; -} - -sub search_field_class_by_id { - my $self = shift; - my $id = shift; - - return $self->search_field_id_map->{by_id}{$id}; -} - -sub search_field_ids_by_class { - my $self = shift; - my $class = shift; - my $field = shift; - - return undef unless ($class); - - if ($field) { - return [$self->search_field_id_map->{by_class}{$class}{$field}]; - } - - return [values( %{ $self->search_field_id_map->{by_class}{$class} } )]; -} - -sub relevance_bumps { - my $self = shift; - my $bumps = shift; - - $self->custom_data->{rel_bumps} ||= {}; - $self->custom_data->{rel_bumps} = $bumps if ($bumps); - return $self->custom_data->{rel_bumps}; -} - -sub find_relevance_bumps { - my $self = shift; - my $class = shift; - my $field = shift; - - return $self->relevance_bumps->{$class}{$field}; -} - -sub add_relevance_bump { - my $self = shift; - my $class = shift; - my $field = shift; - my $type = shift; - my $multiplier = shift; - my $active = shift; - - $active = 1 if (!defined($active)); - - $self->relevance_bumps->{$class}{$field}{$type} = { multiplier => $multiplier, active => $active }; - - return { $class => { $field => { $type => { multiplier => $multiplier, active => $active } } } }; -} - - -sub initialize_search_field_id_map { - my $self = shift; - my $cmf_list = shift; - - for my $cmf (@$cmf_list) { - __PACKAGE__->add_search_field_id_map( $cmf->field_class, $cmf->name, $cmf->id, $cmf->weight ) if ($U->is_true($cmf->search_field)); - __PACKAGE__->add_facet_field_id_map( $cmf->field_class, $cmf->name, $cmf->id, $cmf->weight ) if ($U->is_true($cmf->facet_field)); - } - - return $self->search_field_id_map; -} - -sub initialize_aliases { - my $self = shift; - my $cmsa_list = shift; - - for my $cmsa (@$cmsa_list) { - if (!$cmsa->field) { - __PACKAGE__->add_search_class_alias( $cmsa->field_class, $cmsa->alias ); - } else { - my $c = $self->search_field_class_by_id( $cmsa->field ); - __PACKAGE__->add_search_field_alias( $cmsa->field_class, $c->{field}, $cmsa->alias ); - } - } -} - -sub initialize_relevance_bumps { - my $self = shift; - my $sra_list = shift; - - for my $sra (@$sra_list) { - my $c = $self->search_field_class_by_id( $sra->field ); - __PACKAGE__->add_relevance_bump( $c->{classname}, $c->{field}, $sra->bump_type, $sra->multiplier ); - } - - return $self->relevance_bumps; -} - -sub initialize_normalizers { - my $self = shift; - my $tree = shift; # open-ils.cstore.direct.config.metabib_field_index_norm_map.search.atomic { "id" : { "!=" : null } }, { "flesh" : 1, "flesh_fields" : { "cmfinm" : ["norm"] }, "order_by" : [{ "class" : "cmfinm", "field" : "pos" }] } - - for my $cmfinm ( @$tree ) { - my $field_info = $self->search_field_class_by_id( $cmfinm->field ); - __PACKAGE__->add_query_normalizer( $field_info->{classname}, $field_info->{field}, $cmfinm->norm->func, OpenSRF::Utils::JSON->JSON2perl($cmfinm->params) ); - } -} - -our $_complete = 0; -sub initialization_complete { - return $_complete; -} - -sub initialize { - my $self = shift; - my %args = @_; - - return $_complete if ($_complete); - - $self->initialize_search_field_id_map( $args{config_metabib_field} ) - if ($args{config_metabib_field}); - - $self->initialize_aliases( $args{config_metabib_search_alias} ) - if ($args{config_metabib_search_alias}); - - $self->initialize_relevance_bumps( $args{search_relevance_adjustment} ) - if ($args{search_relevance_adjustment}); - - $self->initialize_normalizers( $args{config_metabib_field_index_norm_map} ) - if ($args{config_metabib_field_index_norm_map}); - - $_complete = 1 if ( - $args{config_metabib_field_index_norm_map} && - $args{search_relevance_adjustment} && - $args{config_metabib_search_alias} && - $args{config_metabib_field} - ); - - return $_complete; -} - -sub TEST_SETUP { - - __PACKAGE__->add_search_field_id_map( series => seriestitle => 1 => 1 ); - - __PACKAGE__->add_search_field_id_map( series => seriestitle => 1 => 1 ); - __PACKAGE__->add_relevance_bump( series => seriestitle => first_word => 1.5 ); - __PACKAGE__->add_relevance_bump( series => seriestitle => full_match => 20 ); - - __PACKAGE__->add_search_field_id_map( title => abbreviated => 2 => 1 ); - __PACKAGE__->add_relevance_bump( title => abbreviated => first_word => 1.5 ); - __PACKAGE__->add_relevance_bump( title => abbreviated => full_match => 20 ); - - __PACKAGE__->add_search_field_id_map( title => translated => 3 => 1 ); - __PACKAGE__->add_relevance_bump( title => translated => first_word => 1.5 ); - __PACKAGE__->add_relevance_bump( title => translated => full_match => 20 ); - - __PACKAGE__->add_search_field_id_map( title => proper => 6 => 1 ); - __PACKAGE__->add_query_normalizer( title => proper => 'naco_normalize' ); - __PACKAGE__->add_relevance_bump( title => proper => first_word => 1.5 ); - __PACKAGE__->add_relevance_bump( title => proper => full_match => 20 ); - __PACKAGE__->add_relevance_bump( title => proper => word_order => 10 ); - - __PACKAGE__->add_search_field_id_map( author => coporate => 7 => 1 ); - __PACKAGE__->add_relevance_bump( author => coporate => first_word => 1.5 ); - __PACKAGE__->add_relevance_bump( author => coporate => full_match => 20 ); - - __PACKAGE__->add_facet_field_id_map( author => personal => 8 => 1 ); - - __PACKAGE__->add_search_field_id_map( author => personal => 8 => 1 ); - __PACKAGE__->add_relevance_bump( author => personal => first_word => 1.5 ); - __PACKAGE__->add_relevance_bump( author => personal => full_match => 20 ); - __PACKAGE__->add_query_normalizer( author => personal => 'naco_normalize' ); - __PACKAGE__->add_query_normalizer( author => personal => 'split_date_range' ); - - __PACKAGE__->add_facet_field_id_map( subject => topic => 14 => 1 ); - - __PACKAGE__->add_search_field_id_map( subject => topic => 14 => 1 ); - __PACKAGE__->add_relevance_bump( subject => topic => first_word => 1 ); - __PACKAGE__->add_relevance_bump( subject => topic => full_match => 1 ); - - __PACKAGE__->add_search_field_id_map( subject => complete => 16 => 1 ); - __PACKAGE__->add_relevance_bump( subject => complete => first_word => 1 ); - __PACKAGE__->add_relevance_bump( subject => complete => full_match => 1 ); - - __PACKAGE__->add_search_field_id_map( keyword => keyword => 15 => 1 ); - __PACKAGE__->add_relevance_bump( keyword => keyword => first_word => 1 ); - __PACKAGE__->add_relevance_bump( keyword => keyword => full_match => 1 ); - - - __PACKAGE__->add_search_class_alias( keyword => 'kw' ); - __PACKAGE__->add_search_class_alias( title => 'ti' ); - __PACKAGE__->add_search_class_alias( author => 'au' ); - __PACKAGE__->add_search_class_alias( author => 'name' ); - __PACKAGE__->add_search_class_alias( author => 'dc.contributor' ); - __PACKAGE__->add_search_class_alias( subject => 'su' ); - __PACKAGE__->add_search_class_alias( subject => 'bib.subject(?:Title|Place|Occupation)' ); - __PACKAGE__->add_search_class_alias( series => 'se' ); - __PACKAGE__->add_search_class_alias( keyword => 'dc.identifier' ); - - __PACKAGE__->add_query_normalizer( author => corporate => 'naco_normalize' ); - __PACKAGE__->add_query_normalizer( keyword => keyword => 'naco_normalize' ); - - __PACKAGE__->add_search_field_alias( subject => name => 'bib.subjectName' ); - -} - -__PACKAGE__->default_search_class( 'keyword' ); - -__PACKAGE__->add_search_filter( 'audience' ); -__PACKAGE__->add_search_filter( 'vr_format' ); -__PACKAGE__->add_search_filter( 'format' ); -__PACKAGE__->add_search_filter( 'item_type' ); -__PACKAGE__->add_search_filter( 'item_form' ); -__PACKAGE__->add_search_filter( 'lit_form' ); -__PACKAGE__->add_search_filter( 'locations' ); -__PACKAGE__->add_search_filter( 'site' ); -__PACKAGE__->add_search_filter( 'lasso' ); -__PACKAGE__->add_search_filter( 'my_lasso' ); -__PACKAGE__->add_search_filter( 'depth' ); -__PACKAGE__->add_search_filter( 'sort' ); -__PACKAGE__->add_search_filter( 'language' ); -__PACKAGE__->add_search_filter( 'preferred_language' ); -__PACKAGE__->add_search_filter( 'preferred_language_weight' ); -__PACKAGE__->add_search_filter( 'preferred_language_multiplier' ); -__PACKAGE__->add_search_filter( 'statuses' ); -__PACKAGE__->add_search_filter( 'bib_level' ); -__PACKAGE__->add_search_filter( 'before' ); -__PACKAGE__->add_search_filter( 'after' ); -__PACKAGE__->add_search_filter( 'between' ); -__PACKAGE__->add_search_filter( 'during' ); -__PACKAGE__->add_search_filter( 'offset' ); -__PACKAGE__->add_search_filter( 'limit' ); -__PACKAGE__->add_search_filter( 'core_limit' ); -__PACKAGE__->add_search_filter( 'check_limit' ); -__PACKAGE__->add_search_filter( 'skip_check' ); -__PACKAGE__->add_search_filter( 'superpage' ); -__PACKAGE__->add_search_filter( 'superpage_size' ); -__PACKAGE__->add_search_filter( 'estimation_strategy' ); - -__PACKAGE__->add_search_modifier( 'available' ); -__PACKAGE__->add_search_modifier( 'descending' ); -__PACKAGE__->add_search_modifier( 'ascending' ); -__PACKAGE__->add_search_modifier( 'metarecord' ); -__PACKAGE__->add_search_modifier( 'metabib' ); -__PACKAGE__->add_search_modifier( 'staff' ); - - -#------------------------------- -package OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan; -use base 'QueryParser::query_plan'; -use OpenSRF::Utils::Logger qw($logger); -use Data::Dumper; - -sub toSQL { - my $self = shift; - - my %filters; - my ($format) = $self->find_filter('format'); - if ($format) { - my ($t,$f) = split('-', $format->args->[0]); - $self->new_filter( item_type => [ split '', $t ] ) if ($t); - $self->new_filter( item_form => [ split '', $f ] ) if ($f); - } - - for my $f ( qw/preferred_language preferred_language_multiplier preferred_language_weight core_limit check_limit skip_check superpage superpage_size/ ) { - my $col = $f; - $col = 'preferred_language_multiplier' if ($f eq 'preferred_language_weight'); - my ($filter) = $self->find_filter($f); - if ($filter and @{$filter->args}) { - $filters{$col} = $filter->args->[0]; - } - } - - $self->QueryParser->superpage($filters{superpage}) if ($filters{superpage}); - $self->QueryParser->superpage_size($filters{superpage_size}) if ($filters{superpage_size}); - $self->QueryParser->core_limit($filters{core_limit}) if ($filters{core_limit}); - - $logger->debug("Query plan:\n".Dumper($self)); - - my $flat_plan = $self->flatten; - - # generate the relevance ranking - my $rel = "AVG(\n\t\t(" . join(")+\n\t\t(", @{$$flat_plan{rank_list}}) . ")\n\t)"; - - # find any supplied sort option - my ($sort_filter) = $self->find_filter('sort'); - if ($sort_filter) { - $sort_filter = $sort_filter->args->[0]; - } else { - $sort_filter = 'rel'; - } - - if (($filters{preferred_language} || $self->QueryParser->default_preferred_language) && ($filters{preferred_language_multiplier} || $self->QueryParser->default_preferred_language_multiplier)) { - my $pl = $self->QueryParser->quote_value( $filters{preferred_language} ? $filters{preferred_language} : $self->QueryParser->default_preferred_language ); - my $plw = $filters{preferred_language_multiplier} ? $filters{preferred_language_multiplier} : $self->QueryParser->default_preferred_language_multiplier; - $rel = "($rel * COALESCE( NULLIF( FIRST(mrd.item_lang) = $pl , FALSE )::INT * $plw, 1))"; - } - $rel .= '::NUMERIC'; - - for my $f ( qw/audience vr_format item_type item_form lit_form language bib_level/ ) { - my $col = $f; - $col = 'item_lang' if ($f eq 'language'); - $filters{$f} = ''; - my ($filter) = $self->find_filter($f); - if ($filter) { - $filters{$f} = "AND mrd.$col in (" . join(",",map { $self->QueryParser->quote_value($_) } @{$filter->args}) . ")"; - } - } - - my $audience = $filters{audience}; - my $vr_format = $filters{vr_format}; - my $item_type = $filters{item_type}; - my $item_form = $filters{item_form}; - my $lit_form = $filters{lit_form}; - my $language = $filters{language}; - my $bib_level = $filters{bib_level}; - - my $rank = $rel; - - my $desc = 'ASC'; - $desc = 'DESC' if ($self->find_modifier('descending')); - - if ($sort_filter eq 'rel') { # relevance ranking flips sort dir - if ($desc eq 'ASC') { - $desc = 'DESC'; - } else { - $desc = 'ASC'; - } - } else { - if ($sort_filter eq 'title') { - $rank = "FIRST((SELECT frt.value FROM metabib.full_rec frt WHERE frt.record = m.source AND frt.tag = 'tnf' AND frt.subfield = 'a' LIMIT 1))"; - } elsif ($sort_filter eq 'pubdate') { - $rank = "FIRST(mrd.date1)::NUMERIC"; - } elsif ($sort_filter eq 'create_date') { - $rank = "FIRST((SELECT create_date FROM biblio.record_entry rbr WHERE rbr.id = m.source))"; - } elsif ($sort_filter eq 'edit_date') { - $rank = "FIRST((SELECT edit_date FROM biblio.record_entry rbr WHERE rbr.id = m.source))"; - } elsif ($sort_filter eq 'author') { - $rank = "FIRST((SELECT fra.value FROM metabib.full_rec fra WHERE fra.record = m.source AND fra.tag LIKE '1%' AND fra.subfield = 'a' ORDER BY fra.tag LIMIT 1))"; - } else { - # default to rel ranking - $rank = $rel; - } - } - - my $key = 'm.source'; - $key = 'm.metarecord' if (grep {$_->name eq 'metarecord' or $_->name eq 'metabib'} @{$self->modifiers}); - - my ($before) = $self->find_filter('before'); - my ($after) = $self->find_filter('after'); - my ($during) = $self->find_filter('during'); - my ($between) = $self->find_filter('between'); - - if ($before and @{$before->args} == 1) { - $before = "AND mrd.date1 <= " . $self->QueryParser->quote_value($before->args->[0]); - } else { - $before = ''; - } - - if ($after and @{$after->args} == 1) { - $after = "AND mrd.date1 >= " . $self->QueryParser->quote_value($after->args->[0]); - } else { - $after = ''; - } - - if ($during and @{$during->args} == 1) { - $during = "AND " . $self->QueryParser->quote_value($during->args->[0]) . " BETWEEN mrd.date1 AND mrd.date2"; - } else { - $during = ''; - } - - if ($between and @{$between->args} == 2) { - $between = "AND mrd.date1 BETWEEN " . $self->QueryParser->quote_value($between->args->[0]) . " AND " . $self->QueryParser->quote_value($between->args->[1]); - } else { - $between = ''; - } - - my $core_limit = $self->QueryParser->core_limit || 25000; - - my $sql = <QueryParser->debug; - return $sql; - -} - - -sub rel_bump { - my $self = shift; - my $node = shift; - my $bump = shift; - my $multiplier = shift; - - my $only_atoms = $node->only_atoms; - return '' if (!@$only_atoms); - - if ($bump eq 'first_word') { - return " /* first_word */ COALESCE(NULLIF( (naco_normalize(".$node->table_alias.".value) ~ ('^'||naco_normalize(".$self->QueryParser->quote_value($only_atoms->[0]->content)."))), FALSE )::INT * $multiplier, 1)"; - } elsif ($bump eq 'full_match') { - return " /* full_match */ COALESCE(NULLIF( (naco_normalize(".$node->table_alias.".value) ~ ('^'||". - join( "||' '||", map { "naco_normalize(".$self->QueryParser->quote_value($_->content).")" } @$only_atoms )."||'\$')), FALSE )::INT * $multiplier, 1)"; - } elsif ($bump eq 'word_order') { - return " /* word_order */ COALESCE(NULLIF( (naco_normalize(".$node->table_alias.".value) ~ (". - join( "||'.*'||", map { "naco_normalize(".$self->QueryParser->quote_value($_->content).")" } @$only_atoms ).")), FALSE )::INT * $multiplier, 1)"; - } - - return ''; -} - -sub flatten { - my $self = shift; - - my $from = shift || ''; - my $where = shift || '('; - - my @rank_list; - for my $node ( @{$self->query_nodes} ) { - if (ref($node)) { - if ($node->isa( 'QueryParser::query_plan::node' )) { - - unless (@{$node->only_atoms}) { - push @rank_list, '1'; - $where .= 'TRUE'; - next; - } - - my $table = $node->table; - my $talias = $node->table_alias; - - my $node_rank = $node->rank . " * ${talias}.weight"; - - my $core_limit = $self->QueryParser->core_limit || 25000; - $from .= "\n\tLEFT JOIN (\n\t\tSELECT fe.*, fe_weight.weight, x.tsq /* search */\n\t\t FROM $table AS fe"; - $from .= "\n\t\t\tJOIN config.metabib_field AS fe_weight ON (fe_weight.id = fe.field)"; - $from .= "\n\t\t\tJOIN (SELECT ".$node->tsquery ." AS tsq ) AS x ON (fe.index_vector @@ x.tsq)"; - - my @bump_fields; - if (@{$node->fields} > 0) { - @bump_fields = @{$node->fields}; - - my @field_ids; - push(@field_ids, $self->QueryParser->search_field_ids_by_class( $node->classname, $_ )->[0]) for (@bump_fields); - $from .= "\n\t\t\tWHERE fe_weight.id IN (". join(',', @field_ids) .")"; - - } else { - @bump_fields = @{$self->QueryParser->search_fields->{$node->classname}}; - } - - ###$from .= "\n\t\tLIMIT $core_limit"; - $from .= "\n\t) AS $talias ON (m.source = ${talias}.source)"; - - - my %used_bumps; - for my $field ( @bump_fields ) { - my $bumps = $self->QueryParser->find_relevance_bumps( $node->classname => $field ); - for my $b (keys %$bumps) { - next if (!$$bumps{$b}{active}); - next if ($used_bumps{$b}); - $used_bumps{$b} = 1; - - next if ($$bumps{$b}{multiplier} == 1); # optimization to remove unneeded bumps - - my $bump_case = $self->rel_bump( $node, $b, $$bumps{$b}{multiplier} ); - $node_rank .= "\n\t\t\t\t * " . $bump_case if ($bump_case); - } - } - - $where .= '(' . $talias . ".id IS NOT NULL"; - $where .= ' AND ' . join(' AND ', map {"${talias}.value ~* ".$self->QueryParser->quote_phrase_value($_)} @{$node->phrases}) if (@{$node->phrases}); - $where .= ')'; - - push @rank_list, $node_rank; - - } elsif ($node->isa( 'QueryParser::query_plan::facet' )) { - - my $table = $node->table; - my $talias = $node->table_alias; - - my @field_ids; - if (@{$node->fields} > 0) { - push(@field_ids, $self->QueryParser->facet_field_ids_by_class( $node->classname, $_ )->[0]) for (@{$node->fields}); - } else { - @field_ids = @{ $self->QueryParser->facet_field_ids_by_class( $node->classname ) }; - } - - $from .= "\n\tJOIN /* facet */ metabib.facet_entry $talias ON (\n\t\tm.source = ${talias}.source\n\t\t". - "AND SUBSTRING(${talias}.value,1,1024) IN (" . join(",", map { $self->QueryParser->quote_value($_) } @{$node->values}) . ")\n\t\t". - "AND ${talias}.field IN (". join(',', @field_ids) . ")\n\t)"; - - $where .= 'TRUE'; - - } else { - my $subnode = $node->flatten; - - push(@rank_list, @{$$subnode{rank_list}}); - $from .= $$subnode{from}; - $where .= "($$subnode{where})"; - } - } else { - $where .= ' AND ' if ($node eq '&'); - $where .= ' OR ' if ($node eq '|'); - # ... stitching the WHERE together ... - } - } - - return { rank_list => \@rank_list, from => $from, where => $where.')' }; - -} - - -#------------------------------- -package OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan::filter; -use base 'QueryParser::query_plan::filter'; - -#------------------------------- -package OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan::facet; -use base 'QueryParser::query_plan::facet'; - -sub classname { - my $self = shift; - my ($classname) = split '\|', $self->name; - return $classname; -} - -sub table { - my $self = shift; - return 'metabib.' . $self->classname . '_field_entry'; -} - -sub fields { - my $self = shift; - my ($classname,@fields) = split '\|', $self->name; - return \@fields; -} - -sub table_alias { - my $self = shift; - - my $table_alias = "$self"; - $table_alias =~ s/^.*\(0(x[0-9a-fA-F]+)\)$/$1/go; - $table_alias .= '_' . $self->name; - $table_alias =~ s/\|/_/go; - - return $table_alias; -} - - -#------------------------------- -package OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan::modifier; -use base 'QueryParser::query_plan::modifier'; - -#------------------------------- -package OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan::node::atom; -use base 'QueryParser::query_plan::node::atom'; - -sub sql { - my $self = shift; - my $sql = shift; - - $self->{sql} = $sql if ($sql); - - return $self->{sql} if ($self->{sql}); - return $self->buildSQL; -} - -sub buildSQL { - my $self = shift; - - my $classname = $self->node->classname; - - my $normalizers = $self->node->plan->QueryParser->query_normalizers( $classname ); - my $fields = $self->node->fields; - - $fields = $self->node->plan->QueryParser->search_fields->{$classname} if (!@$fields); - - my %norms; - my $pos = 0; - for my $field (@$fields) { - for my $nfield (keys %$normalizers) { - for my $nizer ( @{$$normalizers{$nfield}} ) { - if ($field eq $nfield) { - if (!exists($norms{$nizer->{function}})) { - $norms{$nizer->{function}} = {p=>$pos++,n=>$nizer}; - } - } - } - } - } - - my $sql = $self->node->plan->QueryParser->quote_value($self->content); - - for my $n ( map { $$_{n} } sort { $$a{p} <=> $$b{p} } values %norms ) { - $sql = join(', ', $sql, map { $self->node->plan->QueryParser->quote_value($_) } @{ $n->{params} }); - $sql = $n->{function}."($sql)"; - } - - my $prefix = $self->prefix || ''; - my $suffix = $self->suffix || ''; - - $prefix = "'$prefix' ||" if $prefix; - my $suffix_op = ":$suffix" if $suffix; - my $suffix_after = "|| '$suffix_op'" if $suffix; - - $sql = "to_tsquery('$classname', COALESCE(NULLIF($prefix '(' || btrim(regexp_replace($sql,E'(?:\\\\s+|:)','$suffix_op&','g'),'&|') $suffix_after || ')', '()'), ''))"; - - return $self->sql($sql); -} - -#------------------------------- -package OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan::node; -use base 'QueryParser::query_plan::node'; - -sub only_atoms { - my $self = shift; - - my $atoms = $self->query_atoms; - my @only_atoms; - for my $a (@$atoms) { - push(@only_atoms, $a) if (ref($a) && $a->isa('QueryParser::query_plan::node::atom')); - } - - return \@only_atoms; -} - -sub table { - my $self = shift; - my $table = shift; - $self->{table} = $table if ($table); - return $self->{table} if $self->{table}; - return $self->table( 'metabib.' . $self->classname . '_field_entry' ); -} - -sub table_alias { - my $self = shift; - my $table_alias = shift; - $self->{table_alias} = $table_alias if ($table_alias); - return $self->{table_alias} if ($self->{table_alias}); - - $table_alias = "$self"; - $table_alias =~ s/^.*\(0(x[0-9a-fA-F]+)\)$/$1/go; - $table_alias .= '_' . $self->requested_class; - $table_alias =~ s/\|/_/go; - - return $self->table_alias( $table_alias ); -} - -sub tsquery { - my $self = shift; - return $self->{tsquery} if ($self->{tsquery}); - - for my $atom (@{$self->query_atoms}) { - if (ref($atom)) { - $self->{tsquery} .= "\n\t\t\t" .$atom->sql; - } else { - $self->{tsquery} .= $atom x 2; - } - } - - return $self->{tsquery}; -} - -sub rank { - my $self = shift; - return $self->{rank} if ($self->{rank}); - return $self->{rank} = 'rank(' . $self->table_alias . '.index_vector, ' . $self->table_alias . '.tsq)'; -} - - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg/cdbi.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg/cdbi.pm deleted file mode 100644 index 20d88c5662..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg/cdbi.pm +++ /dev/null @@ -1,37 +0,0 @@ -{ # Based on the change to Class::DBI in OpenILS::Application::Storage. This will - # allow us to use TSearch2 via a simple cdbi "search" interface. - #------------------------------------------------------------------------------- - use UNIVERSAL::require; - BEGIN { - 'Class::DBI::Frozen::301'->use or 'Class::DBI'->use or die $@; - } - package Class::DBI; - - sub search_fts { - my $self = shift; - my @args = @_; - - if (ref($args[-1]) eq 'HASH' && @args > 1) { - $args[-1]->{_placeholder} = "to_tsquery('default',?)"; - } else { - push @args, {_placeholder => "to_tsquery('default',?)"}; - } - - $self->_do_search("@@" => @args); - } - - sub search_regex { - my $self = shift; - my @args = @_; - $self->_do_search("~*" => @args); - } - - sub search_ilike { - my $self = shift; - my @args = @_; - $self->_do_search("ILIKE" => @args); - } - -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg/dbi.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg/dbi.pm deleted file mode 100644 index 5ca6fd008b..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg/dbi.pm +++ /dev/null @@ -1,828 +0,0 @@ -{ - - #------------------------------------------------------------------------------- - package container::user_bucket; - - container::user_bucket->table( 'container.user_bucket' ); - container::user_bucket->sequence( 'container.user_bucket_id_seq' ); - - #------------------------------------------------------------------------------- - package container::user_bucket_item; - - container::user_bucket_item->table( 'container.user_bucket_item' ); - container::user_bucket_item->sequence( 'container.user_bucket_item_id_seq' ); - - #------------------------------------------------------------------------------- - package container::copy_bucket; - - container::copy_bucket->table( 'container.copy_bucket' ); - container::copy_bucket->sequence( 'container.copy_bucket_id_seq' ); - - #------------------------------------------------------------------------------- - package container::copy_bucket_item; - - container::copy_bucket_item->table( 'container.copy_bucket_item' ); - container::copy_bucket_item->sequence( 'container.copy_bucket_item_id_seq' ); - - #------------------------------------------------------------------------------- - package container::call_number_bucket; - - container::call_number_bucket->table( 'container.call_number_bucket' ); - container::call_number_bucket->sequence( 'container.call_number_bucket_id_seq' ); - - #------------------------------------------------------------------------------- - package container::call_number_bucket_item; - - container::call_number_bucket_item->table( 'container.call_number_bucket_item' ); - container::call_number_bucket_item->sequence( 'container.call_number_bucket_item_id_seq' ); - - #------------------------------------------------------------------------------- - package container::biblio_record_entry_bucket; - - container::biblio_record_entry_bucket->table( 'container.biblio_record_entry_bucket' ); - container::biblio_record_entry_bucket->sequence( 'container.biblio_record_entry_bucket_id_seq' ); - - #------------------------------------------------------------------------------- - package container::biblio_record_entry_bucket_item; - - container::biblio_record_entry_bucket_item->table( 'container.biblio_record_entry_bucket_item' ); - container::biblio_record_entry_bucket_item->sequence( 'container.biblio_record_entry_bucket_item_id_seq' ); - - #--------------------------------------------------------------------- - package money::grocery; - - money::grocery->table( 'money.grocery' ); - money::grocery->sequence( 'money.billable_xact_id_seq' ); - - #--------------------------------------------------------------------- - package money::collections_tracker; - - money::collections_tracker->table( 'money.collections_tracker' ); - money::collections_tracker->sequence( 'money.collections_tracker_id_seq' ); - - #--------------------------------------------------------------------- - package money::billable_transaction; - - money::billable_transaction->table( 'money.billable_xact' ); - money::billable_transaction->sequence( 'money.billable_xact_id_seq' ); - - #--------------------------------------------------------------------- - package money::billing; - - money::billing->table( 'money.billing' ); - money::billing->sequence( 'money.billing_id_seq' ); - - #--------------------------------------------------------------------- - package money::desk_payment; - - money::desk_payment->table( 'money.desk_payment_view' ); - - #--------------------------------------------------------------------- - package money::payment; - - money::payment->table( 'money.payment_view' ); - - #--------------------------------------------------------------------- - package money::cash_payment; - - money::cash_payment->table( 'money.cash_payment' ); - money::cash_payment->sequence( 'money.payment_id_seq' ); - - #--------------------------------------------------------------------- - package money::check_payment; - - money::check_payment->table( 'money.check_payment' ); - money::check_payment->sequence( 'money.payment_id_seq' ); - - #--------------------------------------------------------------------- - package money::credit_payment; - - money::credit_payment->table( 'money.credit_payment' ); - money::credit_payment->sequence( 'money.payment_id_seq' ); - - #--------------------------------------------------------------------- - package money::credit_card_payment; - - money::credit_card_payment->table( 'money.credit_card_payment' ); - money::credit_card_payment->sequence( 'money.payment_id_seq' ); - - #--------------------------------------------------------------------- - package money::work_payment; - - money::work_payment->table( 'money.work_payment' ); - money::work_payment->sequence( 'money.payment_id_seq' ); - - #--------------------------------------------------------------------- - package money::goods_payment; - - money::goods_payment->table( 'money.goods_payment' ); - money::goods_payment->sequence( 'money.payment_id_seq' ); - - #--------------------------------------------------------------------- - package money::forgive_payment; - - money::forgive_payment->table( 'money.forgive_payment' ); - money::forgive_payment->sequence( 'money.payment_id_seq' ); - - #--------------------------------------------------------------------- - package money::open_billable_transaction_summary; - - money::open_billable_transaction_summary->table( 'money.open_billable_xact_summary' ); - - #--------------------------------------------------------------------- - package money::billable_transaction_summary; - - money::billable_transaction_summary->table( 'money.billable_xact_summary' ); - - #--------------------------------------------------------------------- - package money::open_user_summary; - - money::open_user_summary->table( 'money.open_usr_summary' ); - - #--------------------------------------------------------------------- - package money::user_summary; - - money::user_summary->table( 'money.usr_summary' ); - - #--------------------------------------------------------------------- - package money::open_user_circulation_summary; - - money::open_user_circulation_summary->table( 'money.open_usr_circulation_summary' ); - - #--------------------------------------------------------------------- - package money::user_circulation_summary; - - money::user_circulation_summary->table( 'money.usr_circulation_summary' ); - - #--------------------------------------------------------------------- - package action::circulation; - - action::circulation->table( 'action.circulation' ); - action::circulation->sequence( 'money.billable_xact_id_seq' ); - - #--------------------------------------------------------------------- - package booking::resource_type; - - booking::resource_type->table( 'booking.resource_type' ); - booking::resource_type->sequence( 'booking.resource_type_id_seq' ); - - #--------------------------------------------------------------------- - package booking::resource; - - booking::resource->table( 'booking.resource' ); - booking::resource->sequence( 'booking.resource_id_seq' ); - - #--------------------------------------------------------------------- - package booking::reservation; - - booking::reservation->table( 'booking.reservation' ); - booking::reservation->sequence( 'money.billable_xact_id_seq' ); - - #--------------------------------------------------------------------- - package booking::reservation_attr_value_map; - - booking::reservation_attr_value_map->table( 'booking.reservation_attr_value_map' ); - booking::reservation_attr_value_map->sequence( 'booking.reservation_attr_value_map_id_seq' ); - - #--------------------------------------------------------------------- - package booking::resource_attr_map; - - booking::resource_attr_map->table( 'booking.resource_attr_map' ); - booking::resource_attr_map->sequence( 'booking.resource_attr_map_id_seq' ); - - #--------------------------------------------------------------------- - package action::non_cat_in_house_use; - - action::non_cat_in_house_use->table( 'action.non_cat_in_house_use' ); - action::non_cat_in_house_use->sequence( 'action.non_cat_in_house_use_id_seq' ); - - #--------------------------------------------------------------------- - package action::in_house_use; - - action::in_house_use->table( 'action.in_house_use' ); - action::in_house_use->sequence( 'action.in_house_use_id_seq' ); - - #--------------------------------------------------------------------- - package action::non_cataloged_circulation; - - action::non_cataloged_circulation->table( 'action.non_cataloged_circulation' ); - action::non_cataloged_circulation->sequence( 'action.non_cataloged_circulation_id_seq' ); - - #--------------------------------------------------------------------- - package action::open_circulation; - - action::open_circulation->table( 'action.open_circulation' ); - - #--------------------------------------------------------------------- - package action::survey; - - action::survey->table( 'action.survey' ); - action::survey->sequence( 'action.survey_id_seq' ); - - #--------------------------------------------------------------------- - package action::survey_question; - - action::survey_question->table( 'action.survey_question' ); - action::survey_question->sequence( 'action.survey_question_id_seq' ); - - #--------------------------------------------------------------------- - package action::survey_answer; - - action::survey_answer->table( 'action.survey_answer' ); - action::survey_answer->sequence( 'action.survey_answer_id_seq' ); - - #--------------------------------------------------------------------- - package action::survey_response; - - action::survey_response->table( 'action.survey_response' ); - action::survey_response->sequence( 'action.survey_response_id_seq' ); - - #--------------------------------------------------------------------- - package config::non_cataloged_type; - - config::non_cataloged_type->table( 'config.non_cataloged_type' ); - config::non_cataloged_type->sequence( 'config.non_cataloged_type_id_seq' ); - - #--------------------------------------------------------------------- - package config::copy_status; - - config::copy_status->table( 'config.copy_status' ); - config::copy_status->sequence( 'config.copy_status_id_seq' ); - - #--------------------------------------------------------------------- - package config::rules::circ_duration; - - config::rules::circ_duration->table( 'config.rule_circ_duration' ); - config::rules::circ_duration->sequence( 'config.rule_circ_duration_id_seq' ); - - #--------------------------------------------------------------------- - package config::rules::age_hold_protect; - - config::rules::age_hold_protect->table( 'config.rule_age_hold_protect' ); - config::rules::age_hold_protect->sequence( 'config.rule_age_hold_protect_id_seq' ); - - #--------------------------------------------------------------------- - package config::rules::max_fine; - - config::rules::max_fine->table( 'config.rule_max_fine' ); - config::rules::max_fine->sequence( 'config.rule_max_fine_id_seq' ); - - #--------------------------------------------------------------------- - package config::rules::recurring_fine; - - config::rules::recurring_fine->table( 'config.rule_recurring_fine' ); - config::rules::recurring_fine->sequence( 'config.rule_recurring_fine_id_seq' ); - - #--------------------------------------------------------------------- - package config::net_access_level; - - config::net_access_level->table( 'config.net_access_level' ); - config::net_access_level->sequence( 'config.net_access_level_id_seq' ); - - #--------------------------------------------------------------------- - package config::standing; - - config::standing->table( 'config.standing' ); - config::standing->sequence( 'config.standing_id_seq' ); - - #--------------------------------------------------------------------- - package config::metabib_field; - - config::metabib_field->table( 'config.metabib_field' ); - config::metabib_field->sequence( 'config.metabib_field_id_seq' ); - - #--------------------------------------------------------------------- - package config::bib_source; - - config::bib_source->table( 'config.bib_source' ); - config::bib_source->sequence( 'config.bib_source_id_seq' ); - - #--------------------------------------------------------------------- - package config::identification_type; - - config::identification_type->table( 'config.identification_type' ); - config::identification_type->sequence( 'config.identification_type_id_seq' ); - - #--------------------------------------------------------------------- - package asset::call_number_note; - - asset::call_number_note->table( 'asset.call_number_note' ); - asset::call_number_note->sequence( 'asset.call_number_note_id_seq' ); - - #--------------------------------------------------------------------- - package asset::copy_note; - - asset::copy_note->table( 'asset.copy_note' ); - asset::copy_note->sequence( 'asset.copy_note_id_seq' ); - - #--------------------------------------------------------------------- - package asset::call_number; - - asset::call_number->table( 'asset.call_number' ); - asset::call_number->sequence( 'asset.call_number_id_seq' ); - - #--------------------------------------------------------------------- - package asset::call_number_class; - - asset::call_number_class->table( 'asset.call_number_class' ); - asset::call_number_class->sequence( 'asset.call_number_class_id_seq' ); - - #--------------------------------------------------------------------- - package asset::copy_location_order; - - asset::copy_location_order->table( 'asset.copy_location_order' ); - asset::copy_location_order->sequence( 'asset.copy_location_order_id_seq' ); - - #--------------------------------------------------------------------- - package asset::copy_location; - - asset::copy_location->table( 'asset.copy_location' ); - asset::copy_location->sequence( 'asset.copy_location_id_seq' ); - - #--------------------------------------------------------------------- - package asset::copy; - - asset::copy->table( 'asset.copy' ); - asset::copy->sequence( 'asset.copy_id_seq' ); - - #--------------------------------------------------------------------- - package asset::stat_cat; - - asset::stat_cat->table( 'asset.stat_cat' ); - asset::stat_cat->sequence( 'asset.stat_cat_id_seq' ); - - #--------------------------------------------------------------------- - package asset::stat_cat_entry; - - asset::stat_cat_entry->table( 'asset.stat_cat_entry' ); - asset::stat_cat_entry->sequence( 'asset.stat_cat_entry_id_seq' ); - - #--------------------------------------------------------------------- - package asset::stat_cat_entry_copy_map; - - asset::stat_cat_entry_copy_map->table( 'asset.stat_cat_entry_copy_map' ); - asset::stat_cat_entry_copy_map->sequence( 'asset.stat_cat_entry_copy_map_id_seq' ); - - #--------------------------------------------------------------------- - package authority::record_entry; - - authority::record_entry->table( 'authority.record_entry' ); - authority::record_entry->sequence( 'authority.record_entry_id_seq' ); - - #--------------------------------------------------------------------- - package biblio::record_entry; - - biblio::record_entry->table( 'biblio.record_entry' ); - biblio::record_entry->sequence( 'biblio.record_entry_id_seq' ); - - #--------------------------------------------------------------------- - #package biblio::record_marc; - # - #biblio::record_marc->table( 'biblio.record_marc' ); - #biblio::record_marc->sequence( 'biblio.record_marc_id_seq' ); - # - #--------------------------------------------------------------------- - package authority::record_note; - - authority::record_note->table( 'authority.record_note' ); - authority::record_note->sequence( 'authority.record_note_id_seq' ); - - #--------------------------------------------------------------------- - package biblio::record_note; - - biblio::record_note->table( 'biblio.record_note' ); - biblio::record_note->sequence( 'biblio.record_note_id_seq' ); - - #--------------------------------------------------------------------- - package actor::workstation; - - actor::workstation->table( 'actor.workstation' ); - actor::workstation->sequence( 'actor.workstation_id_seq' ); - - #--------------------------------------------------------------------- - package actor::user; - - actor::user->table( 'actor.usr' ); - actor::user->sequence( 'actor.usr_id_seq' ); - - #--------------------------------------------------------------------- - package actor::org_unit::closed_date; - - actor::org_unit::closed_date->table( 'actor.org_unit_closed' ); - actor::org_unit::closed_date->sequence( 'actor.org_unit_closed_id_seq' ); - - #--------------------------------------------------------------------- - package actor::org_unit_setting; - - actor::org_unit_setting->table( 'actor.org_unit_setting' ); - actor::org_unit_setting->sequence( 'actor.org_unit_setting_id_seq' ); - - #--------------------------------------------------------------------- - package actor::user_standing_penalty; - - actor::user_standing_penalty->table( 'actor.usr_standing_penalty' ); - actor::user_standing_penalty->sequence( 'actor.usr_standing_penalty_id_seq' ); - - #--------------------------------------------------------------------- - package actor::user_setting; - - actor::user_setting->table( 'actor.usr_setting' ); - actor::user_setting->sequence( 'actor.usr_setting_id_seq' ); - - #--------------------------------------------------------------------- - package actor::user_address; - - actor::user_address->table( 'actor.usr_address' ); - actor::user_address->sequence( 'actor.usr_address_id_seq' ); - - #--------------------------------------------------------------------- - package actor::org_address; - - actor::org_address->table( 'actor.org_address' ); - actor::org_address->sequence( 'actor.org_address_id_seq' ); - - #--------------------------------------------------------------------- - package actor::usr_org_unit_opt_in; - - actor::usr_org_unit_opt_in->table( 'actor.usr_org_unit_opt_in' ); - actor::usr_org_unit_opt_in->sequence( 'actor.usr_org_unit_opt_in_id_seq' ); - - #--------------------------------------------------------------------- - package actor::org_unit_proximity; - - actor::org_unit_proximity->table( 'actor.org_unit_proximity' ); - actor::org_unit_proximity->sequence( 'actor.org_unit_proximity_id_seq' ); - - #--------------------------------------------------------------------- - package actor::org_unit_type; - - actor::org_unit_type->table( 'actor.org_unit_type' ); - actor::org_unit_type->sequence( 'actor.org_unit_type_id_seq' ); - - #--------------------------------------------------------------------- - package actor::org_unit::hours_of_operation; - - actor::org_unit::hours_of_operation->table( 'actor.hours_of_operation' ); - - #--------------------------------------------------------------------- - package actor::org_unit; - - actor::org_unit->table( 'actor.org_unit' ); - actor::org_unit->sequence( 'actor.org_unit_id_seq' ); - - #--------------------------------------------------------------------- - package actor::stat_cat; - - actor::stat_cat->table( 'actor.stat_cat' ); - actor::stat_cat->sequence( 'actor.stat_cat_id_seq' ); - - #--------------------------------------------------------------------- - package actor::stat_cat_entry; - - actor::stat_cat_entry->table( 'actor.stat_cat_entry' ); - actor::stat_cat_entry->sequence( 'actor.stat_cat_entry_id_seq' ); - - #--------------------------------------------------------------------- - package actor::stat_cat_entry_user_map; - - actor::stat_cat_entry_user_map->table( 'actor.stat_cat_entry_usr_map' ); - actor::stat_cat_entry_user_map->sequence( 'actor.stat_cat_entry_usr_map_id_seq' ); - - #--------------------------------------------------------------------- - package actor::card; - - actor::card->table( 'actor.card' ); - actor::card->sequence( 'actor.card_id_seq' ); - - #--------------------------------------------------------------------- - package actor::usr_note; - - actor::usr_note->table( 'actor.usr_note' ); - actor::usr_note->sequence( 'actor.usr_note_id_seq' ); - - #--------------------------------------------------------------------- - - #------------------------------------------------------------------------------- - package metabib::metarecord; - - metabib::metarecord->table( 'metabib.metarecord' ); - metabib::metarecord->sequence( 'metabib.metarecord_id_seq' ); - - - #------------------------------------------------------------------------------- - - #------------------------------------------------------------------------------- - package metabib::identifier_field_entry; - - metabib::identifier_field_entry->table( 'metabib.identifier_field_entry' ); - metabib::identifier_field_entry->sequence( 'metabib.identifier_field_entry_id_seq' ); - metabib::identifier_field_entry->columns( 'FTS' => 'index_vector' ); - - #------------------------------------------------------------------------------- - - #------------------------------------------------------------------------------- - package metabib::title_field_entry; - - metabib::title_field_entry->table( 'metabib.title_field_entry' ); - metabib::title_field_entry->sequence( 'metabib.title_field_entry_id_seq' ); - metabib::title_field_entry->columns( 'FTS' => 'index_vector' ); - -# metabib::title_field_entry->add_trigger( -# before_create => \&OpenILS::Application::Storage::Driver::Pg::tsearch2_trigger -# ); -# metabib::title_field_entry->add_trigger( -# before_update => \&OpenILS::Application::Storage::Driver::Pg::tsearch2_trigger -# ); - - #------------------------------------------------------------------------------- - - #------------------------------------------------------------------------------- - package metabib::author_field_entry; - - metabib::author_field_entry->table( 'metabib.author_field_entry' ); - metabib::author_field_entry->sequence( 'metabib.author_field_entry_id_seq' ); - metabib::author_field_entry->columns( 'FTS' => 'index_vector' ); - - #------------------------------------------------------------------------------- - - #------------------------------------------------------------------------------- - package metabib::subject_field_entry; - - metabib::subject_field_entry->table( 'metabib.subject_field_entry' ); - metabib::subject_field_entry->sequence( 'metabib.subject_field_entry_id_seq' ); - metabib::subject_field_entry->columns( 'FTS' => 'index_vector' ); - - #------------------------------------------------------------------------------- - - #------------------------------------------------------------------------------- - package metabib::keyword_field_entry; - - metabib::keyword_field_entry->table( 'metabib.keyword_field_entry' ); - metabib::keyword_field_entry->sequence( 'metabib.keyword_field_entry_id_seq' ); - metabib::keyword_field_entry->columns( 'FTS' => 'index_vector' ); - - #------------------------------------------------------------------------------- - package metabib::series_field_entry; - - metabib::series_field_entry->table( 'metabib.series_field_entry' ); - metabib::series_field_entry->sequence( 'metabib.series_field_entry_id_seq' ); - metabib::series_field_entry->columns( 'FTS' => 'index_vector' ); - - #------------------------------------------------------------------------------- - - #------------------------------------------------------------------------------- - #package metabib::title_field_entry_source_map; - - #metabib::title_field_entry_source_map->table( 'metabib.title_field_entry_source_map' ); - - #------------------------------------------------------------------------------- - - #------------------------------------------------------------------------------- - #package metabib::author_field_entry_source_map; - - #metabib::author_field_entry_source_map->table( 'metabib.author_field_entry_source_map' ); - - #------------------------------------------------------------------------------- - - #------------------------------------------------------------------------------- - #package metabib::subject_field_entry_source_map; - - #metabib::subject_field_entry_source_map->table( 'metabib.subject_field_entry_source_map' ); - - #------------------------------------------------------------------------------- - - #------------------------------------------------------------------------------- - #package metabib::keyword_field_entry_source_map; - - #metabib::keyword_field_entry_source_map->table( 'metabib.keyword_field_entry_source_map' ); - - #------------------------------------------------------------------------------- - - #------------------------------------------------------------------------------- - package metabib::metarecord_source_map; - - metabib::metarecord_source_map->table( 'metabib.metarecord_source_map' ); - metabib::metarecord_source_map->sequence( 'metabib.metarecord_source_map_id_seq' ); - - #------------------------------------------------------------------------------- - package authority::record_descriptor; - - authority::record_descriptor->table( 'authority.rec_descriptor' ); - authority::record_descriptor->sequence( 'authority.rec_descriptor_id_seq' ); - - #------------------------------------------------------------------------------- - package metabib::record_descriptor; - - metabib::record_descriptor->table( 'metabib.rec_descriptor' ); - metabib::record_descriptor->sequence( 'metabib.rec_descriptor_id_seq' ); - - #------------------------------------------------------------------------------- - - - #------------------------------------------------------------------------------- - package authority::full_rec; - - authority::full_rec->table( 'authority.full_rec' ); - authority::full_rec->sequence( 'authority.full_rec_id_seq' ); - authority::full_rec->columns( 'FTS' => 'index_vector' ); - - #------------------------------------------------------------------------------- - package metabib::full_rec; - - metabib::full_rec->table( 'metabib.full_rec' ); - metabib::full_rec->sequence( 'metabib.full_rec_id_seq' ); - metabib::full_rec->columns( 'FTS' => 'index_vector' ); - - #------------------------------------------------------------------------------- - - package permission::perm_list; - - permission::perm_list->sequence( 'permission.perm_list_id_seq' ); - permission::perm_list->table('permission.perm_list'); - - #------------------------------------------------------------------------------- - - package permission::grp_tree; - - permission::grp_tree->sequence( 'permission.grp_tree_id_seq' ); - permission::grp_tree->table('permission.grp_tree'); - - #------------------------------------------------------------------------------- - - package permission::usr_grp_map; - - permission::usr_grp_map->sequence( 'permission.usr_grp_map_id_seq' ); - permission::usr_grp_map->table('permission.usr_grp_map'); - - #------------------------------------------------------------------------------- - - package permission::usr_work_ou_map; - permission::usr_work_ou_map->sequence('permission.usr_work_ou_map_id_seq'); - permission::usr_work_ou_map->table('permission.usr_work_ou_map'); - - #------------------------------------------------------------------------------- - - package permission::usr_perm_map; - - permission::usr_perm_map->sequence( 'permission.usr_perm_map_id_seq' ); - permission::usr_perm_map->table('permission.usr_perm_map'); - - #------------------------------------------------------------------------------- - - package permission::grp_perm_map; - - permission::grp_perm_map->sequence( 'permission.grp_perm_map_id_seq' ); - permission::grp_perm_map->table('permission.grp_perm_map'); - - #------------------------------------------------------------------------------- - - package action::hold_request; - - action::hold_request->sequence( 'action.hold_request_id_seq' ); - action::hold_request->table('action.hold_request'); - - #------------------------------------------------------------------------------- - - package action::hold_notification; - - action::hold_notification->sequence( 'action.hold_notification_id_seq' ); - action::hold_notification->table('action.hold_notification'); - - #------------------------------------------------------------------------------- - - package action::hold_copy_map; - - action::hold_copy_map->sequence( 'action.hold_copy_map_id_seq' ); - action::hold_copy_map->table('action.hold_copy_map'); - - #------------------------------------------------------------------------------- - - package action::hold_transit_copy; - - action::hold_transit_copy->sequence( 'action.transit_copy_id_seq' ); - action::hold_transit_copy->table('action.hold_transit_copy'); - - #------------------------------------------------------------------------------- - - package action::reservation_transit_copy; - - action::reservation_transit_copy->sequence( 'action.transit_copy_id_seq' ); - action::reservation_transit_copy->table('action.reservation_transit_copy'); - - #------------------------------------------------------------------------------- - - package action::transit_copy; - - action::transit_copy->sequence( 'action.transit_copy_id_seq' ); - action::transit_copy->table('action.transit_copy'); - - #------------------------------------------------------------------------------- - - package action::unfulfilled_hold_list; - - action::unfulfilled_hold_list->sequence( 'action.unfulfilled_hold_list_id_seq' ); - action::unfulfilled_hold_list->table('action.unfulfilled_hold_list'); - - #------------------------------------------------------------------------------- - - package serial::subscription; - - serial::subscription->sequence( 'serial.subscription_id_seq' ); - serial::subscription->table('serial.subscription'); - - #------------------------------------------------------------------------------- - - package serial::issuance; - - serial::issuance->sequence( 'serial.issuance_id_seq' ); - serial::issuance->table('serial.issuance'); - - #------------------------------------------------------------------------------- - - package serial::item; - - serial::item->sequence( 'serial.item_id_seq' ); - serial::item->table('serial.item'); - - #------------------------------------------------------------------------------- - - package serial::unit; - - serial::unit->sequence( 'asset.copy_id_seq' ); - serial::unit->table('serial.unit'); - - #------------------------------------------------------------------------------- - - package config::language_map; - config::language_map->table('config.language_map'); - - #------------------------------------------------------------------------------- - - package config::i18n_locale; - config::i18n_locale->table('config.i18n_locale'); - - #------------------------------------------------------------------------------- - - package config::i18n_core; - config::i18n_core->sequence( 'config.i18n_core_id_seq' ); - config::i18n_core->table('config.i18n_core'); - - #------------------------------------------------------------------------------- - - package config::item_form_map; - config::item_form_map->table('config.item_form_map'); - - #------------------------------------------------------------------------------- - - package config::lit_form_map; - config::lit_form_map->table('config.lit_form_map'); - - #------------------------------------------------------------------------------- - - package config::item_type_map; - config::item_type_map->table('config.item_type_map'); - - #------------------------------------------------------------------------------- - package config::audience_map; - config::audience_map->table('config.audience_map'); - - #------------------------------------------------------------------------------- - - -} - -for my $class ( qw/ - biblio::record_entry - metabib::metarecord - metabib::title_field_entry - metabib::author_field_entry - metabib::subject_field_entry - metabib::keyword_field_entry - metabib::series_field_entry - metabib::metarecord_source_map - metabib::record_descriptor - metabib::full_rec - authority::record_descriptor - authority::full_rec - / ) { - - (my $method_class = $class) =~ s/::/./go; - - for my $type ( qw/create create_start create_push create_finish/ ) { - my ($name,$part) = split('_', $type); - - my $apiname = "open-ils.storage.direct.$method_class.batch.$name"; - $apiname .= ".$part" if ($part); - - OpenILS::Application::Storage->register_method( - api_name => $apiname, - method => "copy_$type", - api_level => 1, - 'package' => 'OpenILS::Application::Storage', - cdbi => $class, - ); - } -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg/fts.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg/fts.pm deleted file mode 100644 index 055266a8fe..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg/fts.pm +++ /dev/null @@ -1,89 +0,0 @@ -{ # Every driver needs to provide a 'compile()' method to OpenILS::Application::Storage::FTS. - # If that driver wants to support FTI, that is... - #------------------------------------------------------------------------------- - package OpenILS::Application::Storage::FTS; - use OpenSRF::Utils::Logger qw/:level/; - use Unicode::Normalize; - my $log = 'OpenSRF::Utils::Logger'; - - sub compile { - my $self = shift; - my $class = shift; - my $term = NFD(shift()); - - $log->debug("Raw term: $term",DEBUG); - $log->debug("Search class: $class",DEBUG); - - $term =~ s/\&//go; - $term =~ s/\|//go; - - $self = ref($self) || $self; - $self = bless {} => $self; - $self->{class} = $class; - - $term =~ s/(\pM+)//gos; - $term =~ s/(\b\.\b)//gos; - - # hack to normalize ratio-like strings - while ($term =~ /\b\d{1}:[, ]?\d+(?:[ ,]\d+[^:])+/o) { - $term = $` . join ('', split(/[, ]/, $&)) . $'; - } - - $self->decompose($term); - - my $newterm = ''; - $newterm = join('&', $self->words) if ($self->words); - - if (@{$self->nots}) { - $newterm = '('.$newterm.')&' if ($newterm); - $newterm .= '!('. join('|', $self->nots) . ')'; - } - - $log->debug("Compiled term is [$newterm]", DEBUG); - $newterm = OpenILS::Application::Storage::Driver::Pg->quote($newterm); - $log->debug("Quoted term is [$newterm]", DEBUG); - - $self->{fts_query} = ["to_tsquery('$$self{class}',$newterm)"]; - $self->{fts_query_nots} = []; - $self->{fts_op} = '@@'; - $self->{text_col} = shift; - $self->{fts_col} = shift; - - return $self; - } - - sub sql_where_clause { - my $self = shift; - my $column = $self->fts_col; - my @output; - - my @ranks; - for my $fts ( $self->fts_query ) { - push @output, join(' ', $self->fts_col, $self->{fts_op}, $fts); - push @ranks, "rank($column, $fts)"; - } - $self->{fts_rank} = \@ranks; - - my $phrase_match = $self->sql_exact_phrase_match(); - return join(' AND ', @output) . $phrase_match; - } - - sub sql_exact_phrase_match { - my $self = shift; - my $column = $self->text_col; - my $output = ''; - for my $phrase ( $self->phrases ) { - $phrase =~ s/\*/\\*/go; - $phrase =~ s/\./\\./go; - $phrase =~ s/'/\\'/go; - $phrase =~ s/\s+/\\s+/go; - $log->debug("Adding phrase [$phrase] to the match list", DEBUG); - $output .= " AND $column ~* \$\$(^|\\W+)$phrase(\\W+|\$)\$\$"; - } - $log->debug("Phrase list is [$output]", DEBUG); - return $output; - } - -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg/storage.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg/storage.pm deleted file mode 100644 index d7623d0d18..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Driver/Pg/storage.pm +++ /dev/null @@ -1,315 +0,0 @@ - -{ - package OpenILS::Application::Storage; - use OpenSRF::Utils::Logger; - - our $NOPRIMARY = 0; - my $log = 'OpenSRF::Utils::Logger'; - my $pg = 'OpenILS::Application::Storage::Driver::Pg'; - - sub child_exit { - $_->disconnect for $pg->db_Handles; - } - - sub current_xact { - my $self = shift; - my $client = shift; - return $pg->current_xact_id; - } - __PACKAGE__->register_method( - method => 'current_xact', - api_name => 'open-ils.storage.transaction.current', - api_level => 1, - argc => 0, - ); - - - sub pg_begin_xaction { - my $self = shift; - my $client = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - if (my $old_xact = $pg->current_xact_session) { - if ($pg->current_xact_is_auto) { - $log->debug("Commiting old autocommit transaction with Open-ILS XACT-ID [$old_xact]", INFO); - $self->method_lookup("open-ils.storage.transaction.commit")->run(); - } else { - $log->debug("Rolling back old NON-autocommit transaction with Open-ILS XACT-ID [$old_xact]", INFO); - $self->method_lookup("open-ils.storage.transaction.rollback")->run(); - throw OpenSRF::DomainObject::oilsException->new( - statusCode => 500, - status => "Previous transaction rolled back!", - ); - } - } - - $pg->set_xact_session( $client->session ); - my $xact_id = $pg->current_xact_id; - - $log->debug("Beginning a new transaction with Open-ILS XACT-ID [$xact_id]", INFO); - - my $dbh = OpenILS::Application::Storage::CDBI->db_Main; - - try { - $dbh->begin_work; - - } catch Error with { - my $e = shift; - $log->debug("Failed to begin a new transaction with Open-ILS XACT-ID [$xact_id]: ".$e, INFO); - throw $e; - }; - - - my $death_cb = $client->session->register_callback( - death => sub { - __PACKAGE__->pg_rollback_xaction; - } - ); - - $log->debug("Registered 'death' callback [$death_cb] for new transaction with Open-ILS XACT-ID [$xact_id]", DEBUG); - - $client->session->session_data( death_cb => $death_cb ); - - if ($self->api_name =~ /autocommit$/o) { - $pg->current_xact_is_auto(1); - my $dc_cb = $client->session->register_callback( - disconnect => sub { - my $ses = shift; - $ses->unregister_callback(death => $death_cb); - __PACKAGE__->pg_commit_xaction; - } - ); - $log->debug("Registered 'disconnect' callback [$dc_cb] for new transaction with Open-ILS XACT-ID [$xact_id]", DEBUG); - if ($client and $client->session) { - $client->session->session_data( disconnect_cb => $dc_cb ); - } - } - - return 1; - - } - __PACKAGE__->register_method( - method => 'pg_begin_xaction', - api_name => 'open-ils.storage.transaction.begin', - api_level => 1, - argc => 0, - ); - __PACKAGE__->register_method( - method => 'pg_begin_xaction', - api_name => 'open-ils.storage.transaction.begin.autocommit', - api_level => 1, - argc => 0, - ); - - sub pg_commit_xaction { - my $self = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - my $xact_id = $pg->current_xact_id; - - my $success = 1; - try { - $log->debug("Committing transaction with Open-ILS XACT-ID [$xact_id]", INFO) if ($xact_id); - my $dbh = OpenILS::Application::Storage::CDBI->db_Main; - $dbh->commit; - - } catch Error with { - my $e = shift; - $log->debug("Failed to commit transaction with Open-ILS XACT-ID [$xact_id]: ".$e, INFO); - $success = 0; - }; - - $pg->current_xact_session->unregister_callback( death => - $pg->current_xact_session->session_data( 'death_cb' ) - ) if ($pg->current_xact_session); - - if ($pg->current_xact_is_auto) { - $pg->current_xact_session->unregister_callback( disconnect => - $pg->current_xact_session->session_data( 'disconnect_cb' ) - ); - } - - $pg->unset_xact_session; - - return $success; - - } - __PACKAGE__->register_method( - method => 'pg_commit_xaction', - api_name => 'open-ils.storage.transaction.commit', - api_level => 1, - argc => 0, - ); - - sub pg_rollback_xaction { - my $self = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - my $xact_id = $pg->current_xact_id; - - my $success = 1; - try { - my $dbh = OpenILS::Application::Storage::CDBI->db_Main; - $log->debug("Rolling back a transaction with Open-ILS XACT-ID [$xact_id]", INFO); - $dbh->rollback; - - } catch Error with { - my $e = shift; - $log->debug("Failed to roll back transaction with Open-ILS XACT-ID [$xact_id]: ".$e, INFO); - $success = 0; - }; - - $pg->current_xact_session->unregister_callback( death => - $pg->current_xact_session->session_data( 'death_cb' ) - ) if ($pg->current_xact_session); - - if ($pg->current_xact_is_auto) { - $pg->current_xact_session->unregister_callback( disconnect => - $pg->current_xact_session->session_data( 'disconnect_cb' ) - ); - } - - $pg->unset_xact_session; - - return $success; - } - __PACKAGE__->register_method( - method => 'pg_rollback_xaction', - api_name => 'open-ils.storage.transaction.rollback', - api_level => 1, - argc => 0, - ); - - sub set_savepoint { - my $self = shift; - my $client = shift; - my $sp = shift || 'osrf_savepoint'; - return OpenILS::Application::Storage::CDBI->db_Main->pg_savepoint($sp); - } - __PACKAGE__->register_method( - method => 'set_savepoint', - api_name => 'open-ils.storage.savepoint.set', - api_level => 1, - argc => 1, - ); - - sub release_savepoint { - my $self = shift; - my $client = shift; - my $sp = shift || 'osrf_savepoint'; - return OpenILS::Application::Storage::CDBI->db_Main->pg_release($sp); - } - __PACKAGE__->register_method( - method => 'release_savepoint', - api_name => 'open-ils.storage.savepoint.release', - api_level => 1, - argc => 1, - ); - - sub rollback_to_savepoint { - my $self = shift; - my $client = shift; - my $sp = shift || 'osrf_savepoint'; - return OpenILS::Application::Storage::CDBI->db_Main->pg_rollback_to($sp); - } - __PACKAGE__->register_method( - method => 'rollback_to_savepoint', - api_name => 'open-ils.storage.savepoint.rollback', - api_level => 1, - argc => 1, - ); - - - sub copy_create_start { - my $self = shift; - my $client = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - #return undef unless ($pg->current_xact_session); - - my @cols = $self->{cdbi}->columns('Essential'); - if ($NOPRIMARY) { - my ($p) = $self->{cdbi}->columns('Primary'); - @cols = grep { $_ ne $p } @cols; - } - - my $col_list = join ',', @cols; - - $log->debug('Starting COPY import for '.$self->{cdbi}->table." ($col_list)", DEBUG); - $self->{cdbi}->sql_copy_start($self->{cdbi}->table, $col_list)->execute; - - return 1; - } - - sub copy_create_push { - my $self = shift; - my $client = shift; - my @fm_nodes = @_; - - local $OpenILS::Application::Storage::WRITE = 1; - - #return undef unless ($pg->current_xact_session); - - my @cols = $self->{cdbi}->columns('Essential'); - if ($NOPRIMARY) { - my ($p) = $self->{cdbi}->columns('Primary'); - @cols = grep { $_ ne $p } @cols; - } - - my $dbh = $self->{cdbi}->db_Main; - for my $node ( @fm_nodes ) { - next unless ($node); - my $line = join("\t", map { defined($node->$_()) ? $node->$_() : '\N' } @cols); - $log->debug("COPY line: [$line]",DEBUG); - $dbh->pg_putline($line."\n"); - } - - return scalar(@fm_nodes); - } - - sub copy_create_finish { - my $self = shift; - my $client = shift; - my @fm_nodes = @_; - - local $OpenILS::Application::Storage::WRITE = 1; - - #return undef unless ($pg->current_xact_session); - - my $dbh = $self->{cdbi}->db_Main; - - $dbh->pg_endcopy || $log->debug("Could not end COPY with pg_endcopy", WARN); - - $log->debug('COPY import for '.$self->{cdbi}->table." ($col_list) complete", DEBUG); - - return 1; - } - - sub copy_create { - my $self = shift; - my $client = shift; - my @fm_nodes = @_; - - local $NOPRIMARY = 1; - - copy_create_start( $self => $client ); - copy_create_push( $self => $client => @fm_nodes ); - copy_create_finish( $self => $client ); - - return scalar(@fm_nodes); - } - - sub autoprimary { - my $class = shift; - my $val = shift; - $NOPRIMARY = $val if (defined $val); - return $NOPRIMARY; - } - -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/FTS.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/FTS.pm deleted file mode 100644 index 05c4decc8c..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/FTS.pm +++ /dev/null @@ -1,252 +0,0 @@ -use OpenSRF::Utils::Logger qw/:level/; -my $log = 'OpenSRF::Utils::Logger'; - -#------------------------------------------------------------------------------- -package OpenILS::Application::Storage::FTS; -use OpenSRF::Utils::Logger qw/:level/; -use Parse::RecDescent; -use OpenILS::Utils::Normalize qw( naco_normalize ); - -my $_default_grammar_parser = new Parse::RecDescent ( <<'GRAMMAR' ); - - - -search_expression: or_expr(s) | and_expr(s) | expr(s) -or_expr: lexpr '||' rexpr -and_expr: lexpr '&&' rexpr -lexpr: expr -rexpr: expr -expr: phrase(s) | group(s) | word(s) -joiner: '||' | '&&' -phrase: '"' token(s) '"' -group : '(' search_expression ')' -word: numeric_range | negative_token | token -negative_token: '-' .../\D+/ token -token: /[-\w]+/ -numeric_range: /\d+-\d*/ - -GRAMMAR - -sub compile { - - $log->debug("You must override me somewhere, or I will make searching really slow!!!!",ERROR);; - - my $self = shift; - my $class = shift; - my $term = shift; - - $self = ref($self) || $self; - $self = bless {} => $self; - - $self->decompose($term); - - for my $part ( $self->words, $self->phrases ) { - $part = OpenILS::Application::Storage::CDBI->quote($part); - push @{ $self->{ fts_query } }, "'\%$part\%'"; - } - - for my $part ( $self->nots ) { - $part = OpenILS::Application::Storage::CDBI->quote($part); - push @{ $self->{ fts_query_not } }, "'\%$part\%'"; - } -} - -sub decompose { - my $self = shift; - my $term = shift; - my $parser = shift || $_default_grammar_parser; - - $term =~ s/:/ /go; - $term =~ s/\s+--\s+/ /go; - $term =~ s/(?:&[^;]+;)//go; - $term =~ s/\s+/ /go; - $term =~ s/(^|\s+)-(\w+)/$1!$2/go; - $term =~ s/\b(\+)(\w+)/$2/go; - $term =~ s/^\s*\b(.+)\b\s*$/$1/o; - $term =~ s/(\d{4})-(\d{4})/$1 $2/go; - #$term =~ s/^(?:an?|the)\b(.*)/$1/o; - - $log->debug("Stripped search term string is [$term]",DEBUG); - - my $parsetree = $parser->search_expression( $term ); - my @words = $term =~ /\b((?debug("Stripped words are[".join(', ',@words)."]",DEBUG); - $log->debug("Stripped nots are[".join(', ',@nots)."]",DEBUG); - - my @parts; - while ($term =~ s/ ((?{ fts_op } = 'ILIKE'; - $self->{ fts_col } = $self->{ text_col } = 'value'; - $self->{ raw } = $term; - $self->{ parsetree } = $parsetree; - $self->{ words } = \@words; - $self->{ nots } = \@nots; - $self->{ phrases } = \@parts; - - return $self; -} - -sub fts_query_not { - my $self = shift; - return wantarray ? @{ $self->{fts_query_not} } : $self->{fts_query_not}; -} - -sub fts_rank { - my $self = shift; - return wantarray ? @{ $self->{fts_rank} } : $self->{fts_rank}; -} - -sub fts_query { - my $self = shift; - return wantarray ? @{ $self->{fts_query} } : $self->{fts_query}; -} - -sub raw { - my $self = shift; - return $self->{raw}; -} - -sub parse_tree { - my $self = shift; - return $self->{parsetree}; -} - -sub fts_col { - my $self = shift; - return $self->{fts_col}; -} - -sub text_col { - my $self = shift; - return $self->{text_col}; -} - -sub phrases { - my $self = shift; - return wantarray ? @{ $self->{phrases} } : $self->{phrases}; -} - -sub words { - my $self = shift; - return wantarray ? @{ $self->{words} } : $self->{words}; -} - -sub nots { - my $self = shift; - return wantarray ? @{ $self->{nots} } : $self->{nots}; -} - -sub sql_exact_phrase_match { - my $self = shift; - my $column = $self->text_col; - my $output = ''; - for my $phrase ( $self->phrases ) { - $phrase =~ s/%/\\%/go; - $phrase =~ s/_/\\_/go; - $phrase =~ s/'/\\'/go; - $log->debug("Adding phrase [$phrase] to the match list", DEBUG); - $output .= " AND $column ILIKE '\%$phrase\%'"; - } - $log->debug("Phrase list is [$output]", DEBUG); - return $output; -} - -sub sql_exact_word_bump { - my $self = shift; - my $bump = shift || '0.1'; - - my $column = $self->text_col; - my $output = ''; - for my $word ( $self->words ) { - $word =~ s/%/\\%/go; - $word =~ s/_/\\_/go; - $word =~ s/'/''/go; - $log->debug("Adding word [$word] to the relevancy bump list", DEBUG); - $output .= " + CASE WHEN $column ILIKE '\%$word\%' THEN $bump ELSE 0 END"; - } - $log->debug("Word bump list is [$output]", DEBUG); - return $output; -} - -sub sql_where_clause { - my $self = shift; - my @output; - - for my $fts ( $self->fts_query ) { - push @output, join(' ', $self->fts_col, $self->{fts_op}, $fts); - } - - for my $fts ( $self->fts_query_not ) { - push @output, 'NOT (' . join(' ', $self->fts_col, $self->{fts_op}, $fts) . ')'; - } - - my $phrase_match = $self->sql_exact_phrase_match(); - return join(' AND ', @output); -} - -#------------------------------------------------------------------------------- -use UNIVERSAL::require; -BEGIN { - 'Class::DBI::Frozen::301'->use or 'Class::DBI'->use or die $@; -} - -package Class::DBI; - -{ - no warnings; - no strict; - sub _do_search { - my ($proto, $search_type, @args) = @_; - my $class = ref $proto || $proto; - - my (@cols, @vals); - my $search_opts = (@args > 1 and ref($args[-1]) eq 'HASH') ? pop @args : {}; - - @args = %{ $args[0] } if ref $args[0] eq "HASH"; - - $search_opts->{offset} = int($search_opts->{page} - 1) * int($search_opts->{page_size}) if ($search_opts->{page_size}); - $search_opts->{_placeholder} ||= '?'; - - my @frags; - while (my ($col, $val) = splice @args, 0, 2) { - my $column = $class->find_column($col) - || (List::Util::first { $_->accessor eq $col } $class->columns) - || $class->_croak("$col is not a column of $class"); - - if (!defined($val)) { - push @frags, "$col IS NULL"; - } elsif (ref($val) and ref($val) eq 'ARRAY') { - push @frags, "$col IN (".join(',',map{'?'}@$val).")"; - for my $v (@$val) { - push @vals, ''.$class->_deflated_column($column, $v); - } - } else { - push @frags, "$col $search_type $$search_opts{_placeholder}"; - push @vals, $class->_deflated_column($column, $val); - } - } - - my $frag = join " AND ", @frags; - - $frag .= " ORDER BY $search_opts->{order_by}" - if $search_opts->{order_by}; - $frag .= " LIMIT $search_opts->{limit}" - if $search_opts->{limit}; - $frag .= " OFFSET $search_opts->{offset}" - if ($search_opts->{limit} && defined($search_opts->{offset})); - - return $class->sth_to_objects($class->sql_Retrieve($frag), \@vals); - } -} - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher.pm deleted file mode 100644 index fb685d69b2..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher.pm +++ /dev/null @@ -1,757 +0,0 @@ -package OpenILS::Application::Storage::Publisher; -use base qw/OpenILS::Application::Storage/; -our $VERSION = 1; - -use Digest::MD5 qw/md5_hex/; -use OpenSRF::EX qw/:try/; -use OpenSRF::Utils; -use OpenSRF::Utils::Logger qw/:level/; -use OpenILS::Utils::Fieldmapper; - -my $log = 'OpenSRF::Utils::Logger'; - - -sub register_method { - my $class = shift; - my %args = @_; - my %dup_args = %args; - - $class = ref($class) || $class; - - $args{package} ||= $class; - __PACKAGE__->SUPER::register_method( %args ); - - if (exists($dup_args{cachable}) and $dup_args{cachable}) { - (my $name = $dup_args{api_name}) =~ s/^open-ils\.storage/open-ils.storage.cachable/o; - if ($name ne $dup_args{api_name}) { - $dup_args{real_api_name} = $dup_args{api_name}; - $dup_args{method} = 'cachable_wrapper'; - $dup_args{api_name} = $name; - $dup_args{package} = __PACKAGE__; - __PACKAGE__->SUPER::register_method( %dup_args ); - } - } - - if ($dup_args{real_api_name} =~ /^open-ils\.storage\.direct\..+\.search.+/o || - $dup_args{api_name} =~ /^open-ils\.storage\.direct\..+\.search.+/o) { - $dup_args{api_name} = $dup_args{real_api_name} if ($dup_args{real_api_name}); - - (my $name = $dup_args{api_name}) =~ s/\.direct\./.id_list./o; - - $dup_args{notes} = $dup_args{real_api_name}; - $dup_args{real_api_name} = $dup_args{api_name}; - $dup_args{method} = 'search_ids'; - $dup_args{api_name} = $name; - $dup_args{package} = __PACKAGE__; - - __PACKAGE__->SUPER::register_method( %dup_args ); - } -} - -sub cachable_wrapper { - my $self = shift; - my $client = shift; - my @args = @_; - - my %cache_args = ( - limit => 100, - offset => 0, - timeout => 7200, - cache_page_size => 1000, - ); - - my @real_args; - my $key_string = $self->api_name; - for (my $ind = 0; $ind < scalar(@args); $ind++) { - if ( $args[$ind] eq 'limit' || - $args[$ind] eq 'offset' || - $args[$ind] eq 'cache_page_size' || - $args[$ind] eq 'timeout' ) { - - my $key_ind = $ind; - $ind++; - my $value_ind = $ind; - $cache_args{$args[$key_ind]} = $args[$value_ind]; - $log->debug("Cache limiter value for $args[$key_ind] is $args[$value_ind]", INTERNAL); - next; - } - $key_string .= $args[$ind]; - $log->debug("Partial cache key value is $args[$ind]", INTERNAL); - push @real_args, $args[$ind]; - } - - my $cache_page = int($cache_args{offset} / $cache_args{cache_page_size}); - my $cache_key; - { use bytes; - $cache_key = md5_hex($key_string.$cache_page); - } - - $log->debug("Key string for cache lookup is $key_string -> $cache_key", DEBUG); - $log->debug("Cache page is $cache_page", DEBUG); - - my $cached_res = OpenSRF::Utils::Cache->new->get_cache( $cache_key ); - if (defined $cached_res) { - $log->debug("Found ".scalar(@$cached_res)." records in the cache", INFO); - $log->debug("Values from cache: ".join(', ', @$cached_res), INTERNAL); - my $start = int($cache_args{offset} - ($cache_page * $cache_args{cache_page_size})); - my $end = int($start + $cache_args{limit} - 1); - $log->debug("Responding with values from ".$start.' to '.$end,DEBUG); - $client->respond( $_ ) for ( grep { defined } @$cached_res[ $start .. $end ]); - return undef; - } - - my $method = $self->method_lookup($self->{real_api_name}); - my @res = $method->run(@real_args); - - - $client->respond( $_ ) for ( grep { defined } @res[$cache_args{offset} .. int($cache_args{offset} + $cache_args{limit} - 1)] ); - - $log->debug("Saving values from ".int($cache_page * $cache_args{cache_page_size})." to ". - int(($cache_page + 1) * $cache_args{cache_page_size}). "to the cache", INTERNAL); - try { - OpenSRF::Utils::Cache->new->put_cache( - $cache_key => - [@res[int($cache_page * $cache_args{cache_page_size}) .. int(($cache_page + 1) * $cache_args{cache_page_size}) ]] => - OpenSRF::Utils->interval_to_seconds( $cache_args{timeout} ) - ); - } catch Error with { - my $e = shift; - $log->error("Cache seems to be down, $e"); - }; - - return undef; -} - -sub random_object { - my $self = shift; - my $client = shift; - - my $cdbi = $self->{cdbi}; - my $table = $cdbi->table; - my $sql = <<" SQL"; - SELECT id - FROM $table - WHERE id IN (( SELECT (RANDOM() * (SELECT MAX(id) FROM $table))::INT LIMIT 1 )); - SQL - - my $trys = 100; - while ($trys--) { - - my $id = $cdbi->db_Main->selectcol_arrayref($sql); - next unless (@$id); - - return ($cdbi->fast_fieldmapper(@$id))[0]; - } - return undef; -} - -sub retrieve_node { - my $self = shift; - my $client = shift; - my @ids = @_; - - my $cdbi = $self->{cdbi}; - - for my $id ( @ids ) { - next unless ($id); - - my ($rec) = $cdbi->fast_fieldmapper($id); - if ($self->api_name !~ /batch/o) { - return $rec if ($rec); - } - $client->respond($rec); - } - return undef; -} - -sub search_ids { - my $self = shift; - my $client = shift; - my @args = @_; - - my @res = $self->method_lookup($self->{real_api_name})->run(@args); - - if (ref($res[0]) eq 'ARRAY') { - return [ map { $_->id } @{ $res[0] } ]; - } - - $client->respond($_) for ( map { $_->id } @res ); - return undef; -} - -sub search_where { - my $self = shift; - my $client = shift; - my @args = @_; - - if (ref($args[0]) eq 'HASH') { - if ($args[1]) { - $args[1]{limit_dialect} = $self->{cdbi}->db_Main; - } else { - $args[1] = {limit_dialect => $self->{cdbi}->db_Main }; - } - } else { - $args[0] = { @args }; - $args[1] = {limit_dialect => $self->{cdbi} }; - } - - my $cdbi = $self->{cdbi}; - - for my $obj ($cdbi->search_where(@args)) { - next unless ref($obj); - $client->respond( $obj->to_fieldmapper ); - } - return undef; -} - -sub search { - my $self = shift; - my $client = shift; - my @args = @_; - - my $cdbi = $self->{cdbi}; - - (my $search_type = $self->api_name) =~ s/.*\.(search[^.]*).*/$1/o; - - for my $obj ($cdbi->$search_type(@args)) { - next unless ref($obj); - $client->respond( $obj->to_fieldmapper ); - } - return undef; -} - -sub search_one_field { - my $self = shift; - my $client = shift; - my @args = @_; - - (my $field = $self->api_name) =~ s/.*\.([^\.]+)$/$1/o; - - return search( $self, $client, $field, @args ); -} - -sub old_search_one_field { - my $self = shift; - my $client = shift; - my @terms = @_; - - (my $search_type = $self->api_name) =~ s/.*\.(search[^.]*).*/$1/o; - (my $col = $self->api_name) =~ s/.*\.$search_type\.([^.]+).*/$1/; - my $cdbi = $self->{cdbi}; - - my $like = 0; - $like = 1 if ($search_type =~ /like$/o); - $like = 2 if ($search_type =~ /fts$/o); - $like = 3 if ($search_type =~ /regex$/o); - - for my $term (@terms) { - $log->debug("Searching $cdbi for $col using type $search_type, value '$term'",DEBUG); - if (@terms == 1) { - return [ $cdbi->fast_fieldmapper($term,$col,$like) ]; - } - $client->respond( [ $cdbi->fast_fieldmapper($term,$col,$like) ] ); - } - return undef; -} - - -sub create_node { - my $self = shift; - my $client = shift; - my $node = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - my $cdbi = $self->{cdbi}; - - my $success; - try { - my $rec = $cdbi->create($node); - $success = $rec->id if ($rec); - } catch Error with { - $success = 0; - }; - - return $success; -} - -sub update_node { - my $self = shift; - my $client = shift; - my $node = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - my $cdbi = $self->{cdbi}; - - return $cdbi->update($node); -} - -sub mass_delete { - my $self = shift; - my $client = shift; - my $search = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - my $where = 'WHERE '; - - my $cdbi = $self->{cdbi}; - my $table = $cdbi->table; - - my @keys = sort keys %$search; - - my @binds; - my @wheres; - for my $col ( @keys ) { - if (ref($$search{$col}) and ref($$search{$col}) =~ /ARRAY/o) { - push @wheres, "$col IN (" . join(',', map { '?' } @{ $$search{$col} }) . ')'; - push @binds, map { "$_" } @{ $$search{$col} }; - } else { - push @wheres, "$col = ?"; - push @binds, $$search{$col}; - } - } - $where .= join ' AND ', @wheres; - - my $delete = "DELETE FROM $table $where"; - - $log->debug("Performing MASS deletion : $delete",DEBUG); - - my $dbh = $cdbi->db_Main; - my $success = 1; - try { - my $sth = $dbh->prepare($delete); - $sth->execute( @binds ); - $sth->finish; - $log->debug("MASS Delete succeeded",DEBUG); - } catch Error with { - $log->debug("MASS Delete FAILED : ".shift(),DEBUG); - $success = 0; - }; - return $success; -} - -sub remote_update_node { - my $self = shift; - my $client = shift; - my $keys = shift; - my $vals = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - my $cdbi = $self->{cdbi}; - - my $success = 1; - try { - $success = $cdbi->remote_update($keys,$vals); - } catch Error with { - $success = 0; - }; - return $success; -} - -sub merge_node { - my $self = shift; - my $client = shift; - my $keys = shift; - my $vals = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - my $cdbi = $self->{cdbi}; - - my $success = 1; - try { - $success = $cdbi->merge($keys,$vals)->id; - } catch Error with { - $success = 0; - }; - return $success; -} - -sub delete_node { - my $self = shift; - my $client = shift; - my $node = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - my $cdbi = $self->{cdbi}; - - my $success = 1; - try { - $success = $cdbi->delete($node); - } catch Error with { - $success = 0; - }; - return $success; -} - -sub batch_call { - my $self = shift; - my $client = shift; - my @nodes = @_; - - my $unwrap = $self->{unwrap}; - - my $cdbi = $self->{cdbi}; - my $api_name = $self->api_name; - (my $single_call_api_name = $api_name) =~ s/batch\.//o; - - $log->debug("Default $api_name looking up $single_call_api_name...",INTERNAL); - my $method = $self->method_lookup($single_call_api_name); - - my @success; - while ( my $node = shift(@nodes) ) { - my ($res) = $method->run( ($unwrap ? (@$node) : ($node)) ); - push(@success, 1) if ($res >= 0); - } - - my $insert_total = 0; - $insert_total += $_ for (@success); - - return $insert_total; -} - - -# --------------------- End of generic methods ----------------------- - - -for my $pkg ( qw/actor action asset biblio config metabib authority money permission container/ ) { - "OpenILS::Application::Storage::Publisher::$pkg"->use; - if ($@) { - $log->debug("ARG! Couldn't load $pkg class Publisher: $@", ERROR); - throw OpenSRF::EX::ERROR ("ARG! Couldn't load $pkg class Publisher: $@"); - } -} - -for my $fmclass ( (Fieldmapper->classes) ) { - - $log->debug("Generating methods for Fieldmapper class $fmclass", DEBUG); - - next if ($fmclass->is_virtual); - - (my $cdbi = $fmclass) =~ s/^Fieldmapper:://o; - (my $class = $cdbi) =~ s/::.*//o; - (my $api_class = $cdbi) =~ s/::/./go; - my $registration_class = __PACKAGE__ . "::$class"; - my $api_prefix = 'open-ils.storage.direct.'.$api_class; - - # Create the search methods - unless ( __PACKAGE__->is_registered( $api_prefix.'.search' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.search', - method => 'search', - api_level => 1, - argc => 2, - stream => 1, - cdbi => $cdbi, - cachable => 1, - ); - } - - unless ( __PACKAGE__->is_registered( $api_prefix.'.search_where' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.search_where', - method => 'search_where', - api_level => 1, - stream => 1, - argc => 1, - cdbi => $cdbi, - cachable => 1, - ); - } - -=comment - - unless ( __PACKAGE__->is_registered( $api_prefix.'.search_like' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.search_like', - method => 'search', - api_level => 1, - stream => 1, - cdbi => $cdbi, - cachable => 1, - argc => 2, - ); - } - - if (\&Class::DBI::search_fts and $cdbi->columns('FTS')) { - unless ( __PACKAGE__->is_registered( $api_prefix.'.search_fts' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.search_fts', - method => 'search', - api_level => 1, - stream => 1, - cdbi => $cdbi, - cachable => 1, - argc => 2, - ); - } - } - - if (\&Class::DBI::search_regex) { - unless ( __PACKAGE__->is_registered( $api_prefix.'.search_regex' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.search_regex', - method => 'search', - api_level => 1, - stream => 1, - cdbi => $cdbi, - cachable => 1, - argc => 2, - ); - } - } - - if (\&Class::DBI::search_ilike) { - unless ( __PACKAGE__->is_registered( $api_prefix.'.search_ilike' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.search_ilike', - method => 'search', - api_level => 1, - stream => 1, - cdbi => $cdbi, - cachable => 1, - argc => 2, - ); - } - } - -=cut - - # Create the random method - unless ( __PACKAGE__->is_registered( $api_prefix.'.random' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.random', - method => 'random_object', - api_level => 1, - cdbi => $cdbi, - argc => 0, - ); - } - - # Create the retrieve method - unless ( __PACKAGE__->is_registered( $api_prefix.'.retrieve' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.retrieve', - method => 'retrieve_node', - api_level => 1, - cdbi => $cdbi, - cachable => 1, - argc => 1, - ); - } - - # Create the batch retrieve method - unless ( __PACKAGE__->is_registered( $api_prefix.'.batch.retrieve' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.batch.retrieve', - method => 'retrieve_node', - api_level => 1, - stream => 1, - cdbi => $cdbi, - cachable => 1, - argc => 1, - ); - } - - for my $field ($fmclass->real_fields) { - unless ( __PACKAGE__->is_registered( $api_prefix.'.search.'.$field ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.search.'.$field, - method => 'search_one_field', - api_level => 1, - cdbi => $cdbi, - cachable => 1, - stream => 1, - argc => 1, - ); - } - -=comment - - unless ( __PACKAGE__->is_registered( $api_prefix.'.search_like.'.$field ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.search_like.'.$field, - method => 'search_one_field', - api_level => 1, - cdbi => $cdbi, - cachable => 1, - stream => 1, - argc => 1, - ); - } - if (\&Class::DBI::search_fts and grep { $field eq $_ } $cdbi->columns('FTS')) { - unless ( __PACKAGE__->is_registered( $api_prefix.'.search_fts.'.$field ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.search_fts.'.$field, - method => 'search_one_field', - api_level => 1, - cdbi => $cdbi, - cachable => 1, - stream => 1, - argc => 1, - ); - } - } - if (\&Class::DBI::search_regex) { - unless ( __PACKAGE__->is_registered( $api_prefix.'.search_regex.'.$field ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.search_regex.'.$field, - method => 'search_one_field', - api_level => 1, - cdbi => $cdbi, - cachable => 1, - stream => 1, - argc => 1, - ); - } - } - if (\&Class::DBI::search_ilike) { - unless ( __PACKAGE__->is_registered( $api_prefix.'.search_ilike.'.$field ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.search_ilike.'.$field, - method => 'search_one_field', - api_level => 1, - cdbi => $cdbi, - cachable => 1, - stream => 1, - argc => 1, - ); - } - } - -=cut - - } - - - unless ($fmclass->is_readonly) { - # Create the create method - unless ( __PACKAGE__->is_registered( $api_prefix.'.create' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.create', - method => 'create_node', - api_level => 1, - cdbi => $cdbi, - argc => 1, - ); - } - - # Create the batch create method - unless ( __PACKAGE__->is_registered( $api_prefix.'.batch.create' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.batch.create', - method => 'batch_call', - api_level => 1, - cdbi => $cdbi, - argc => 1, - ); - } - - # Create the update method - unless ( __PACKAGE__->is_registered( $api_prefix.'.update' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.update', - method => 'update_node', - api_level => 1, - cdbi => $cdbi, - argc => 1, - ); - } - - # Create the batch update method - unless ( __PACKAGE__->is_registered( $api_prefix.'.batch.update' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.batch.update', - method => 'batch_call', - api_level => 1, - cdbi => $cdbi, - argc => 1, - ); - } - - # Create the delete method - unless ( __PACKAGE__->is_registered( $api_prefix.'.delete' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.delete', - method => 'delete_node', - api_level => 1, - cdbi => $cdbi, - argc => 1, - ); - } - - # Create the batch delete method - unless ( __PACKAGE__->is_registered( $api_prefix.'.batch.delete' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.batch.delete', - method => 'batch_call', - api_level => 1, - cdbi => $cdbi, - argc => 1, - ); - } - - # Create the merge method - unless ( __PACKAGE__->is_registered( $api_prefix.'.merge' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.merge', - method => 'merge_node', - api_level => 1, - cdbi => $cdbi, - argc => 1, - ); - } - - # Create the batch merge method - unless ( __PACKAGE__->is_registered( $api_prefix.'.batch.merge' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.batch.merge', - method => 'batch_call', - unwrap => 1, - api_level => 1, - cdbi => $cdbi, - argc => 1, - ); - } - - # Create the remote_update method - unless ( __PACKAGE__->is_registered( $api_prefix.'.remote_update' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.remote_update', - method => 'remote_update_node', - api_level => 1, - cdbi => $cdbi, - argc => 1, - ); - } - - # Create the batch remote_update method - unless ( __PACKAGE__->is_registered( $api_prefix.'.batch.remote_update' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.batch.remote_update', - method => 'batch_call', - api_level => 1, - unwrap => 1, - cdbi => $cdbi, - argc => 1, - ); - } - - # Create the search-based mass delete method - unless ( __PACKAGE__->is_registered( $api_prefix.'.mass_delete' ) ) { - __PACKAGE__->register_method( - api_name => $api_prefix.'.mass_delete', - method => 'mass_delete', - api_level => 1, - cdbi => $cdbi, - argc => 1, - ); - } - } -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/action.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/action.pm deleted file mode 100644 index 6b96ffabca..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/action.pm +++ /dev/null @@ -1,2011 +0,0 @@ -package OpenILS::Application::Storage::Publisher::action; -use parent qw/OpenILS::Application::Storage::Publisher/; -use strict; -use warnings; -use OpenSRF::Utils::Logger qw/:level/; -use OpenSRF::Utils qw/:datetime/; -use OpenSRF::Utils::JSON; -use OpenSRF::AppSession; -use OpenSRF::EX qw/:try/; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::PermitHold; -use DateTime; -use DateTime::Format::ISO8601; -use OpenILS::Utils::Penalty; - -sub isTrue { - my $v = shift; - return 1 if ($v == 1); - return 1 if ($v =~ /^t/io); - return 1 if ($v =~ /^y/io); - return 0; -} - -my $parser = DateTime::Format::ISO8601->new; -my $log = 'OpenSRF::Utils::Logger'; - -sub open_noncat_circs { - my $self = shift; - my $client = shift; - my $user = shift; - - my $a = action::non_cataloged_circulation->table; - my $c = config::non_cataloged_type->table; - - my $sql = <<" SQL"; - SELECT a.id - FROM $a a - JOIN $c c ON (a.item_type = c.id) - WHERE a.circ_time + c.circ_duration > current_timestamp - AND a.patron = ? - SQL - - return action::non_cataloged_circulation->db_Main->selectcol_arrayref($sql, {}, $user); -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.open_non_cataloged_circulation.user', - method => 'open_noncat_circs', - api_level => 1, - argc => 1, -); - - -sub ou_hold_requests { - my $self = shift; - my $client = shift; - my $ou = shift; - - my $h_table = action::hold_request->table; - my $c_table = asset::copy->table; - my $o_table = actor::org_unit->table; - - my $SQL = <<" SQL"; - SELECT h.id - FROM $h_table h - JOIN $c_table cp ON (cp.id = h.current_copy) - JOIN $o_table ou ON (ou.id = cp.circ_lib) - WHERE ou.id = ? - AND h.capture_time IS NULL - AND h.cancel_time IS NULL - AND (h.expire_time IS NULL OR h.expire_time > NOW()) - ORDER BY h.request_time - SQL - - my $sth = action::hold_request->db_Main->prepare_cached($SQL); - $sth->execute($ou); - - $client->respond($_) for ( - map { - $self - ->method_lookup('open-ils.storage.direct.action.hold_request.retrieve') - ->run($_) - } map { - $_->[0] - } @{ $sth->fetchall_arrayref } - ); - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.targeted_hold_request.org_unit', - api_level => 1, - argc => 1, - stream => 1, - method => 'ou_hold_requests', -); - - -sub overdue_circs { - my $grace = shift; - my $upper_interval = shift || '1 millennium'; - my $idlist = shift; - - my $c_t = action::circulation->table; - - if ($grace && $grace =~ /^\d+$/o) { - $grace = " - ($grace * (fine_interval))"; - } else { - $grace = ''; - } - - my $sql = <<" SQL"; - SELECT * - FROM $c_t - WHERE stop_fines IS NULL - AND due_date < ( CURRENT_TIMESTAMP $grace) - AND fine_interval < ?::INTERVAL - SQL - - my $sth = action::circulation->db_Main->prepare_cached($sql); - $sth->execute($upper_interval); - - my @circs = map { $idlist ? $_->{id} : action::circulation->construct($_) } $sth->fetchall_hash; - - $c_t = booking::reservation->table; - $sql = <<" SQL"; - SELECT * - FROM $c_t - WHERE return_time IS NULL - AND end_time < ( CURRENT_TIMESTAMP $grace) - AND fine_interval IS NOT NULL - AND cancel_time IS NULL - SQL - - $sth = action::circulation->db_Main->prepare_cached($sql); - $sth->execute(); - - push @circs, map { $idlist ? $_->{id} : booking::reservation->construct($_) } $sth->fetchall_hash; - - return @circs; -} - -sub complete_reshelving { - my $self = shift; - my $client = shift; - my $window = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - throw OpenSRF::EX::InvalidArg ("I need an interval of more than 0 seconds!") - unless (interval_to_seconds( $window )); - - my $setting = actor::org_unit_setting->table; - my $circ = action::circulation->table; - my $cp = asset::copy->table; - my $atc = action::transit_copy->table; - - my $sql = <<" SQL"; - UPDATE $cp - SET status = 0 - WHERE id IN ( - SELECT id - FROM (SELECT cp.id, MAX(circ.checkin_time), MAX(trans.dest_recv_time) - FROM $cp cp - JOIN $circ circ ON (circ.target_copy = cp.id) - LEFT JOIN $atc trans ON (trans.target_copy = cp.id) - LEFT JOIN $setting setting - ON (cp.circ_lib = setting.org_unit AND setting.name = 'circ.reshelving_complete.interval') - WHERE circ.checkin_time IS NOT NULL - AND cp.status = 7 - GROUP BY 1 - HAVING ( - ( ( MAX(circ.checkin_time) > MAX(trans.dest_recv_time) or MAX(trans.dest_recv_time) IS NULL ) - AND MAX(circ.checkin_time) < NOW() - CAST( COALESCE( BTRIM( FIRST(setting.value),'"' ), ? ) AS INTERVAL) ) - OR - ( MAX(trans.dest_recv_time) > MAX(circ.checkin_time) - AND MAX(trans.dest_recv_time) < NOW() - CAST( COALESCE( BTRIM( FIRST(setting.value),'"' ), ? ) AS INTERVAL) ) - ) - ) AS foo - UNION ALL - SELECT cp.id - FROM $cp cp - LEFT JOIN $setting setting - ON (cp.circ_lib = setting.org_unit AND setting.name = 'circ.reshelving_complete.interval') - LEFT JOIN $circ circ ON (circ.target_copy = cp.id) - WHERE cp.status = 7 - AND circ.id IS NULL - AND cp.create_date < NOW() - CAST( COALESCE( BTRIM( setting.value,'"' ), ? ) AS INTERVAL) - ) - SQL - my $sth = action::circulation->db_Main->prepare_cached($sql); - $sth->execute($window, $window, $window); - - return $sth->rows; - -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.circulation.reshelving.complete', - api_level => 1, - argc => 1, - method => 'complete_reshelving', -); - -sub mark_longoverdue { - my $self = shift; - my $client = shift; - my $window = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - throw OpenSRF::EX::InvalidArg ("I need an interval of more than 0 seconds!") - unless (interval_to_seconds( $window )); - - my $setting = actor::org_unit_setting->table; - my $circ = action::circulation->table; - - my $sql = <<" SQL"; - UPDATE $circ - SET stop_fines = 'LONGOVERDUE', - stop_fines_time = now() - WHERE id IN ( - SELECT circ.id - FROM $circ circ - LEFT JOIN $setting setting - ON (circ.circ_lib = setting.org_unit AND setting.name = 'circ.long_overdue.interval') - WHERE circ.checkin_time IS NULL AND (stop_fines IS NULL OR stop_fines NOT IN ('LOST','LONGOVERDUE')) - AND AGE(circ.due_date) > CAST( COALESCE( BTRIM( setting.value,'"' ), ? ) AS INTERVAL) - ) - SQL - - my $sth = action::circulation->db_Main->prepare_cached($sql); - $sth->execute($window); - - return $sth->rows; - -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.circulation.long_overdue', - api_level => 1, - argc => 1, - method => 'mark_longoverdue', -); - -sub auto_thaw_frozen_holds { - my $self = shift; - my $client = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - my $holds = action::hold_request->table; - - my $sql = "UPDATE $holds SET frozen = FALSE WHERE frozen IS TRUE AND thaw_date < NOW();"; - - my $sth = action::hold_request->db_Main->prepare_cached($sql); - $sth->execute(); - - return $sth->rows; - -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.hold_request.thaw_expired_frozen', - api_level => 1, - stream => 0, - argc => 0, - method => 'auto_thaw_frozen_holds', -); - -sub grab_overdue { - my $self = shift; - my $client = shift; - my $grace = shift || ''; - - my $idlist = $self->api_name =~/id_list/o ? 1 : 0; - - $client->respond( $idlist ? $_ : $_->to_fieldmapper ) for ( overdue_circs($grace, '', $idlist) ); - - return undef; - -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.circulation.overdue', - api_level => 1, - stream => 1, - method => 'grab_overdue', - signature => q/ - Return list of overdue circulations and reservations to be used for fine generation. - Despite the name, this is not a generic method for retrieving all overdue loans, - as it excludes loans that have already hit the maximum fine limit. -/, -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.circulation.overdue.id_list', - api_level => 1, - stream => 1, - method => 'grab_overdue', -); - -sub nearest_hold { - my $self = shift; - my $client = shift; - my $here = shift; - my $cp = shift; - my $limit = int(shift()) || 10; - my $age = shift() || '0 seconds'; - my $fifo = shift(); - - local $OpenILS::Application::Storage::WRITE = 1; - - my $holdsort = isTrue($fifo) ? - "pgt.hold_priority, CASE WHEN h.cut_in_line IS TRUE THEN 0 ELSE 1 END, h.request_time, h.selection_depth DESC, p.prox " : - "p.prox, pgt.hold_priority, CASE WHEN h.cut_in_line IS TRUE THEN 0 ELSE 1 END, h.selection_depth DESC, h.request_time "; - - my $ids = action::hold_request->db_Main->selectcol_arrayref(<<" SQL", {}, $here, $cp, $age); - SELECT h.id - FROM action.hold_request h - JOIN actor.org_unit_proximity p ON (p.from_org = ? AND p.to_org = h.pickup_lib) - JOIN action.hold_copy_map hm ON (hm.hold = h.id) - JOIN actor.usr au ON (au.id = h.usr) - JOIN permission.grp_tree pgt ON (au.profile = pgt.id) - WHERE hm.target_copy = ? - AND (AGE(NOW(),h.request_time) >= CAST(? AS INTERVAL) OR p.prox = 0) - AND h.capture_time IS NULL - AND h.cancel_time IS NULL - AND (h.expire_time IS NULL OR h.expire_time > NOW()) - AND h.frozen IS FALSE - ORDER BY $holdsort - LIMIT $limit - SQL - - $client->respond( $_ ) for ( @$ids ); - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.hold_request.nearest_hold', - api_level => 1, - stream => 1, - method => 'nearest_hold', -); - -sub targetable_holds { - my $self = shift; - my $client = shift; - my $check_expire = shift; - - $check_expire ||= '12h'; - - local $OpenILS::Application::Storage::WRITE = 1; - - # json_query can *almost* represent this query, but can't - # handle the CASE statement or the interval arithmetic - my $query = <<" SQL"; - SELECT ahr.id, mmsm.metarecord - FROM action.hold_request ahr - JOIN reporter.hold_request_record USING (id) - JOIN metabib.metarecord_source_map mmsm ON (bib_record = source) - WHERE capture_time IS NULL - AND (prev_check_time IS NULL or prev_check_time < (NOW() - ?::interval)) - AND fulfillment_time IS NULL - AND cancel_time IS NULL - AND NOT frozen - ORDER BY CASE WHEN ahr.hold_type = 'F' THEN 0 ELSE 1 END, selection_depth DESC, request_time; - SQL - my $sth = action::hold_request->db_Main->prepare_cached($query); - $sth->execute($check_expire); - - $client->respond( $_ ) for ( $sth->fetchall_arrayref ); - return undef; -} - -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.hold_request.targetable_holds.id_list', - api_level => 1, - stream => 1, - method => 'targetable_holds', - signature => q/ - Returns ordered list of hold request and metarecord IDs - for all hold requests that are available for initial targeting - or retargeting. - @param check interval - @return list of pairs of hold request and metarecord IDs -/, -); - -sub next_resp_group_id { - my $self = shift; - my $client = shift; - - # XXX This is not replication safe!!! - - my ($id) = action::survey->db_Main->selectrow_array(<<" SQL"); - SELECT NEXTVAL('action.survey_response_group_id_seq'::TEXT) - SQL - return $id; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.survey_response.next_group_id', - api_level => 1, - method => 'next_resp_group_id', -); - -sub patron_circ_summary { - my $self = shift; - my $client = shift; - my $id = ''.shift(); - - return undef unless ($id); - my $c_table = action::circulation->table; - my $b_table = money::billing->table; - - $log->debug("Retrieving patron summary for id $id", DEBUG); - - my $select = <<" SQL"; - SELECT COUNT(DISTINCT c.id), SUM( COALESCE(b.amount,0) ) - FROM $c_table c - LEFT OUTER JOIN $b_table b ON (c.id = b.xact AND b.voided = FALSE) - WHERE c.usr = ? - AND c.xact_finish IS NULL - AND ( - c.stop_fines NOT IN ('CLAIMSRETURNED','LOST') - OR c.stop_fines IS NULL - ) - SQL - - return action::survey->db_Main->selectrow_arrayref($select, {}, $id); -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.circulation.patron_summary', - api_level => 1, - method => 'patron_circ_summary', -); - -#XXX Fix stored proc calls -sub find_local_surveys { - my $self = shift; - my $client = shift; - my $ou = ''.shift(); - - return undef unless ($ou); - my $s_table = action::survey->table; - - my $select = <<" SQL"; - SELECT s.* - FROM $s_table s - JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner) - WHERE CURRENT_TIMESTAMP BETWEEN s.start_date AND s.end_date - SQL - - my $sth = action::survey->db_Main->prepare_cached($select); - $sth->execute($ou); - - $client->respond( $_->to_fieldmapper ) for ( map { action::survey->construct($_) } $sth->fetchall_hash ); - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.survey.all', - api_level => 1, - stream => 1, - method => 'find_local_surveys', -); - -#XXX Fix stored proc calls -sub find_opac_surveys { - my $self = shift; - my $client = shift; - my $ou = ''.shift(); - - return undef unless ($ou); - my $s_table = action::survey->table; - - my $select = <<" SQL"; - SELECT s.* - FROM $s_table s - JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner) - WHERE CURRENT_TIMESTAMP BETWEEN s.start_date AND s.end_date - AND s.opac IS TRUE; - SQL - - my $sth = action::survey->db_Main->prepare_cached($select); - $sth->execute($ou); - - $client->respond( $_->to_fieldmapper ) for ( map { action::survey->construct($_) } $sth->fetchall_hash ); - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.survey.opac', - api_level => 1, - stream => 1, - method => 'find_opac_surveys', -); - -sub hold_pull_list { - my $self = shift; - my $client = shift; - my $ou = shift; - my $limit = shift || 10; - my $offset = shift || 0; - - return undef unless ($ou); - my $h_table = action::hold_request->table; - my $a_table = asset::copy->table; - my $ord_table = asset::copy_location_order->table; - - my $idlist = 1 if ($self->api_name =~/id_list/o); - my $count = 1 if ($self->api_name =~/count$/o); - - my $status_filter = ''; - $status_filter = 'AND a.status IN (0,7)' if ($self->api_name =~/status_filtered/o); - - my $select = <<" SQL"; - SELECT h.* - FROM $h_table h - JOIN $a_table a ON (h.current_copy = a.id) - LEFT JOIN $ord_table ord ON (a.location = ord.location AND a.circ_lib = ord.org) - WHERE a.circ_lib = ? - AND h.capture_time IS NULL - AND h.cancel_time IS NULL - AND (h.expire_time IS NULL OR h.expire_time > NOW()) - $status_filter - ORDER BY CASE WHEN ord.position IS NOT NULL THEN ord.position ELSE 999 END, h.request_time - LIMIT $limit - OFFSET $offset - SQL - - if ($count) { - $select = <<" SQL"; - SELECT count(*) - FROM $h_table h - JOIN $a_table a ON (h.current_copy = a.id) - WHERE a.circ_lib = ? - AND h.capture_time IS NULL - AND h.cancel_time IS NULL - AND (h.expire_time IS NULL OR h.expire_time > NOW()) - $status_filter - SQL - } - - my $sth = action::survey->db_Main->prepare_cached($select); - $sth->execute($ou); - - if ($count) { - $client->respond( $sth->fetchall_arrayref()->[0][0] ); - } elsif ($idlist) { - $client->respond( $_->{id} ) for ( $sth->fetchall_hash ); - } else { - $client->respond( $_->to_fieldmapper ) for ( map { action::hold_request->construct($_) } $sth->fetchall_hash ); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.direct.action.hold_request.pull_list.current_copy_circ_lib.count', - api_level => 1, - stream => 1, - signature => [ - "Returns a count of holds for a specific library's pull list.", - [ [org_unit => "The library's org id", "number"] ], - ['A count of holds for the stated library to pull ', 'number'] - ], - method => 'hold_pull_list', -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.direct.action.hold_request.pull_list.current_copy_circ_lib.status_filtered.count', - api_level => 1, - stream => 1, - signature => [ - "Returns a status filtered count of holds for a specific library's pull list.", - [ [org_unit => "The library's org id", "number"] ], - ['A status filtered count of holds for the stated library to pull ', 'number'] - ], - method => 'hold_pull_list', -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.direct.action.hold_request.pull_list.id_list.current_copy_circ_lib', - api_level => 1, - stream => 1, - signature => [ - "Returns the hold ids for a specific library's pull list.", - [ [org_unit => "The library's org id", "number"], - [limit => 'An optional page size, defaults to 10', 'number'], - [offset => 'Offset for paging, defaults to 0, 0 based', 'number'], - ], - ['A list of holds for the stated library to pull for', 'array'] - ], - method => 'hold_pull_list', -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.direct.action.hold_request.pull_list.search.current_copy_circ_lib', - api_level => 1, - stream => 1, - signature => [ - "Returns the holds for a specific library's pull list.", - [ [org_unit => "The library's org id", "number"], - [limit => 'An optional page size, defaults to 10', 'number'], - [offset => 'Offset for paging, defaults to 0, 0 based', 'number'], - ], - ['A list of holds for the stated library to pull for', 'array'] - ], - method => 'hold_pull_list', -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.direct.action.hold_request.pull_list.id_list.current_copy_circ_lib.status_filtered', - api_level => 1, - stream => 1, - signature => [ - "Returns the hold ids for a specific library's pull list that are definitely in that library, based on status.", - [ [org_unit => "The library's org id", "number"], - [limit => 'An optional page size, defaults to 10', 'number'], - [offset => 'Offset for paging, defaults to 0, 0 based', 'number'], - ], - ['A list of holds for the stated library to pull for', 'array'] - ], - method => 'hold_pull_list', -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.direct.action.hold_request.pull_list.search.current_copy_circ_lib.status_filtered', - api_level => 1, - stream => 1, - signature => [ - "Returns the holds for a specific library's pull list that are definitely in that library, based on status.", - [ [org_unit => "The library's org id", "number"], - [limit => 'An optional page size, defaults to 10', 'number'], - [offset => 'Offset for paging, defaults to 0, 0 based', 'number'], - ], - ['A list of holds for the stated library to pull for', 'array'] - ], - method => 'hold_pull_list', -); - -sub find_optional_surveys { - my $self = shift; - my $client = shift; - my $ou = ''.shift(); - - return undef unless ($ou); - my $s_table = action::survey->table; - - my $select = <<" SQL"; - SELECT s.* - FROM $s_table s - JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner) - WHERE CURRENT_TIMESTAMP BETWEEN s.start_date AND s.end_date - AND s.required IS FALSE; - SQL - - my $sth = action::survey->db_Main->prepare_cached($select); - $sth->execute($ou); - - $client->respond( $_->to_fieldmapper ) for ( map { action::survey->construct($_) } $sth->fetchall_hash ); - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.survey.optional', - api_level => 1, - stream => 1, - method => 'find_optional_surveys', -); - -sub find_required_surveys { - my $self = shift; - my $client = shift; - my $ou = ''.shift(); - - return undef unless ($ou); - my $s_table = action::survey->table; - - my $select = <<" SQL"; - SELECT s.* - FROM $s_table s - JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner) - WHERE CURRENT_TIMESTAMP BETWEEN s.start_date AND s.end_date - AND s.required IS TRUE; - SQL - - my $sth = action::survey->db_Main->prepare_cached($select); - $sth->execute($ou); - - $client->respond( $_->to_fieldmapper ) for ( map { action::survey->construct($_) } $sth->fetchall_hash ); - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.survey.required', - api_level => 1, - stream => 1, - method => 'find_required_surveys', -); - -sub find_usr_summary_surveys { - my $self = shift; - my $client = shift; - my $ou = ''.shift(); - - return undef unless ($ou); - my $s_table = action::survey->table; - - my $select = <<" SQL"; - SELECT s.* - FROM $s_table s - JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner) - WHERE CURRENT_TIMESTAMP BETWEEN s.start_date AND s.end_date - AND s.usr_summary IS TRUE; - SQL - - my $sth = action::survey->db_Main->prepare_cached($select); - $sth->execute($ou); - - $client->respond( $_->to_fieldmapper ) for ( map { action::survey->construct($_) } $sth->fetchall_hash ); - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.survey.usr_summary', - api_level => 1, - stream => 1, - method => 'find_usr_summary_surveys', -); - -sub seconds_to_interval_hash { - my $interval = shift; - my $limit = shift || 's'; - $limit =~ s/^(.)/$1/o; - - my %output; - - my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s); - my ($year, $month, $week, $day, $hour, $minute, $second) = - ('years','months','weeks','days', 'hours', 'minutes', 'seconds'); - - if ($y = int($interval / (60 * 60 * 24 * 365))) { - $output{$year} = $y; - $ym = $interval % (60 * 60 * 24 * 365); - } else { - $ym = $interval; - } - return %output if ($limit eq 'y'); - - if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) { - $output{$month} = $M; - $Mm = $ym % ((60 * 60 * 24 * 365)/12); - } else { - $Mm = $ym; - } - return %output if ($limit eq 'M'); - - if ($w = int($Mm / 604800)) { - $output{$week} = $w; - $wm = $Mm % 604800; - } else { - $wm = $Mm; - } - return %output if ($limit eq 'w'); - - if ($d = int($wm / 86400)) { - $output{$day} = $d; - $dm = $wm % 86400; - } else { - $dm = $wm; - } - return %output if ($limit eq 'd'); - - if ($h = int($dm / 3600)) { - $output{$hour} = $h; - $hm = $dm % 3600; - } else { - $hm = $dm; - } - return %output if ($limit eq 'h'); - - if ($m = int($hm / 60)) { - $output{$minute} = $m; - $mm = $hm % 60; - } else { - $mm = $hm; - } - return %output if ($limit eq 'm'); - - if ($s = int($mm)) { - $output{$second} = $s; - } else { - $output{$second} = 0 unless (keys %output); - } - return %output; -} - - -sub generate_fines { - my $self = shift; - my $client = shift; - my $grace = shift; - my $circ = shift; - my $overbill = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - my @circs; - if ($circ) { - push @circs, - action::circulation->search_where( { id => $circ, stop_fines => undef } ), - booking::reservation->search_where( { id => $circ, return_time => undef, cancel_time => undef } ); - } else { - push @circs, overdue_circs($grace); - } - - my %hoo = map { ( $_->id => $_ ) } actor::org_unit::hours_of_operation->retrieve_all; - - my $penalty = OpenSRF::AppSession->create('open-ils.penalty'); - for my $c (@circs) { - - my $ctype = ref($c); - $ctype =~ s/^.+::(\w+)$/$1/; - - my $due_date_method = 'due_date'; - my $target_copy_method = 'target_copy'; - my $circ_lib_method = 'circ_lib'; - my $recurring_fine_method = 'recurring_fine'; - my $is_reservation = 0; - if ($ctype eq 'reservation') { - $is_reservation = 1; - $due_date_method = 'end_time'; - $target_copy_method = 'current_resource'; - $circ_lib_method = 'pickup_lib'; - $recurring_fine_method = 'fine_amount'; - next unless ($c->fine_interval); - } - - try { - if ($self->method_lookup('open-ils.storage.transaction.current')->run) { - $log->debug("Cleaning up after previous transaction\n"); - $self->method_lookup('open-ils.storage.transaction.rollback')->run; - } - $self->method_lookup('open-ils.storage.transaction.begin')->run( $client ); - $log->info( - sprintf("Processing %s %d...", - ($is_reservation ? "reservation" : "circ"), $c->id - ) - ); - - - my $due_dt = $parser->parse_datetime( cleanse_ISO8601( $c->$due_date_method ) ); - - my $due = $due_dt->epoch; - my $now = time; - - my $fine_interval = $c->fine_interval; - $fine_interval =~ s/(\d{2}):(\d{2}):(\d{2})/$1 h $2 m $3 s/o; - $fine_interval = interval_to_seconds( $fine_interval ); - - if ( $is_reservation and $fine_interval >= interval_to_seconds('1d') ) { - my $tz_offset_s = 0; - if ($due_dt->strftime('%z') =~ /(-|\+)(\d{2}):?(\d{2})/) { - $tz_offset_s = $1 . interval_to_seconds( "${2}h ${3}m"); - } - - $due -= ($due % $fine_interval) + $tz_offset_s; - $now -= ($now % $fine_interval) + $tz_offset_s; - } - - $client->respond( - "ARG! Overdue $ctype ".$c->id. - " for item ".$c->$target_copy_method. - " (user ".$c->usr.").\n". - "\tItem was due on or before: ".localtime($due)."\n"); - - my @fines = money::billing->search_where( - { xact => $c->id, - btype => 1, - billing_ts => { '>' => $c->$due_date_method } }, - { order_by => 'billing_ts DESC'} - ); - - my $f_idx = 0; - my $fine = $fines[$f_idx] if (@fines); - if ($overbill) { - $fine = $fines[++$f_idx] while ($fine and $fine->voided); - } - - my $current_fine_total = 0; - $current_fine_total += int($_->amount * 100) for (grep { $_ and !$_->voided } @fines); - - my $last_fine; - if ($fine) { - $client->respond( "Last billing time: ".$fine->billing_ts." (clensed format: ".cleanse_ISO8601( $fine->billing_ts ).")"); - $last_fine = $parser->parse_datetime( cleanse_ISO8601( $fine->billing_ts ) )->epoch; - } else { - $log->info( "Potential first billing for circ ".$c->id ); - $last_fine = $due; - - if (0) { - if (my $h = $hoo{$c->$circ_lib_method}) { - - $log->info( "Circ lib has an hours-of-operation entry" ); - # find the day after the due date... - $due_dt = $due_dt->add( days => 1 ); - - # get the day of the week for that day... - my $dow = $due_dt->day_of_week_0; - my $dow_open = "dow_${dow}_open"; - my $dow_close = "dow_${dow}_close"; - - my $count = 0; - while ( $h->$dow_open eq '00:00:00' and $h->$dow_close eq '00:00:00' ) { - # if the circ lib is closed, add a day to the grace period... - - $grace++; - $log->info( "Grace period for circ ".$c->id." extended to $grace intervals" ); - $log->info( "Day of week $dow open $dow_open, close $dow_close" ); - - $due_dt = $due_dt->add( days => 1 ); - $dow = $due_dt->day_of_week_0; - $dow_open = "dow_${dow}_open"; - $dow_close = "dow_${dow}_close"; - - $count++; - - # and check for up to a week - last if ($count > 6); - } - } - } - } - - next if ($last_fine > $now); - my $pending_fine_count = int( ($now - $last_fine) / $fine_interval ); - - # Generate fines for the interval we are currently inside, when the fine interval is some multiple of 1d - $pending_fine_count++ if ($fine_interval && ($fine_interval % 86400 == 0)); - - if ( $last_fine == $due # we have no fines yet - && $grace # and we have a grace period - && $pending_fine_count <= $grace # and we seem to be inside that period - && $now < $due + $fine_interval * $grace # and some date math bares that out, then - ) { - $client->respond( "Still inside grace period of: ". seconds_to_interval( $fine_interval * $grace)."\n" ); - $log->info( "Circ ".$c->id." is still inside grace period of: $grace [". seconds_to_interval( $fine_interval * $grace).']' ); - next; - } - - $client->respond( "\t$pending_fine_count pending fine(s)\n" ); - next unless ($pending_fine_count); - - my $recurring_fine = int($c->$recurring_fine_method * 100); - my $max_fine = int($c->max_fine * 100); - - my ($latest_billing_ts, $latest_amount) = ('',0); - for (my $bill = 1; $bill <= $pending_fine_count; $bill++) { - - if ($current_fine_total >= $max_fine) { - $c->update({stop_fines => 'MAXFINES', stop_fines_time => 'now'}) if ($ctype eq 'circulation'); - $client->respond( - "\tMaximum fine level of ".$c->max_fine. - " reached for this $ctype.\n". - "\tNo more fines will be generated.\n" ); - last; - } - - # XXX Use org time zone (or default to 'local') once we have the ou setting built for that - my $billing_ts = DateTime->from_epoch( epoch => $last_fine, time_zone => 'local' ); - my $current_bill_count = $bill; - while ( $current_bill_count ) { - $billing_ts->add( seconds_to_interval_hash( $fine_interval ) ); - $current_bill_count--; - } - - my $dow = $billing_ts->day_of_week_0(); - my $dow_open = "dow_${dow}_open"; - my $dow_close = "dow_${dow}_close"; - - if (my $h = $hoo{$c->$circ_lib_method}) { - next if ( $h->$dow_open eq '00:00:00' and $h->$dow_close eq '00:00:00'); - } - - my $timestamptz = $billing_ts->strftime('%FT%T%z'); - my @cl = actor::org_unit::closed_date->search_where( - { close_start => { '<=' => $timestamptz }, - close_end => { '>=' => $timestamptz }, - org_unit => $c->$circ_lib_method } - ); - next if (@cl); - - $current_fine_total += $recurring_fine; - $latest_amount += $recurring_fine; - $latest_billing_ts = $timestamptz; - - money::billing->create( - { xact => ''.$c->id, - note => "System Generated Overdue Fine", - billing_type => "Overdue materials", - btype => 1, - amount => sprintf('%0.2f', $recurring_fine/100), - billing_ts => $timestamptz, - } - ); - - } - - $client->respond( "\t\tAdding fines totaling $latest_amount for overdue up to $latest_billing_ts\n" ) - if ($latest_billing_ts and $latest_amount); - - $self->method_lookup('open-ils.storage.transaction.commit')->run; - - if(1) { - - # Caluclate penalties inline - OpenILS::Utils::Penalty->calculate_penalties( - undef, $c->usr->to_fieldmapper->id.'', $c->$circ_lib_method->to_fieldmapper->id.''); - - } else { - - # Calculate penalties with an aysnc call to the penalty server. This approach - # may lead to duplicate penalties since multiple penalty processes for a - # given user may be running at the same time. Leave this here for reference - # in case we later find that asyc calls are needed in some environments. - $penalty->request( - 'open-ils.penalty.patron_penalty.calculate', - { patronid => ''.$c->usr, - context_org => ''.$c->$circ_lib_method, - update => 1, - background => 1, - } - )->gather(1); - } - - } catch Error with { - my $e = shift; - $client->respond( "Error processing overdue $ctype [".$c->id."]:\n\n$e\n" ); - $log->error("Error processing overdue $ctype [".$c->id."]:\n$e\n"); - $self->method_lookup('open-ils.storage.transaction.rollback')->run; - throw $e if ($e =~ /IS NOT CONNECTED TO THE NETWORK/o); - }; - } -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.circulation.overdue.generate_fines', - api_level => 1, - stream => 1, - method => 'generate_fines', -); - - - -sub new_hold_copy_targeter { - my $self = shift; - my $client = shift; - my $check_expire = shift; - my $one_hold = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - $self->{target_weight} = {}; - $self->{max_loops} = {}; - - my $holds; - - try { - if ($one_hold) { - $self->method_lookup('open-ils.storage.transaction.begin')->run( $client ); - $holds = [ action::hold_request->search_where( { id => $one_hold, fulfillment_time => undef, cancel_time => undef } ) ]; - } elsif ( $check_expire ) { - - # what's the retarget time threashold? - my $time = time; - $check_expire ||= '12h'; - $check_expire = interval_to_seconds( $check_expire ); - - my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time() - $check_expire); - $year += 1900; - $mon += 1; - my $expire_threshold = sprintf( - '%s-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d-00', - $year, $mon, $mday, $hour, $min, $sec - ); - - # find all the holds holds needing retargeting - $holds = [ action::hold_request->search_where( - { capture_time => undef, - fulfillment_time => undef, - cancel_time => undef, - frozen => 'f', - prev_check_time => { '<=' => $expire_threshold }, - }, - { order_by => 'CASE WHEN hold_type = \'F\' THEN 0 ELSE 1 END, selection_depth DESC, request_time,prev_check_time' } ) ]; - - # find all the holds holds needing first time targeting - push @$holds, action::hold_request->search( - capture_time => undef, - fulfillment_time => undef, - prev_check_time => undef, - frozen => 'f', - cancel_time => undef, - { order_by => 'CASE WHEN hold_type = \'F\' THEN 0 ELSE 1 END, selection_depth DESC, request_time' } ); - } else { - - # find all the holds holds needing first time targeting ONLY - $holds = [ action::hold_request->search( - capture_time => undef, - fulfillment_time => undef, - prev_check_time => undef, - cancel_time => undef, - frozen => 'f', - { order_by => 'CASE WHEN hold_type = \'F\' THEN 0 ELSE 1 END, selection_depth DESC, request_time' } ) ]; - } - } catch Error with { - my $e = shift; - die "Could not retrieve uncaptured hold requests:\n\n$e\n"; - }; - - my @closed = actor::org_unit::closed_date->search_where( - { close_start => { '<=', 'now' }, - close_end => { '>=', 'now' } } - ); - - if ($check_expire) { - - # $check_expire, if it exists, was already converted to seconds - my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time() + $check_expire); - $year += 1900; - $mon += 1; - - my $next_check_time = sprintf( - '%s-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d-00', - $year, $mon, $mday, $hour, $min, $sec - ); - - - my @closed_at_next = actor::org_unit::closed_date->search_where( - { close_start => { '<=', $next_check_time }, - close_end => { '>=', $next_check_time } } - ); - - my @new_closed; - for my $c_at_n (@closed_at_next) { - if (grep { ''.$_->org_unit eq ''.$c_at_n->org_unit } @closed) { - push @new_closed, $c_at_n; - } - } - @closed = @new_closed; - } - - my @successes; - my $actor = OpenSRF::AppSession->create('open-ils.actor'); - - for my $hold (@$holds) { - try { - #start a transaction if needed - if ($self->method_lookup('open-ils.storage.transaction.current')->run) { - $log->debug("Cleaning up after previous transaction\n"); - $self->method_lookup('open-ils.storage.transaction.rollback')->run; - } - $self->method_lookup('open-ils.storage.transaction.begin')->run( $client ); - $log->info("Processing hold ".$hold->id."...\n"); - - #first, re-fetch the hold, to make sure it's not captured already - $hold->remove_from_object_index(); - $hold = action::hold_request->retrieve( $hold->id ); - - die "OK\n" if (!$hold or $hold->capture_time or $hold->cancel_time); - - # remove old auto-targeting maps - my @oldmaps = action::hold_copy_map->search( hold => $hold->id ); - $_->delete for (@oldmaps); - - if ($hold->expire_time) { - my $ex_time = $parser->parse_datetime( cleanse_ISO8601( $hold->expire_time ) ); - if ( DateTime->compare($ex_time, DateTime->now) < 0 ) { - - # cancel cause = un-targeted expiration - $hold->update( { cancel_time => 'now', cancel_cause => 1 } ); - $self->method_lookup('open-ils.storage.transaction.commit')->run; - - # tell A/T the hold was cancelled - my $fm_hold = $hold->to_fieldmapper; - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - $ses->request('open-ils.trigger.event.autocreate', - 'hold_request.cancel.expire_no_target', $fm_hold, $fm_hold->pickup_lib); - - die "OK\n"; - } - } - - my $all_copies = []; - - # find filters for MR holds - my ($types, $formats, $lang); - if (defined($hold->holdable_formats)) { - ($types, $formats, $lang) = split '-', $hold->holdable_formats; - } - - # find all the potential copies - if ($hold->hold_type eq 'M') { - for my $r ( map - {$_->record} - metabib::record_descriptor - ->search( - record => [ - map { - isTrue($_->deleted) ? () : ($_->id) - } metabib::metarecord->retrieve($hold->target)->source_records - ], - ( $types ? (item_type => [split '', $types]) : () ), - ( $formats ? (item_form => [split '', $formats]) : () ), - ( $lang ? (item_lang => $lang) : () ), - ) - ) { - my ($rtree) = $self - ->method_lookup( 'open-ils.storage.biblio.record_entry.ranged_tree') - ->run( $r->id, $hold->selection_ou, $hold->selection_depth ); - - for my $cn ( @{ $rtree->call_numbers } ) { - push @$all_copies, - asset::copy->search_where( - { id => [map {$_->id} @{ $cn->copies }], - deleted => 'f' } - ) if ($cn && @{ $cn->copies }); - } - } - } elsif ($hold->hold_type eq 'T') { - my ($rtree) = $self - ->method_lookup( 'open-ils.storage.biblio.record_entry.ranged_tree') - ->run( $hold->target, $hold->selection_ou, $hold->selection_depth ); - - unless ($rtree) { - push @successes, { hold => $hold->id, eligible_copies => 0, error => 'NO_RECORD' }; - die "OK\n"; - } - - for my $cn ( @{ $rtree->call_numbers } ) { - push @$all_copies, - asset::copy->search_where( - { id => [map {$_->id} @{ $cn->copies }], - deleted => 'f' } - ) if ($cn && @{ $cn->copies }); - } - } elsif ($hold->hold_type eq 'V') { - my ($vtree) = $self - ->method_lookup( 'open-ils.storage.asset.call_number.ranged_tree') - ->run( $hold->target, $hold->selection_ou, $hold->selection_depth ); - - push @$all_copies, - asset::copy->search_where( - { id => [map {$_->id} @{ $vtree->copies }], - deleted => 'f' } - ) if ($vtree && @{ $vtree->copies }); - - } elsif ($hold->hold_type eq 'I') { - my ($itree) = $self - ->method_lookup( 'open-ils.storage.serial.issuance.ranged_tree') - ->run( $hold->target, $hold->selection_ou, $hold->selection_depth ); - - push @$all_copies, - asset::copy->search_where( - { id => [map {$_->unit->id} @{ $itree->items }], - deleted => 'f' } - ) if ($itree && @{ $itree->items }); - - } elsif ($hold->hold_type eq 'C' || $hold->hold_type eq 'R' || $hold->hold_type eq 'F') { - my $_cp = asset::copy->retrieve($hold->target); - push @$all_copies, $_cp if $_cp; - } - - # trim unholdables - @$all_copies = grep { isTrue($_->status->holdable) && - isTrue($_->location->holdable) && - isTrue($_->holdable) && - !isTrue($_->deleted) && - isTrue($hold->mint_condition) ? isTrue($_->mint_condition) : 1 - } @$all_copies; - - # let 'em know we're still working - $client->status( new OpenSRF::DomainObject::oilsContinueStatus ); - - # if we have no copies ... - if (!ref $all_copies || !@$all_copies) { - $log->info("\tNo copies available for targeting at all!\n"); - push @successes, { hold => $hold->id, eligible_copies => 0, error => 'NO_COPIES' }; - - $hold->update( { prev_check_time => 'today', current_copy => undef } ); - $self->method_lookup('open-ils.storage.transaction.commit')->run; - die "OK\n"; - } - - my $copy_count = @$all_copies; - - # map the potentials, so that we can pick up checkins - # XXX Loop-based targeting may require that /only/ copies from this loop should be added to - # XXX the potentials list. If this is the cased, hold_copy_map creation will move down further. - $log->debug( "\tMapping ".scalar(@$all_copies)." potential copies for hold ".$hold->id); - action::hold_copy_map->create( { hold => $hold->id, target_copy => $_->id } ) for (@$all_copies); - - #$client->status( new OpenSRF::DomainObject::oilsContinueStatus ); - - my @good_copies; - for my $c (@$all_copies) { - # current target - next if ($c->id eq $hold->current_copy); - - # circ lib is closed - next if ( grep { ''.$_->org_unit eq ''.$c->circ_lib } @closed ); - - # target of another hold - next if (action::hold_request - ->search_where( - { current_copy => $c->id, - fulfillment_time => undef, - cancel_time => undef, - } - ) - ); - - # we passed all three, keep it - push @good_copies, $c if ($c); - #$client->status( new OpenSRF::DomainObject::oilsContinueStatus ); - } - - $log->debug("\t".scalar(@good_copies)." (non-current) copies available for targeting..."); - - my $old_best = $hold->current_copy; - $hold->update({ current_copy => undef }) if ($old_best); - - if (!scalar(@good_copies)) { - $log->info("\tNo (non-current) copies eligible to fill the hold."); - if ( $old_best && grep { ''.$old_best->id eq ''.$_->id } @$all_copies ) { - # the old copy is still available - $log->debug("\tPushing current_copy back onto the targeting list"); - push @good_copies, $old_best; - } else { - # oops, old copy is not available - $log->debug("\tcurrent_copy is no longer available for targeting... NEXT HOLD, PLEASE!"); - $hold->update( { prev_check_time => 'today' } ); - $self->method_lookup('open-ils.storage.transaction.commit')->run; - push @successes, { hold => $hold->id, eligible_copies => 0, error => 'NO_TARGETS' }; - die "OK\n"; - } - } - - my $pu_lib = ''.$hold->pickup_lib; - - my $prox_list = []; - $$prox_list[0] = - [ - grep { - ''.$_->circ_lib eq $pu_lib && - ( $_->status == 0 || $_->status == 7 ) - } @good_copies - ]; - - $all_copies = [grep { $_->status == 0 || $_->status == 7 } grep {''.$_->circ_lib ne $pu_lib } @good_copies]; - # $all_copies is now a list of copies not at the pickup library - - my $best = choose_nearest_copy($hold, $prox_list); - $client->status( new OpenSRF::DomainObject::oilsContinueStatus ); - - if (!$best) { - $log->debug("\tNothing at the pickup lib, looking elsewhere among ".scalar(@$all_copies)." copies"); - - $self->{max_loops}{$pu_lib} = $actor->request( - 'open-ils.actor.ou_setting.ancestor_default' => $pu_lib => 'circ.holds.max_org_unit_target_loops' - )->gather(1); - - if (defined($self->{max_loops}{$pu_lib})) { - $self->{max_loops}{$pu_lib} = $self->{max_loops}{$pu_lib}{value}; - - my %circ_lib_map = map { (''.$_->circ_lib => 1) } @$all_copies; - my $circ_lib_list = [keys %circ_lib_map]; - - my $cstore = OpenSRF::AppSession->create('open-ils.cstore'); - - # Grab the "biggest" loop for this hold so far - my $current_loop = $cstore->request( - 'open-ils.cstore.json_query', - { distinct => 1, - select => { aufhmxl => ['max'] }, - from => 'aufhmxl', - where => { hold => $hold->id} - } - )->gather(1); - - $current_loop = $current_loop->{max} if ($current_loop); - $current_loop ||= 1; - - my $exclude_list = $cstore->request( - 'open-ils.cstore.json_query.atomic', - { distinct => 1, - select => { aufhol => ['circ_lib'] }, - from => 'aufhol', - where => { hold => $hold->id} - } - )->gather(1); - - my @keepers; - if ($exclude_list && @$exclude_list) { - $exclude_list = [map {$_->{circ_lib}} @$exclude_list]; - # check to see if we've used up every library in the potentials list - for my $l ( @$circ_lib_list ) { - my $keep = 1; - for my $ex ( @$exclude_list ) { - if ($ex eq $l) { - $keep = 0; - last; - } - } - push(@keepers, $l) if ($keep); - } - } else { - @keepers = @$circ_lib_list; - } - - $current_loop++ if (!@keepers); - - if ($self->{max_loops}{$pu_lib} && $self->{max_loops}{$pu_lib} >= $current_loop) { - # We haven't exceeded max_loops yet - my @keeper_copies; - for my $cp ( @$all_copies ) { - push(@keeper_copies, $cp) if ( grep { $_ eq ''.$cp->circ_lib } @keepers ); - } - $all_copies = [@keeper_copies]; - } else { - # We have, and should remove potentials and cancel the hold - my @oldmaps = action::hold_copy_map->search( hold => $hold->id ); - $_->delete for (@oldmaps); - - # cancel cause = un-targeted expiration - $hold->update( { cancel_time => 'now', cancel_cause => 1 } ); - $self->method_lookup('open-ils.storage.transaction.commit')->run; - - # tell A/T the hold was cancelled - my $fm_hold = $hold->to_fieldmapper; - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - $ses->request('open-ils.trigger.event.autocreate', - 'hold_request.cancel.expire_no_target', $fm_hold, $fm_hold->pickup_lib); - - die "OK\n"; - } - } - - $prox_list = create_prox_list( $self, $pu_lib, $all_copies ); - - $client->status( new OpenSRF::DomainObject::oilsContinueStatus ); - - $best = choose_nearest_copy($hold, $prox_list); - } - - $client->status( new OpenSRF::DomainObject::oilsContinueStatus ); - if ($old_best) { - # hold wasn't fulfilled, record the fact - - $log->info("\tHold was not (but should have been) fulfilled by ".$old_best->id); - action::unfulfilled_hold_list->create( - { hold => ''.$hold->id, - current_copy => ''.$old_best->id, - circ_lib => ''.$old_best->circ_lib, - }); - } - - if ($best) { - $hold->update( { current_copy => ''.$best->id, prev_check_time => 'now' } ); - $log->debug("\tUpdating hold [".$hold->id."] with new 'current_copy' [".$best->id."] for hold fulfillment."); - } elsif ( - $old_best && - !action::hold_request - ->search_where( - { current_copy => $old_best->id, - fulfillment_time => undef, - cancel_time => undef, - } - ) - ) { - $hold->update( { prev_check_time => 'now', current_copy => ''.$old_best->id } ); - $log->debug( "\tRetargeting the previously targeted copy [".$old_best->id."]" ); - } else { - $hold->update( { prev_check_time => 'now' } ); - $log->info( "\tThere were no targetable copies for the hold" ); - process_recall($actor, $log, $hold, \@good_copies); - } - - $self->method_lookup('open-ils.storage.transaction.commit')->run; - $log->info("\tProcessing of hold ".$hold->id." complete."); - - push @successes, - { hold => $hold->id, - old_target => ($old_best ? $old_best->id : undef), - eligible_copies => $copy_count, - target => ($best ? $best->id : undef) }; - - } otherwise { - my $e = shift; - if ($e !~ /^OK/o) { - $log->error("Processing of hold failed: $e"); - $self->method_lookup('open-ils.storage.transaction.rollback')->run; - throw $e if ($e =~ /IS NOT CONNECTED TO THE NETWORK/o); - } - }; - } - - return \@successes; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.action.hold_request.copy_targeter', - api_level => 1, - method => 'new_hold_copy_targeter', -); - -sub process_recall { - my ($actor, $log, $hold, $good_copies) = @_; - - # Bail early if we don't have required settings to avoid spurious requests - my ($recall_threshold, $return_interval, $fine_rules); - - my $rv = $actor->request( - 'open-ils.actor.ou_setting.ancestor_default', ''.$hold->pickup_lib, 'circ.holds.recall_threshold' - )->gather(1); - - if (!$rv) { - $log->info("Recall threshold was not set; bailing out on hold ".$hold->id." processing."); - return; - } - $recall_threshold = $rv->{value}; - - $rv = $actor->request( - 'open-ils.actor.ou_setting.ancestor_default', ''.$hold->pickup_lib, 'circ.holds.recall_return_interval' - )->gather(1); - - if (!$rv) { - $log->info("Recall return interval was not set; bailing out on hold ".$hold->id." processing."); - return; - } - $return_interval = $rv->{value}; - - $rv = $actor->request( - 'open-ils.actor.ou_setting.ancestor_default', ''.$hold->pickup_lib, 'circ.holds.recall_fine_rules' - )->gather(1); - - if ($rv) { - $fine_rules = $rv->{value}; - } - - $log->info("Recall threshold: $recall_threshold; return interval: $return_interval"); - - # We want checked out copies (status = 1) at the hold pickup lib - my $all_copies = [grep { $_->status == 1 } grep {''.$_->circ_lib eq ''.$hold->pickup_lib } @$good_copies]; - - my @copy_ids = map { $_->id } @$all_copies; - - $log->info("Found " . scalar(@$all_copies) . " eligible checked-out copies for recall"); - - my $return_date = DateTime->now(time_zone => 'local')->add(seconds => interval_to_seconds($return_interval))->iso8601(); - - # Iterate over the checked-out copies to find a copy with a - # loan period longer than the recall threshold: - my $circs = [ action::circulation->search_where( - { target_copy => \@copy_ids, checkin_time => undef, duration => { '>' => $recall_threshold } }, - { order_by => 'due_date ASC' } - )]; - - # If we have a candidate copy, then: - if (scalar(@$circs)) { - my $circ = $circs->[0]; - $log->info("Recalling circ ID : " . $circ->id); - - # Give the user a new due date of either a full recall threshold, - # or the return interval, whichever is further in the future - my $threshold_date = DateTime::Format::ISO8601->parse_datetime(cleanse_ISO8601($circ->xact_start))->add(seconds => interval_to_seconds($recall_threshold))->iso8601(); - if (DateTime->compare(DateTime::Format::ISO8601->parse_datetime($threshold_date), DateTime::Format::ISO8601->parse_datetime($return_date)) == 1) { - $return_date = $threshold_date; - } - - my $update_fields = { - due_date => $return_date, - renewal_remaining => 0, - }; - - # If the OU hasn't defined new fine rules for recalls, keep them - # as they were - if ($fine_rules) { - $log->info("Apply recall fine rules: $fine_rules"); - my $rules = OpenSRF::Utils::JSON->JSON2perl($fine_rules); - $update_fields->{recurring_fine} = $rules->[0]; - $update_fields->{fine_interval} = $rules->[1]; - $update_fields->{max_fine} = $rules->[2]; - } - - # Adjust circ for current user - $circ->update($update_fields); - - # Create trigger event for notifying current user - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - $ses->request('open-ils.trigger.event.autocreate', 'circ.recall.target', $circ->to_fieldmapper(), $circ->circ_lib->id); - } - - $log->info("Processing of hold ".$hold->id." for recall is now complete."); -} - -sub reservation_targeter { - my $self = shift; - my $client = shift; - my $one_reservation = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - my $reservations; - - try { - if ($one_reservation) { - $self->method_lookup('open-ils.storage.transaction.begin')->run( $client ); - $reservations = [ booking::reservation->search_where( { id => $one_reservation, capture_time => undef, cancel_time => undef } ) ]; - } else { - - # find all the reservations needing targeting - $reservations = [ - booking::reservation->search_where( - { current_resource => undef, - cancel_time => undef, - start_time => { '>' => 'now' } - }, - { order_by => 'start_time' } - ) - ]; - } - } catch Error with { - my $e = shift; - die "Could not retrieve reservation requests:\n\n$e\n"; - }; - - my @successes = (); - for my $bresv (@$reservations) { - try { - #start a transaction if needed - if ($self->method_lookup('open-ils.storage.transaction.current')->run) { - $log->debug("Cleaning up after previous transaction\n"); - $self->method_lookup('open-ils.storage.transaction.rollback')->run; - } - $self->method_lookup('open-ils.storage.transaction.begin')->run( $client ); - $log->info("Processing reservation ".$bresv->id."...\n"); - - #first, re-fetch the hold, to make sure it's not captured already - $bresv->remove_from_object_index(); - $bresv = booking::reservation->retrieve( $bresv->id ); - - die "OK\n" if (!$bresv or $bresv->capture_time or $bresv->cancel_time); - - my $end_time = $parser->parse_datetime( cleanse_ISO8601( $bresv->end_time ) ); - if (DateTime->compare($end_time, DateTime->now) < 0) { - - # cancel cause = un-targeted expiration - $bresv->update( { cancel_time => 'now' } ); - $self->method_lookup('open-ils.storage.transaction.commit')->run; - - # tell A/T the reservation was cancelled - my $fm_bresv = $bresv->to_fieldmapper; - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - $ses->request('open-ils.trigger.event.autocreate', - 'booking.reservation.cancel.expire_no_target', $fm_bresv, $fm_bresv->pickup_lib); - - die "OK\n"; - } - - my $possible_resources; - - # find all the potential resources - if (!$bresv->target_resource) { - my $filter = { type => $bresv->target_resource_type }; - my $attr_maps = [ booking::reservation_attr_value_map->search( reservation => $bresv->id) ]; - - $filter->{attribute_values} = [ map { $_->attr_value } @$attr_maps ] if (@$attr_maps); - - $filter->{available} = [$bresv->start_time, $bresv->end_time]; - my $ses = OpenSRF::AppSession->create('open-ils.booking'); - $possible_resources = $ses->request('open-ils.booking.resources.filtered_id_list', undef, $filter)->gather(1); - } else { - $possible_resources = $bresv->target_resource; - } - - my $all_resources = [ booking::resource->search( id => $possible_resources ) ]; - @$all_resources = grep { isTrue($_->type->transferable) || $_->owner.'' eq $bresv->pickup_lib.'' } @$all_resources; - - - my @good_resources = (); - my %conflicts = (); - for my $res (@$all_resources) { - unless (isTrue($res->type->catalog_item)) { - push @good_resources, $res; - next; - } - - my $copy = [ asset::copy->search( deleted => 'f', barcode => $res->barcode )]->[0]; - - unless ($copy) { - push @good_resources, $res; - next; - } - - if ($copy->status->id == 0 || $copy->status->id == 7) { - push @good_resources, $res; - next; - } - - if ($copy->status->id == 1) { - my $circs = [ action::circulation->search_where( - {target_copy => $copy->id, checkin_time => undef }, - { order_by => 'id DESC' } - ) ]; - - if (@$circs) { - my $due_date = $circs->[0]->due_date; - $due_date = $parser->parse_datetime( cleanse_ISO8601( $due_date ) ); - my $start_time = $parser->parse_datetime( cleanse_ISO8601( $bresv->start_time ) ); - if (DateTime->compare($start_time, $due_date) < 0) { - $conflicts{$res->id} = $circs->[0]->to_fieldmapper; - next; - } - - push @good_resources, $res; - } - - next; - } - - push @good_resources, $res if (isTrue($copy->status->holdable)); - } - - # let 'em know we're still working - $client->status( new OpenSRF::DomainObject::oilsContinueStatus ); - - # if we have no copies ... - if (!@good_resources) { - $log->info("\tNo resources available for targeting at all!\n"); - push @successes, { reservation => $bresv->id, eligible_copies => 0, error => 'NO_COPIES', conflicts => \%conflicts }; - - - $self->method_lookup('open-ils.storage.transaction.commit')->run; - die "OK\n"; - } - - $log->debug("\t".scalar(@good_resources)." resources available for targeting..."); - - my $prox_list = []; - $$prox_list[0] = - [ - grep { - $_->owner == $bresv->pickup_lib - } @good_resources - ]; - - $all_resources = [grep {$_->owner != $bresv->pickup_lib } @good_resources]; - # $all_copies is now a list of copies not at the pickup library - - my $best = shift @good_resources; - $client->status( new OpenSRF::DomainObject::oilsContinueStatus ); - - if (!$best) { - $log->debug("\tNothing at the pickup lib, looking elsewhere among ".scalar(@$all_resources)." resources"); - - $prox_list = - map { $_->[1] } - sort { $a->[0] <=> $b->[0] } - map { - [ actor::org_unit_proximity->search_where( - { from_org => $bresv->pickup_lib.'', to_org => $_->owner.'' } - )->[0]->prox, - $_ - ] - } @$all_resources; - - $client->status( new OpenSRF::DomainObject::oilsContinueStatus ); - - $best = shift @$prox_list - } - - if ($best) { - $bresv->update( { current_resource => ''.$best->id } ); - $log->debug("\tUpdating reservation [".$bresv->id."] with new 'current_resource' [".$best->id."] for reservation fulfillment."); - } - - $self->method_lookup('open-ils.storage.transaction.commit')->run; - $log->info("\tProcessing of bresv ".$bresv->id." complete."); - - push @successes, - { reservation => $bresv->id, - current_resource => ($best ? $best->id : undef) }; - - } otherwise { - my $e = shift; - if ($e !~ /^OK/o) { - $log->error("Processing of bresv failed: $e"); - $self->method_lookup('open-ils.storage.transaction.rollback')->run; - throw $e if ($e =~ /IS NOT CONNECTED TO THE NETWORK/o); - } - }; - } - - return \@successes; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.booking.reservation.resource_targeter', - api_level => 1, - method => 'reservation_targeter', -); - -my $locations; -my $statuses; -my %cache = (titles => {}, cns => {}); - -sub copy_hold_capture { - my $self = shift; - my $hold = shift; - my $cps = shift; - - if (!defined($cps)) { - try { - $cps = [ asset::copy->search( id => $hold->target ) ]; - } catch Error with { - my $e = shift; - die "Could not retrieve initial volume list:\n\n$e\n"; - }; - } - - my @copies = grep { $_->holdable } @$cps; - - for (my $i = 0; $i < @$cps; $i++) { - next unless $$cps[$i]; - - my $cn = $cache{cns}{$copies[$i]->call_number}; - my $rec = $cache{titles}{$cn->record}; - $copies[$i] = undef if ($copies[$i] && !grep{ $copies[$i]->status eq $_->id}@$statuses); - $copies[$i] = undef if ($copies[$i] && !grep{ $copies[$i]->location eq $_->id}@$locations); - $copies[$i] = undef if ( - !$copies[$i] || - !$self->{user_filter}->request( - 'open-ils.circ.permit_hold', - $hold->to_fieldmapper, do { - my $cp_fm = $copies[$i]->to_fieldmapper; - $cp_fm->circ_lib( $copies[$i]->circ_lib->to_fieldmapper ); - $cp_fm->location( $copies[$i]->location->to_fieldmapper ); - $cp_fm->status( $copies[$i]->status->to_fieldmapper ); - $cp_fm; - }, - { title => $rec->to_fieldmapper, - usr => actor::user->retrieve($hold->usr)->to_fieldmapper, - requestor => actor::user->retrieve($hold->requestor)->to_fieldmapper, - })->gather(1) - ); - $self->{client}->status( new OpenSRF::DomainObject::oilsContinueStatus ); - } - - @copies = grep { $_ } @copies; - - my $count = @copies; - - return unless ($count); - - action::hold_copy_map->search( hold => $hold->id )->delete_all; - - my @maps; - $self->{client}->respond( "\tMapping ".scalar(@copies)." eligable copies for hold ".$hold->id."\n"); - for my $c (@copies) { - push @maps, action::hold_copy_map->create( { hold => $hold->id, target_copy => $c->id } ); - } - $self->{client}->respond( "\tA total of ".scalar(@maps)." mapping were created for hold ".$hold->id."\n"); - - return \@copies; -} - - -sub choose_nearest_copy { - my $hold = shift; - my $prox_list = shift; - - for my $p ( 0 .. int( scalar(@$prox_list) - 1) ) { - next unless (ref $$prox_list[$p]); - - my @capturable = @{ $$prox_list[$p] }; - next unless (@capturable); - - my $rand = int(rand(scalar(@capturable))); - my %seen = (); - while (my ($c) = splice(@capturable, $rand, 1)) { - return $c if !exists($seen{$c->id}) && ( OpenILS::Utils::PermitHold::permit_copy_hold( - { title => $c->call_number->record->to_fieldmapper, - title_descriptor => $c->call_number->record->record_descriptor->next->to_fieldmapper, - patron => $hold->usr->to_fieldmapper, - copy => $c->to_fieldmapper, - requestor => $hold->requestor->to_fieldmapper, - request_lib => $hold->request_lib->to_fieldmapper, - pickup_lib => $hold->pickup_lib->id, - retarget => 1 - } - )); - $seen{$c->id}++; - - last unless(@capturable); - $rand = int(rand(scalar(@capturable))); - } - } -} - -sub create_prox_list { - my $self = shift; - my $lib = shift; - my $copies = shift; - - my $actor = OpenSRF::AppSession->create('open-ils.actor'); - - my @prox_list; - for my $cp (@$copies) { - my ($prox) = $self->method_lookup('open-ils.storage.asset.copy.proximity')->run( $cp, $lib ); - next unless (defined($prox)); - - my $copy_circ_lib = ''.$cp->circ_lib; - # Fetch the weighting value for hold targeting, defaulting to 1 - $self->{target_weight}{$copy_circ_lib} ||= $actor->request( - 'open-ils.actor.ou_setting.ancestor_default' => $copy_circ_lib.'' => 'circ.holds.org_unit_target_weight' - )->gather(1); - $self->{target_weight}{$copy_circ_lib} = $self->{target_weight}{$copy_circ_lib}{value} if (ref $self->{target_weight}{$copy_circ_lib}); - $self->{target_weight}{$copy_circ_lib} ||= 1; - - $prox_list[$prox] = [] unless defined($prox_list[$prox]); - for my $w ( 1 .. $self->{target_weight}{$copy_circ_lib} ) { - push @{$prox_list[$prox]}, $cp; - } - } - return \@prox_list; -} - -sub volume_hold_capture { - my $self = shift; - my $hold = shift; - my $vols = shift; - - if (!defined($vols)) { - try { - $vols = [ asset::call_number->search( id => $hold->target ) ]; - $cache{cns}{$_->id} = $_ for (@$vols); - } catch Error with { - my $e = shift; - die "Could not retrieve initial volume list:\n\n$e\n"; - }; - } - - my @v_ids = map { $_->id } @$vols; - - my $cp_list; - try { - $cp_list = [ asset::copy->search( call_number => \@v_ids ) ]; - - } catch Error with { - my $e = shift; - warn "Could not retrieve copy list:\n\n$e\n"; - }; - - $self->copy_hold_capture($hold,$cp_list) if (ref $cp_list and @$cp_list); -} - -sub title_hold_capture { - my $self = shift; - my $hold = shift; - my $titles = shift; - - if (!defined($titles)) { - try { - $titles = [ biblio::record_entry->search( id => $hold->target ) ]; - $cache{titles}{$_->id} = $_ for (@$titles); - } catch Error with { - my $e = shift; - die "Could not retrieve initial title list:\n\n$e\n"; - }; - } - - my @t_ids = map { $_->id } @$titles; - my $cn_list; - try { - ($cn_list) = $self->method_lookup('open-ils.storage.direct.asset.call_number.search.record.atomic')->run( \@t_ids ); - - } catch Error with { - my $e = shift; - warn "Could not retrieve volume list:\n\n$e\n"; - }; - - $cache{cns}{$_->id} = $_ for (@$cn_list); - - $self->volume_hold_capture($hold,$cn_list) if (ref $cn_list and @$cn_list); -} - -sub metarecord_hold_capture { - my $self = shift; - my $hold = shift; - - my $titles; - try { - $titles = [ metabib::metarecord_source_map->search( metarecord => $hold->target) ]; - - } catch Error with { - my $e = shift; - die "Could not retrieve initial title list:\n\n$e\n"; - }; - - try { - my @recs = map {$_->record} metabib::record_descriptor->search( record => $titles, item_type => [split '', $hold->holdable_formats] ); - - $titles = [ biblio::record_entry->search( id => \@recs ) ]; - - } catch Error with { - my $e = shift; - die "Could not retrieve format-pruned title list:\n\n$e\n"; - }; - - - $cache{titles}{$_->id} = $_ for (@$titles); - $self->title_hold_capture($hold,$titles) if (ref $titles and @$titles); -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/actor.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/actor.pm deleted file mode 100644 index 22362cf53c..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/actor.pm +++ /dev/null @@ -1,1031 +0,0 @@ -package OpenILS::Application::Storage::Publisher::actor; -use base qw/OpenILS::Application::Storage/; -use OpenILS::Application::Storage::CDBI::actor; -use OpenSRF::Utils::Logger qw/:level/; -use OpenSRF::Utils qw/:datetime/; -use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::SettingsClient; - -use DateTime; -use DateTime::Format::ISO8601; -use DateTime::Set; -use DateTime::SpanSet; - - -my $_dt_parser = DateTime::Format::ISO8601->new; - -my $log = 'OpenSRF::Utils::Logger'; - -sub new_usergroup_id { - return actor::user->db_Main->selectrow_array("select nextval('actor.usr_usrgroup_seq'::regclass)"); -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.user.group_id.new', - api_level => 1, - method => 'new_usergroup_id', -); - -sub juv_to_adult { - my $self = shift; - my $client = shift; - my $adult_age = shift; - - my $sql = <<" SQL"; - UPDATE actor.usr - SET juvenile = FALSE - WHERE AGE(dob) > ?::INTERVAL; - SQL - - my $sth = actor::user->db_Main->prepare_cached($sql); - $sth->execute($adult_age); - - return $sth->rows; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.user.juvenile_to_adult', - api_level => 1, - method => 'juv_to_adult', -); - -sub usr_total_owed { - my $self = shift; - my $client = shift; - my $usr = shift; - - my $sql = <<" SQL"; - SELECT x.usr, - SUM(COALESCE((SELECT SUM(b.amount) FROM money.billing b WHERE b.voided IS FALSE AND b.xact = x.id),0.0)) - - SUM(COALESCE((SELECT SUM(p.amount) FROM money.payment p WHERE p.voided IS FALSE AND p.xact = x.id),0.0)) - FROM money.billable_xact x - WHERE x.usr = ? AND x.xact_finish IS NULL - GROUP BY 1 - SQL - - my (undef,$val) = actor::user->db_Main->selectrow_array($sql, {}, $usr); - - return $val; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.user.total_owed', - api_level => 1, - method => 'usr_total_owed', -); - -sub usr_breakdown_out { - my $self = shift; - my $client = shift; - my $usr = shift; - - $self->method_lookup('open-ils.storage.transaction.begin')->run($client); - - my $out_sql = <<" SQL"; - SELECT id - FROM action.circulation - WHERE usr = ? - AND checkin_time IS NULL - AND ( (fine_interval >= '1 day' AND due_date >= 'today') - OR (fine_interval < '1 day' AND due_date > 'now' )) - AND (stop_fines IS NULL - OR stop_fines NOT IN ('LOST','CLAIMSRETURNED','LONGOVERDUE')) - SQL - - my $out = actor::user->db_Main->selectcol_arrayref($out_sql, {}, $usr); - - my $od_sql = <<" SQL"; - SELECT id - FROM action.circulation - WHERE usr = ? - AND checkin_time IS NULL - AND ( (fine_interval >= '1 day' AND due_date < 'today') - OR (fine_interval < '1 day' AND due_date < 'now' )) - AND (stop_fines IS NULL - OR stop_fines NOT IN ('LOST','CLAIMSRETURNED','LONGOVERDUE')) - SQL - - my $od = actor::user->db_Main->selectcol_arrayref($od_sql, {}, $usr); - - my $lost_sql = <<" SQL"; - SELECT id - FROM action.circulation - WHERE usr = ? AND checkin_time IS NULL AND xact_finish IS NULL AND stop_fines = 'LOST' - SQL - - my $lost = actor::user->db_Main->selectcol_arrayref($lost_sql, {}, $usr); - - my $cl_sql = <<" SQL"; - SELECT id - FROM action.circulation - WHERE usr = ? AND checkin_time IS NULL AND stop_fines = 'CLAIMSRETURNED' - SQL - - my $cl = actor::user->db_Main->selectcol_arrayref($cl_sql, {}, $usr); - - my $lo_sql = <<" SQL"; - SELECT id - FROM action.circulation - WHERE usr = ? AND checkin_time IS NULL AND stop_fines = 'LONGOVERDUE' - SQL - - my $lo = actor::user->db_Main->selectcol_arrayref($lo_sql, {}, $usr); - - $self->method_lookup('open-ils.storage.transaction.rollback')->run($client); - - if ($self->api_name =~/count$/o) { - return { total => scalar(@$out) + scalar(@$od) + scalar(@$lost) + scalar(@$cl) + scalar(@$lo), - out => scalar(@$out), - overdue => scalar(@$od), - lost => scalar(@$lost), - claims_returned => scalar(@$cl), - long_overdue => scalar(@$lo), - }; - } - - return { out => $out, - overdue => $od, - lost => $lost, - claims_returned => $cl, - long_overdue => $lo, - }; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.user.checked_out', - api_level => 1, - method => 'usr_breakdown_out', -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.user.checked_out.count', - api_level => 1, - method => 'usr_breakdown_out', -); - -sub usr_total_out { - my $self = shift; - my $client = shift; - my $usr = shift; - - my $sql = <<" SQL"; - SELECT count(*) - FROM action.circulation - WHERE usr = ? AND checkin_time IS NULL - SQL - - my ($val) = actor::user->db_Main->selectrow_array($sql, {}, $usr); - - return $val; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.user.total_out', - api_level => 1, - method => 'usr_total_out', -); - -sub calc_proximity { - my $self = shift; - my $client = shift; - - local $OpenILS::Application::Storage::WRITE = 1; - - my $delete_sql = <<" SQL"; - DELETE FROM actor.org_unit_proximity; - SQL - - my $insert_sql = <<" SQL"; - INSERT INTO actor.org_unit_proximity (from_org, to_org, prox) - SELECT l.id, - r.id, - actor.org_unit_proximity(l.id,r.id) - FROM actor.org_unit l, - actor.org_unit r; - SQL - - actor::org_unit_proximity->db_Main->do($delete_sql); - actor::org_unit_proximity->db_Main->do($insert_sql); - - return 1; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.org_unit.refresh_proximity', - api_level => 1, - method => 'calc_proximity', -); - -sub make_hoo_spanset { - my $hoo = shift; - return undef unless $hoo; - - my $today = shift || DateTime->now; - - my $tz = OpenSRF::AppSession->create('open-ils.actor')->request( - 'open-ils.actor.ou_setting.ancestor_default' => $hoo->id.'' => 'org_unit.timezone' - )->gather(1) || DateTime::TimeZone->new( name => 'local' )->name; - - my $current_dow = $today->day_of_week_0; - - my $spanset = DateTime::SpanSet->empty_set; - for my $d ( 0 .. 6 ) { - - my $omethod = 'dow_'.$d.'_open'; - my $cmethod = 'dow_'.$d.'_close'; - - my $open = interval_to_seconds($hoo->$omethod()); - my $close = interval_to_seconds($hoo->$cmethod()); - - next if ($open == $close && $open == 0); - - my $dow_offset = ($d - $current_dow) * $one_day; - $close += $one_day if ($close <= $open); - - $spanset = $spanset->union( - DateTime::Span->new( - start => $today->clone->add( seconds => $dow_offset + $open ), - end => $today->clone->add( seconds => $dow_offset + $close ) - ) - ); - } - - return $spanset->complement; -} - -sub make_closure_spanset { - my $closures = shift; - return undef unless $closures; - - my $spanset = DateTime::SpanSet->empty_set; - for my $k ( keys %$closures ) { - my $c = $$closures{$k}; - - $spanset = $spanset->union( - DateTime::Span->new( - start => $_dt_parser->parse_datetime(cleanse_ISO8601($c->{close_start})), - end => $_dt_parser->parse_datetime(cleanse_ISO8601($c->{close_end})) - ) - ); - } - - return $spanset; -} - -sub new_org_closed_overlap { - my $self = shift; - my $client = shift; - my $ou = shift; - my $date = shift; - my $direction = shift || 0; - my $no_hoo = shift || 0; - - return undef unless ($date && $ou); - - # we're given a date and a direction, find any closures that contain the date - my $t = actor::org_unit::closed_date->table; - my $sql = <<" SQL"; - SELECT * - FROM $t - WHERE close_end > ? - AND org_unit = ? - ORDER BY close_start ASC, close_end DESC - LIMIT 1 - SQL - - $date = cleanse_ISO8601($date); - - my $target_date = $_dt_parser->parse_datetime( $date ); - my ($begin, $end) = ($target_date, $target_date); - - # create a spanset from the closures that contain the $date - my $closure_spanset = make_closure_spanset( - actor::org_unit::closed_date->db_Main->selectall_hashref( $sql, 'id', {}, $date, $ou ) - ); - - if ($closure_spanset && $closure_spanset->intersects( $target_date )) { - my $closure_intersection = $closure_spanset->intersection( $target_date ); - $begin = $closure_intersection->min; - $end = $closure_intersection->max; - - if ( $direction <= 0 ) { - $begin->subtract( minutes => 1 ); - - while ( my $_b = new_org_closed_overlap($self, $client, $ou, $begin->strftime('%FT%T%z'), -1, 1 ) ) { - $begin = $_dt_parser->parse_datetime( cleanse_ISO8601($_b->{start}) ); - } - } - - if ( $direction >= 0 ) { - $end->add( minutes => 1 ); - - while ( my $_a = new_org_closed_overlap($self, $client, $ou, $end->strftime('%FT%T%z'), 1, 1 ) ) { - $end = $_dt_parser->parse_datetime( cleanse_ISO8601($_a->{end}) ); - } - } - } - - if ( !$no_hoo ) { - - my $begin_hoo = make_hoo_spanset(actor::org_unit::hours_of_operation->retrieve($ou), $begin); - my $end_hoo = make_hoo_spanset(actor::org_unit::hours_of_operation->retrieve($ou), $end ); - - - if ( $begin_hoo && $direction <= 0 && $begin_hoo->intersects($begin) ) { - my $hoo_intersection = $begin_hoo->intersection( $begin ); - $begin = $hoo_intersection->min; - $begin->subtract( minutes => 1 ); - - while ( my $_b = new_org_closed_overlap($self, $client, $ou, $begin->strftime('%FT%T%z'), -1 ) ) { - $begin = $_dt_parser->parse_datetime( cleanse_ISO8601($_b->{start}) ); - } - } - - if ( $end_hoo && $direction >= 0 && $end_hoo->intersects($end) ) { - my $hoo_intersection = $end_hoo->intersection( $end ); - $end = $hoo_intersection->max; - $end->add( minutes => 1 ); - - - while ( my $_b = new_org_closed_overlap($self, $client, $ou, $end->strftime('%FT%T%z'), -1 ) ) { - $end = $_dt_parser->parse_datetime( cleanse_ISO8601($_b->{end}) ); - } - } - } - - my $start = $begin->strftime('%FT%T%z'); - my $stop = $end->strftime('%FT%T%z'); - - return undef if ($start eq $stop); - return { start => $start, end => $stop }; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.org_unit.closed_date.overlap', - api_level => 0, - method => 'new_org_closed_overlap', -); - -sub org_closed_overlap { - my $self = shift; - my $client = shift; - my $ou = shift; - my $date = shift; - my $direction = shift || 0; - my $no_hoo = shift || 0; - - return undef unless ($date && $ou); - - my $t = actor::org_unit::closed_date->table; - my $sql = <<" SQL"; - SELECT * - FROM $t - WHERE ? between close_start and close_end - AND org_unit = ? - ORDER BY close_start ASC, close_end DESC - LIMIT 1 - SQL - - $date = cleanse_ISO8601($date); - my ($begin, $end) = ($date,$date); - - my $hoo = actor::org_unit::hours_of_operation->retrieve($ou); - - if (my $closure = actor::org_unit::closed_date->db_Main->selectrow_hashref( $sql, {}, $date, $ou )) { - $begin = cleanse_ISO8601($closure->{close_start}); - $end = cleanse_ISO8601($closure->{close_end}); - - if ( $direction <= 0 ) { - $before = $_dt_parser->parse_datetime( $begin ); - $before->subtract( minutes => 1 ); - - while ( my $_b = org_closed_overlap($self, $client, $ou, $before->strftime('%FT%T%z'), -1, 1 ) ) { - $before = $_dt_parser->parse_datetime( cleanse_ISO8601($_b->{start}) ); - } - $begin = cleanse_ISO8601($before->strftime('%FT%T%z')); - } - - if ( $direction >= 0 ) { - $after = $_dt_parser->parse_datetime( $end ); - $after->add( minutes => 1 ); - - while ( my $_a = org_closed_overlap($self, $client, $ou, $after->strftime('%FT%T%z'), 1, 1 ) ) { - $after = $_dt_parser->parse_datetime( cleanse_ISO8601($_a->{end}) ); - } - $end = cleanse_ISO8601($after->strftime('%FT%T%z')); - } - } - - if ( !$no_hoo ) { - if ( $hoo ) { - - if ( $direction <= 0 ) { - my $begin_dow = $_dt_parser->parse_datetime( $begin )->day_of_week_0; - my $begin_open_meth = "dow_".$begin_dow."_open"; - my $begin_close_meth = "dow_".$begin_dow."_close"; - - my $count = 1; - while ($hoo->$begin_open_meth eq '00:00:00' and $hoo->$begin_close_meth eq '00:00:00') { - $begin = cleanse_ISO8601($_dt_parser->parse_datetime( $begin )->subtract( days => 1)->strftime('%FT%T%z')); - $begin_dow++; - $begin_dow %= 7; - $count++; - last if ($count > 6); - $begin_open_meth = "dow_".$begin_dow."_open"; - $begin_close_meth = "dow_".$begin_dow."_close"; - } - - if (my $closure = actor::org_unit::closed_date->db_Main->selectrow_hashref( $sql, {}, $begin, $ou )) { - $before = $_dt_parser->parse_datetime( $begin ); - $before->subtract( minutes => 1 ); - while ( my $_b = org_closed_overlap($self, $client, $ou, $before->strftime('%FT%T%z'), -1 ) ) { - $before = $_dt_parser->parse_datetime( cleanse_ISO8601($_b->{start}) ); - } - } - } - - if ( $direction >= 0 ) { - my $end_dow = $_dt_parser->parse_datetime( $end )->day_of_week_0; - my $end_open_meth = "dow_".$end_dow."_open"; - my $end_close_meth = "dow_".$end_dow."_close"; - - $count = 1; - while ($hoo->$end_open_meth eq '00:00:00' and $hoo->$end_close_meth eq '00:00:00') { - $end = cleanse_ISO8601($_dt_parser->parse_datetime( $end )->add( days => 1)->strftime('%FT%T%z')); - $end_dow++; - $end_dow %= 7; - $count++; - last if ($count > 6); - $end_open_meth = "dow_".$end_dow."_open"; - $end_close_meth = "dow_".$end_dow."_close"; - } - - if (my $closure = actor::org_unit::closed_date->db_Main->selectrow_hashref( $sql, {}, $end, $ou )) { - $after = $_dt_parser->parse_datetime( $end ); - $after->add( minutes => 1 ); - - while ( my $_a = org_closed_overlap($self, $client, $ou, $after->strftime('%FT%T%z'), 1 ) ) { - $after = $_dt_parser->parse_datetime( cleanse_ISO8601($_a->{end}) ); - } - $end = cleanse_ISO8601($after->strftime('%FT%T%z')); - } - } - - } - } - - if ($begin eq $date && $end eq $date) { - return undef; - } - - return { start => $begin, end => $end }; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.org_unit.closed_date.overlap', - api_level => 1, - method => 'org_closed_overlap', -); - -sub user_by_barcode { - my $self = shift; - my $client = shift; - my @barcodes = shift; - - return undef unless @barcodes; - - for my $card ( actor::card->search( { barcode => @barcodes } ) ) { - next unless $card; - if (@barcodes == 1) { - return $card->usr->to_fieldmapper; - } - $client->respond( $card->usr->to_fieldmapper); - } - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.direct.actor.user.search.barcode', - api_level => 1, - method => 'user_by_barcode', - stream => 1, - cachable => 1, -); - -sub lost_barcodes { - my $self = shift; - my $client = shift; - - my $c = actor::card->table; - my $p = actor::user->table; - - my $sql = "SELECT c.barcode FROM $c c JOIN $p p ON (c.usr = p.id) WHERE p.card <> c.id"; - - my $list = actor::user->db_Main->selectcol_arrayref($sql); - for my $bc ( @$list ) { - $client->respond($bc); - } - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.user.lost_barcodes', - api_level => 1, - stream => 1, - method => 'lost_barcodes', - signature => <<' NOTE', - Returns an array of barcodes that belong to lost cards. - @return array of barcodes - NOTE -); - -sub expired_barcodes { - my $self = shift; - my $client = shift; - - my $c = actor::card->table; - my $p = actor::user->table; - - my $sql = "SELECT c.barcode FROM $c c JOIN $p p ON (c.usr = p.id) WHERE p.expire_date < CURRENT_DATE"; - - my $list = actor::user->db_Main->selectcol_arrayref($sql); - for my $bc ( @$list ) { - $client->respond($bc); - } - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.user.expired_barcodes', - api_level => 1, - stream => 1, - method => 'expired_barcodes', - signature => <<' NOTE', - Returns an array of barcodes that are currently expired. - @return array of barcodes - NOTE -); - -sub barred_barcodes { - my $self = shift; - my $client = shift; - - my $c = actor::card->table; - my $p = actor::user->table; - - my $sql = "SELECT c.barcode FROM $c c JOIN $p p ON (c.usr = p.id) WHERE p.barred IS TRUE"; - - my $list = actor::user->db_Main->selectcol_arrayref($sql); - for my $bc ( @$list ) { - $client->respond($bc); - } - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.user.barred_barcodes', - api_level => 1, - stream => 1, - method => 'barred_barcodes', - signature => <<' NOTE', - Returns an array of barcodes that are currently barred. - @return array of barcodes - NOTE -); - -sub penalized_barcodes { - my $self = shift; - my $client = shift; - - my $c = actor::card->table; - my $p = actor::user_standing_penalty->table; - - my $sql = <<" SQL"; - SELECT DISTINCT c.barcode - FROM $c c - JOIN $p p USING (usr) - JOIN config.standing_penalty csp ON (csp.id = p.standing_penalty) - WHERE csp.block_list IS NOT NULL - AND p.set_date < CURRENT_DATE - AND (p.stop_date IS NULL OR p.stop_date > CURRENT_DATE); - SQL - - my $list = actor::user->db_Main->selectcol_arrayref($sql); - for my $bc ( @$list ) { - $client->respond($bc); - } - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.user.penalized_barcodes', - api_level => 1, - stream => 1, - method => 'penalized_barcodes', - signature => <<' NOTE', - Returns an array of barcodes that have blocking penalties. - @return array of barcodes - NOTE -); - - -sub patron_search { - my $self = shift; - my $client = shift; - my $search = shift; - my $limit = shift || 1000; - my $sort = shift; - my $inactive = shift; - my $ws_ou = shift; - my $ws_ou_depth = shift || 0; - - my $penalty_sort = 0; - - my $strict_opt_in = OpenSRF::Utils::SettingsClient->new->config_value( share => user => 'opt_in' ); - - $sort = ['family_name','first_given_name'] unless ($$sort[0]); - push @$sort,'id'; - - if ($$sort[0] eq 'penalties') { - shift @$sort; - $penalty_sort = 1; - } - - # group 0 = user - # group 1 = address - # group 2 = phone, ident - # group 3 = barcode - - my $usr = join ' AND ', map { "LOWER(CAST($_ AS text)) ~ ?" } grep { ''.$$search{$_}{group} eq '0' } keys %$search; - my @usrv = map { "^$$search{$_}{value}" } grep { ''.$$search{$_}{group} eq '0' } keys %$search; - - my $addr = join ' AND ', map { "LOWER(CAST($_ AS text)) ~ ?" } grep { ''.$$search{$_}{group} eq '1' } keys %$search; - my @addrv = map { "^$$search{$_}{value}" } grep { ''.$$search{$_}{group} eq '1' } keys %$search; - - my $pv = $$search{phone}{value}; - my $iv = $$search{ident}{value}; - my $nv = $$search{name}{value}; - my $cv = $$search{card}{value}; - - my $card = ''; - if ($cv) { - $card = 'JOIN (SELECT DISTINCT usr FROM actor.card WHERE LOWER(barcode) LIKE ?||\'%\') AS card ON (card.usr = users.id)'; - unshift(@usrv, $cv); - } - - my $phone = ''; - my @ps; - my @phonev; - if ($pv) { - for my $p ( qw/day_phone evening_phone other_phone/ ) { - push @ps, "LOWER($p) ~ ?"; - push @phonev, "^$pv"; - } - $phone = '(' . join(' OR ', @ps) . ')'; - } - - my $ident = ''; - my @is; - my @identv; - if ($iv) { - for my $i ( qw/ident_value ident_value2/ ) { - push @is, "LOWER($i) ~ ?"; - push @identv, "^$iv"; - } - $ident = '(' . join(' OR ', @is) . ')'; - } - - my $name = ''; - my @ns; - my @namev; - if (0 && $nv) { - for my $n ( qw/first_given_name second_given_name family_name/ ) { - push @ns, "LOWER($n) ~ ?"; - push @namev, "^$nv"; - } - $name = '(' . join(' OR ', @ns) . ')'; - } - - my $usr_where = join ' AND ', grep { $_ } ($usr,$phone,$ident,$name); - my $addr_where = $addr; - - - my $u_table = actor::user->table; - my $a_table = actor::user_address->table; - my $opt_in_table = actor::usr_org_unit_opt_in->table; - my $ou_table = actor::org_unit->table; - - my $u_select = "SELECT id as id FROM $u_table u WHERE $usr_where"; - my $a_select = "SELECT u.id as id FROM $a_table a JOIN $u_table u ON (u.mailing_address = a.id OR u.billing_address = a.id) WHERE $addr_where"; - - my $clone_select = ''; - - #$clone_select = "JOIN (SELECT cu.id as id FROM $a_table ca ". - # "JOIN $u_table cu ON (cu.mailing_address = ca.id OR cu.billing_address = ca.id) ". - # "WHERE $addr_where) AS clone ON (clone.id = users.id)" if ($addr_where); - - my $select = ''; - if ($usr_where) { - if ($addr_where) { - $select = "$u_select INTERSECT $a_select"; - } else { - $select = $u_select; - } - } elsif ($addr_where) { - $select = "$a_select"; - } - - return undef if (!$select && !$card); - - my $order_by = join ', ', map { 'LOWER(CAST(users.'. (split / /,$_)[0] . ' AS text)) ' . (split / /,$_)[1] } @$sort; - my $distinct_list = join ', ', map { 'LOWER(CAST(users.'. (split / /,$_)[0] . ' AS text))' } @$sort; - my $group_list = $distinct_list; - - if ($inactive) { - $inactive = ''; - } else { - $inactive = 'AND users.active = TRUE'; - } - - if (!$ws_ou) { # XXX This should be required!! - $ws_ou = actor::org_unit->search( { parent_ou => undef } )->next->id; - } - - my $opt_in_join = ''; - my $opt_in_where = ''; - if (lc($strict_opt_in) eq 'true') { - $opt_in_join = "LEFT JOIN $opt_in_table oi ON (oi.org_unit = $ws_ou AND users.id = oi.usr)"; - $opt_in_where = "AND (oi.id IS NOT NULL OR users.home_ou = $ws_ou)"; - } - - my $penalty_join = ''; - if ($penalty_sort) { - $distinct_list = 'COUNT(penalties.id), ' . $distinct_list; - $order_by = 'COUNT(penalties.id) DESC, ' . $order_by; - unshift @$sort, 'COUNT(penalties.id)'; - $penalty_join = <<" SQL"; - LEFT JOIN actor.usr_standing_penalty penalties - ON (users.id = penalties.usr AND (penalties.stop_date IS NULL OR penalties.stop_date > NOW())) - SQL - } - - my $descendants = "actor.org_unit_descendants($ws_ou, $ws_ou_depth)"; - - $select = "JOIN ($select) AS search ON (search.id = users.id)" if ($select); - $select = <<" SQL"; - SELECT $distinct_list - FROM $u_table AS users $card - JOIN $descendants d ON (d.id = users.home_ou) - $select - $opt_in_join - $clone_select - $penalty_join - WHERE users.deleted = FALSE - $inactive - $opt_in_where - GROUP BY $group_list - ORDER BY $order_by - LIMIT $limit - SQL - - return actor::user->db_Main->selectcol_arrayref($select, {Columns=>[scalar(@$sort)]}, map {lc($_)} (@usrv,@phonev,@identv,@namev,@addrv)); -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.user.crazy_search', - api_level => 1, - method => 'patron_search', -); - -sub org_unit_list { - my $self = shift; - my $client = shift; - - my $select =<<" SQL"; - SELECT * - FROM actor.org_unit - ORDER BY CASE WHEN parent_ou IS NULL THEN 0 ELSE 1 END, name; - SQL - - my $sth = actor::org_unit->db_Main->prepare_cached($select); - $sth->execute; - - $client->respond( $_->to_fieldmapper ) for ( map { actor::org_unit->construct($_) } $sth->fetchall_hash ); - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.direct.actor.org_unit.retrieve.all', - api_level => 1, - stream => 1, - method => 'org_unit_list', -); - -sub org_unit_type_list { - my $self = shift; - my $client = shift; - - my $select =<<" SQL"; - SELECT * - FROM actor.org_unit_type - ORDER BY depth, name; - SQL - - my $sth = actor::org_unit_type->db_Main->prepare_cached($select); - $sth->execute; - - $client->respond( $_->to_fieldmapper ) for ( map { actor::org_unit_type->construct($_) } $sth->fetchall_hash ); - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.direct.actor.org_unit_type.retrieve.all', - api_level => 1, - stream => 1, - method => 'org_unit_type_list', -); - -sub org_unit_full_path { - my $self = shift; - my $client = shift; - my @binds = @_; - - return undef unless (@binds); - - my $func = 'actor.org_unit_full_path(?)'; - $func = 'actor.org_unit_full_path(?,?)' if (@binds > 1); - - my $sth = actor::org_unit->db_Main->prepare_cached("SELECT * FROM $func"); - $sth->execute(@binds); - - $client->respond( $_->to_fieldmapper ) for ( map { actor::org_unit->construct($_) } $sth->fetchall_hash ); - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.org_unit.full_path', - api_level => 1, - stream => 1, - method => 'org_unit_full_path', -); - -sub org_unit_ancestors { - my $self = shift; - my $client = shift; - my $id = shift; - - return undef unless ($id); - - my $func = 'actor.org_unit_ancestors(?)'; - - my $sth = actor::org_unit->db_Main->prepare_cached(<<" SQL"); - SELECT f.* - FROM $func f - JOIN actor.org_unit_type t ON (f.ou_type = t.id) - ORDER BY t.depth, f.name; - SQL - $sth->execute(''.$id); - - $client->respond( $_->to_fieldmapper ) for ( map { actor::org_unit->construct($_) } $sth->fetchall_hash ); - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.org_unit.ancestors', - api_level => 1, - stream => 1, - method => 'org_unit_ancestors', -); - -sub org_unit_descendants { - my $self = shift; - my $client = shift; - my $id = shift; - my $depth = shift; - - return undef unless ($id); - - my $func = 'actor.org_unit_descendants(?)'; - if (defined $depth) { - $func = 'actor.org_unit_descendants(?,?)'; - } - - my $sth = actor::org_unit->db_Main->prepare_cached("SELECT * FROM $func"); - $sth->execute(''.$id, ''.$depth) if (defined $depth); - $sth->execute(''.$id) unless (defined $depth); - - $client->respond( $_->to_fieldmapper ) for ( map { actor::org_unit->construct($_) } $sth->fetchall_hash ); - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.actor.org_unit.descendants', - api_level => 1, - stream => 1, - method => 'org_unit_descendants', -); - -sub fleshed_actor_stat_cat { - my $self = shift; - my $client = shift; - my @list = @_; - - @list = ($list[0]) unless ($self->api_name =~ /batch/o); - - for my $sc (@list) { - my $cat = actor::stat_cat->retrieve($sc); - next unless ($cat); - - my $sc_fm = $cat->to_fieldmapper; - $sc_fm->entries( [ map { $_->to_fieldmapper } $cat->entries ] ); - - $client->respond( $sc_fm ); - - } - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.fleshed.actor.stat_cat.retrieve', - api_level => 1, - argc => 1, - method => 'fleshed_actor_stat_cat', -); - -__PACKAGE__->register_method( - api_name => 'open-ils.storage.fleshed.actor.stat_cat.retrieve.batch', - api_level => 1, - argc => 1, - stream => 1, - method => 'fleshed_actor_stat_cat', -); - -#XXX Fix stored proc calls -sub ranged_actor_stat_cat_all { - my $self = shift; - my $client = shift; - my $ou = ''.shift(); - - return undef unless ($ou); - my $s_table = actor::stat_cat->table; - - my $select = <<" SQL"; - SELECT s.* - FROM $s_table s - JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner) - ORDER BY name - SQL - - $fleshed = 0; - $fleshed = 1 if ($self->api_name =~ /fleshed/o); - - my $sth = actor::stat_cat->db_Main->prepare_cached($select); - $sth->execute($ou); - - for my $sc ( map { actor::stat_cat->construct($_) } $sth->fetchall_hash ) { - my $sc_fm = $sc->to_fieldmapper; - $sc_fm->entries( - [ $self->method_lookup( 'open-ils.storage.ranged.actor.stat_cat_entry.search.stat_cat' )->run($ou,$sc->id) ] - ) if ($fleshed); - $client->respond( $sc_fm ); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.ranged.fleshed.actor.stat_cat.all', - api_level => 1, - argc => 1, - stream => 1, - method => 'ranged_actor_stat_cat_all', -); - -__PACKAGE__->register_method( - api_name => 'open-ils.storage.ranged.actor.stat_cat.all', - api_level => 1, - argc => 1, - stream => 1, - method => 'ranged_actor_stat_cat_all', -); - -#XXX Fix stored proc calls -sub ranged_actor_stat_cat_entry { - my $self = shift; - my $client = shift; - my $ou = ''.shift(); - my $sc = ''.shift(); - - return undef unless ($ou); - my $s_table = actor::stat_cat_entry->table; - - my $select = <<" SQL"; - SELECT s.* - FROM $s_table s - JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner) - WHERE stat_cat = ? - ORDER BY name - SQL - - my $sth = actor::stat_cat->db_Main->prepare_cached($select); - $sth->execute($ou,$sc); - - for my $sce ( map { actor::stat_cat_entry->construct($_) } $sth->fetchall_hash ) { - $client->respond( $sce->to_fieldmapper ); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.ranged.actor.stat_cat_entry.search.stat_cat', - api_level => 1, - stream => 1, - method => 'ranged_actor_stat_cat_entry', -); - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/asset.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/asset.pm deleted file mode 100644 index 622a1dbbf1..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/asset.pm +++ /dev/null @@ -1,888 +0,0 @@ -package OpenILS::Application::Storage::Publisher::asset; -use base qw/OpenILS::Application::Storage/; -#use OpenILS::Application::Storage::CDBI::asset; -#use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::Logger qw/:level/; -use OpenSRF::EX qw/:try/; -use OpenSRF::Utils::JSON; - -# - -my $log = 'OpenSRF::Utils::Logger'; - -use MARC::Record; -use MARC::File::XML; - -sub circ_count { - my $self = shift; - my $client = shift; - my $copy = shift; - my $granularity = shift; - - my $c_table = action::circulation->table; - - if (lc($granularity) eq 'year') { - $granularity = ", to_char(xact_start, 'YYYY') as when"; - } elsif (lc($granularity) eq 'month') { - $granularity = ", to_char(xact_start, 'YYYY-MM') as when"; - } elsif (lc($granularity) eq 'day') { - $granularity = ", to_char(xact_start, 'YYYY-MM-DD') as when"; - } else { - $granularity = ", 'total' as when"; - } - - my $SQL = <<" SQL"; - SELECT COUNT(*) as count $granularity - FROM $c_table - WHERE target_copy = ? - SQL - - - if ($granularity !~ /total/o) { - $SQL .= ' GROUP BY 2 ORDER BY 2'; - } - - $log->debug("Circ count SQL [$SQL]", DEBUG); - - return action::circulation->db_Main->selectall_hashref($SQL, 'when', {}, $copy); -} -__PACKAGE__->register_method( - method => 'circ_count', - api_name => 'open-ils.storage.asset.copy.circ_count', - argc => 1, -); - - -#our $_default_subfield_map = { -# call_number => $cn, -# barcode => $bc, -# owning_lib => $ol, -# circulating_lib => $cl, -# copy_location => $sl, -# copy_number => $num, -# price => $pr, -# status => $loc, -# create_date => $date, -# -# legacy_item_type => $it, -# legacy_item_cat_1 => $ic1, -# legacy_item_cat_2 => $ic2, -#}; - -my %org_cache; - -sub import_xml_holdings { - my $self = shift; - my $client = shift; - my $editor = shift; - my $record = shift; - my $xml = shift; - my $tag = shift; - my $map = shift; - my $date_format = shift || 'mm/dd/yyyy'; - - ($record) = biblio::record_entry->search_where($record); - - return 0 unless ($record); - - my $r = MARC::Record->new_from_xml($xml); - - my $count = 0; - for my $f ( $r->fields( $tag ) ) { - next unless ($f->subfield( $map->{owning_lib} )); - - my ($ol,$cl); - - try { - $ol = - $org_cache{ $f->subfield( $map->{owning_lib} ) } - || actor::org_unit->search( shortname => $f->subfield( $map->{owning_lib} ) )->next->id; - - $org_cache{ $f->subfield( $map->{owning_lib} ) } = $ol; - } otherwise { - $log->debug('Could not find library with shortname ['.$f->subfield( $map->{owning_lib} ).'] : '. shift(), ERROR); - $log->info('Failed holdings tag: ['.OpenSRF::Utils::JSON->perl2JSON( $f ).']'); - }; - - try { - $cl = - $org_cache{ $f->subfield( $map->{circulating_lib} ) } - || actor::org_unit->search( shortname => $f->subfield( $map->{circulating_lib} ) )->next->id; - - $org_cache{ $f->subfield( $map->{circulating_lib} ) } = $cl; - } otherwise { - $log->debug('Could not find library with shortname ['.$f->subfield( $map->{circulating_lib} ).'] : '. shift(), ERROR); - $log->info('Failed holdings tag: ['.OpenSRF::Utils::JSON->perl2JSON( $f ).']'); - }; - - next unless ($ol && $cl); - - my $cn; - try { - $cn = asset::call_number->find_or_create( - { label => $f->subfield( $map->{call_number} ), - owning_lib => $ol, - record => $record->id, - creator => $editor, - editor => $editor, - } - ); - } otherwise { - $log->debug('Could not find or create callnumber ['.$f->subfield( $map->{call_number} )."] on record $record : ". shift(), ERROR); - $log->info('Failed holdings tag: ['.OpenSRF::Utils::JSON->perl2JSON( $f ).']'); - }; - - next unless ($cn); - - my $create_date = $f->subfield( $map->{create_date} ); - - my ($m,$d,$y); - if ($date_format eq 'mm/dd/yyyy') { - ($m,$d,$y) = split '/', $create_date; - - } elsif ($date_format eq 'dd/mm/yyyy') { - ($d,$m,$y) = split '/', $create_date; - - } elsif ($date_format eq 'mm-dd-yyyy') { - ($m,$d,$y) = split '-', $create_date; - - } elsif ($date_format eq 'dd-mm-yyyy') { - ($d,$m,$y) = split '-', $create_date; - - } elsif ($date_format eq 'yyyy-mm-dd') { - ($y,$m,$d) = split '-', $create_date; - - } elsif ($date_format eq 'yyyy/mm/dd') { - ($y,$m,$d) = split '/', $create_date; - } - - if ($y == 0) { - (undef,undef,undef,$d,$m,$y) = localtime; - $m++; - $y+=1900; - } - - my $price = $f->subfield( $map->{price} ); - $price =~ s/[^0-9\.]+//gso; - $price ||= '0.00'; - - try { - $cn->add_to_copies( - { circ_lib => $cl, - copy_number => $f->subfield( $map->{copy_number} ), - price => $price, - barcode => $f->subfield( $map->{barcode} ), - loan_duration => 2, - fine_level => 2, - creator => $editor, - editor => $editor, - create_date => sprintf('%04d-%02d-%02d',$y,$m,$d), - } - ); - $count++; - } otherwise { - $log->debug('Could not create copy ['.$f->subfield( $map->{barcode} ).'] : '. shift(), ERROR); - }; - } - - return $count; -} -__PACKAGE__->register_method( - method => 'import_xml_holdings', - api_name => 'open-ils.storage.asset.holdings.import.xml', - argc => 5, - stream => 0, -); - -# XXX -# see /home/miker/cn_browse-test.sql for page up and down sql ... -# XXX - -sub cn_browse_pagedown { - my $self = shift; - my $client = shift; - - my %args = @_; - - my $cn = uc($args{label}); - my $org = $args{org_unit}; - my $depth = $args{depth}; - my $boundry_id = $args{boundry_id}; - my $size = $args{page_size} || 20; - $size = int($size); - - my $table = asset::call_number->table; - - my $descendants = "actor.org_unit_descendants($org)"; - if (defined $depth) { - $descendants = "actor.org_unit_descendants($org,$depth)"; - } - - my $orgs = join(',', @{ asset::call_number->db_Main->selectcol_arrayref("SELECT DISTINCT id FROM $descendants;") }); - - my $sql = <<" SQL"; - select - cn.label, - cn.owning_lib, - cn.record, - cn.id - from - $table cn - where - not deleted - and (oils_text_as_bytea(label) > ? or ( cn.id > ? and oils_text_as_bytea(label) = ? )) - and owning_lib in ($orgs) - order by oils_text_as_bytea(label), 4, 2 - limit $size; - SQL - - my $sth = asset::call_number->db_Main->prepare($sql); - $sth->execute($cn, $boundry_id, $cn); - while ( my @row = $sth->fetchrow_array ) { - $client->respond([@row]); - } - $sth->finish; - - return undef; -} -__PACKAGE__->register_method( - method => 'cn_browse_pagedown', - api_name => 'open-ils.storage.asset.call_number.browse.page_down', - argc => 4, - stream => 1, -); - -sub cn_browse_pageup { - my $self = shift; - my $client = shift; - - my %args = @_; - - my $cn = uc($args{label}); - my $org = $args{org_unit}; - my $depth = $args{depth}; - my $boundry_id = $args{boundry_id}; - my $size = $args{page_size} || 20; - $size = int($size); - - my $table = asset::call_number->table; - - my $descendants = "actor.org_unit_descendants($org)"; - if (defined $depth) { - $descendants = "actor.org_unit_descendants($org,$depth)"; - } - - my $orgs = join(',', @{ asset::call_number->db_Main->selectcol_arrayref("SELECT DISTINCT id FROM $descendants;") }); - - my $sql = <<" SQL"; - select * from ( - select - cn.label, - cn.owning_lib, - cn.record, - cn.id - from - $table cn - where - not deleted - and (oils_text_as_bytea(label) < ? or ( cn.id < ? and oils_text_as_bytea(label) = ? )) - and owning_lib in ($orgs) - order by oils_text_as_bytea(label) desc, 4 desc, 2 desc - limit $size - ) as bar - order by 1,4,2; - SQL - - my $sth = asset::call_number->db_Main->prepare($sql); - $sth->execute($cn, $boundry_id, $cn); - while ( my @row = $sth->fetchrow_array ) { - $client->respond([@row]); - } - $sth->finish; - - return undef; -} -__PACKAGE__->register_method( - method => 'cn_browse_pageup', - api_name => 'open-ils.storage.asset.call_number.browse.page_up', - argc => 4, - stream => 1, -); - -sub cn_browse_target { - my $self = shift; - my $client = shift; - - my %args = @_; - - my $cn = uc($args{label}); - my $org = $args{org_unit}; - my $depth = $args{depth}; - my $size = $args{page_size} || 20; - my $topsize = $size / 2; - $topsize = int($topsize); - $bottomsize = $size - $topsize; - - my $table = asset::call_number->table; - - my $descendants = "actor.org_unit_descendants($org)"; - if (defined $depth) { - $descendants = "actor.org_unit_descendants($org,$depth)"; - } - - my $orgs = join(',', @{ asset::call_number->db_Main->selectcol_arrayref("SELECT DISTINCT id FROM $descendants;") }); - - my $top_sql = <<" SQL"; - select * from ( - select - cn.label, - cn.owning_lib, - cn.record, - cn.id - from - $table cn - where - not deleted - and oils_text_as_bytea(label) < ? - and owning_lib in ($orgs) - order by oils_text_as_bytea(label) desc, 4 desc, 2 desc - limit $topsize - ) as bar - order by 1,4,2; - SQL - - my $bottom_sql = <<" SQL"; - select - cn.label, - cn.owning_lib, - cn.record, - cn.id - from - $table cn - where - not deleted - and oils_text_as_bytea(label) >= ? - and owning_lib in ($orgs) - order by oils_text_as_bytea(label),4,2 - limit $bottomsize; - SQL - - my $sth = asset::call_number->db_Main->prepare($top_sql); - $sth->execute($cn); - while ( my @row = $sth->fetchrow_array ) { - $client->respond([@row]); - } - $sth->finish; - - $sth = asset::call_number->db_Main->prepare($bottom_sql); - $sth->execute($cn); - while ( my @row = $sth->fetchrow_array ) { - $client->respond([@row]); - } - $sth->finish; - - return undef; -} -__PACKAGE__->register_method( - method => 'cn_browse_target', - api_name => 'open-ils.storage.asset.call_number.browse.target', - argc => 4, - stream => 1, -); - - -sub copy_proximity { - my $self = shift; - my $client = shift; - - my $cp = shift; - my $org = shift; - - return unless ($cp && $org); - - $cp = asset::copy->retrieve($cp) unless (ref($cp)); - - return unless $cp; - my $ol = $cp->circ_lib; - - return (actor::org_unit_proximity->search( from_org => "$ol", to_org => "$org"))[0]->prox; -} -__PACKAGE__->register_method( - method => 'copy_proximity', - api_name => 'open-ils.storage.asset.copy.proximity', - argc => 2, - stream => 1, -); - -sub asset_copy_location_all { - my $self = shift; - my $client = shift; - - for my $rec ( asset::copy_location->retrieve_all ) { - $client->respond( $rec->to_fieldmapper ); - } - - return undef; -} -__PACKAGE__->register_method( - method => 'asset_copy_location_all', - api_name => 'open-ils.storage.direct.asset.copy_location.retrieve.all', - argc => 0, - stream => 1, -); - -# XXX arg, with the descendancy SPs... -sub ranged_asset_copy_location { - my $self = shift; - my $client = shift; - my @binds = @_; - - my $ctable = asset::copy_location->table; - - my $descendants = defined($binds[1]) ? - "actor.org_unit_full_path(?, ?)" : - "actor.org_unit_full_path(?)" ; - - - my $sql = <<" SQL"; - SELECT DISTINCT c.* - FROM $ctable c - JOIN $descendants d - ON (d.id = c.owning_lib) - ORDER BY name - SQL - - my $sth = asset::copy_location->db_Main->prepare($sql); - $sth->execute(@binds); - - while ( my $rec = $sth->fetchrow_hashref ) { - - my $cnct = new Fieldmapper::asset::copy_location; - map {$cnct->$_($$rec{$_})} keys %$rec; - $client->respond( $cnct ); - } - - return undef; -} -__PACKAGE__->register_method( - method => 'ranged_asset_copy_location', - api_name => 'open-ils.storage.ranged.asset.copy_location.retrieve', - argc => 1, - stream => 1, -); - - -sub fleshed_copy { - my $self = shift; - my $client = shift; - my @ids = @_; - - return undef unless (@ids); - - @ids = ($ids[0]) unless ($self->api_name =~ /batch/o); - - for my $id ( @ids ) { - next unless $id; - my $cp = asset::copy->retrieve($id); - next unless $cp; - - my $cp_fm = $cp->to_fieldmapper; - $cp_fm->circ_lib( $cp->circ_lib->to_fieldmapper ); - $cp_fm->location( $cp->location->to_fieldmapper ); - $cp_fm->status( $cp->status->to_fieldmapper ); - $cp_fm->stat_cat_entries( [ map { $_->to_fieldmapper } $cp->stat_cat_entries ] ); - - $client->respond( $cp_fm ); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.fleshed.asset.copy.batch.retrieve', - method => 'fleshed_copy', - argc => 1, - stream => 1, -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.fleshed.asset.copy.retrieve', - method => 'fleshed_copy', - argc => 1, -); - -sub fleshed_copy_by_barcode { - my $self = shift; - my $client = shift; - my $bc = ''.shift; - - my ($cp) = asset::copy->search( { barcode => $bc } ); - - return undef unless ($cp); - - my $cp_fm = $cp->to_fieldmapper; - $cp_fm->circ_lib( $cp->circ_lib->to_fieldmapper ); - $cp_fm->location( $cp->location->to_fieldmapper ); - $cp_fm->status( $cp->status->to_fieldmapper ); - - return $cp_fm; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.fleshed.asset.copy.search.barcode', - method => 'fleshed_copy_by_barcode', - argc => 1, - stream => 1, -); - - -#XXX Fix stored proc calls -sub fleshed_asset_stat_cat { - my $self = shift; - my $client = shift; - my @list = @_; - - @list = ($list[0]) unless ($self->api_name =~ /batch/o); - for my $sc (@list) { - my $cat = asset::stat_cat->retrieve($sc); - - next unless ($cat); - - my $sc_fm = $cat->to_fieldmapper; - $sc_fm->entries( [ map { $_->to_fieldmapper } $cat->entries ] ); - $client->respond( $sc_fm ); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.fleshed.asset.stat_cat.retrieve', - api_level => 1, - method => 'fleshed_asset_stat_cat', -); - -__PACKAGE__->register_method( - api_name => 'open-ils.storage.fleshed.asset.stat_cat.retrieve.batch', - api_level => 1, - stream => 1, - method => 'fleshed_asset_stat_cat', -); - - -#XXX Fix stored proc calls -sub ranged_asset_stat_cat { - my $self = shift; - my $client = shift; - my $ou = ''.shift(); - - return undef unless ($ou); - my $s_table = asset::stat_cat->table; - - my $select = <<" SQL"; - SELECT s.* - FROM $s_table s - JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner) - ORDER BY name - SQL - - $fleshed = 0; - $fleshed = 1 if ($self->api_name =~ /fleshed/o); - - my $sth = asset::stat_cat->db_Main->prepare_cached($select); - $sth->execute($ou); - - for my $sc ( map { asset::stat_cat->construct($_) } $sth->fetchall_hash ) { - my $sc_fm = $sc->to_fieldmapper; - $sc_fm->entries( - [ $self->method_lookup( 'open-ils.storage.ranged.asset.stat_cat_entry.search.stat_cat' )->run($ou,$sc->id) ] - ) if ($fleshed); - $client->respond( $sc_fm ); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.ranged.fleshed.asset.stat_cat.all', - api_level => 1, - stream => 1, - method => 'ranged_asset_stat_cat', -); - -__PACKAGE__->register_method( - api_name => 'open-ils.storage.ranged.asset.stat_cat.all', - api_level => 1, - stream => 1, - method => 'ranged_asset_stat_cat', -); - - -#XXX Fix stored proc calls -sub multiranged_asset_stat_cat { - my $self = shift; - my $client = shift; - my $ous = shift; - - return undef unless (defined($ous) and @$ous); - my $s_table = asset::stat_cat->table; - - my $select = <<" SQL"; - SELECT s.* - FROM $s_table s - WHERE s.owner IN ( XXX ) - ORDER BY name - SQL - - my $collector = ' INTERSECT '; - my $entry_method = 'open-ils.storage.multiranged.intersect.asset.stat_cat_entry.search.stat_cat'; - if ($self->api_name =~ /union/o) { - $collector = ' UNION '; - $entry_method = 'open-ils.storage.multiranged.union.asset.stat_cat_entry.search.stat_cat'; - } - - my $binds = join($collector, map { 'SELECT id FROM actor.org_unit_full_path(?)' } grep {defined} @$ous); - $select =~ s/XXX/$binds/so; - - $fleshed = 0; - $fleshed = 1 if ($self->api_name =~ /fleshed/o); - - my $sth = asset::stat_cat->db_Main->prepare_cached($select); - $sth->execute(map { "$_" } grep {defined} @$ous); - - for my $sc ( map { asset::stat_cat->construct($_) } $sth->fetchall_hash ) { - my $sc_fm = $sc->to_fieldmapper; - $sc_fm->entries( - [ $self->method_lookup( $entry_method )->run($ous, $sc->id) ] - ) if ($fleshed); - $client->respond( $sc_fm ); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.multiranged.intersect.fleshed.asset.stat_cat.all', - api_level => 1, - stream => 1, - method => 'multiranged_asset_stat_cat', -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.multiranged.union.fleshed.asset.stat_cat.all', - api_level => 1, - stream => 1, - method => 'multiranged_asset_stat_cat', -); - -#XXX Fix stored proc calls -sub ranged_asset_stat_cat_entry { - my $self = shift; - my $client = shift; - my $ou = ''.shift(); - my $sc = ''.shift(); - - return undef unless ($ou); - my $s_table = asset::stat_cat_entry->table; - - my $select = <<" SQL"; - SELECT s.* - FROM $s_table s - JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner) - WHERE stat_cat = ? - ORDER BY name - SQL - - my $sth = asset::stat_cat->db_Main->prepare_cached($select); - $sth->execute($ou,$sc); - - for my $sce ( map { asset::stat_cat_entry->construct($_) } $sth->fetchall_hash ) { - $client->respond( $sce->to_fieldmapper ); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.ranged.asset.stat_cat_entry.search.stat_cat', - api_level => 1, - stream => 1, - method => 'ranged_asset_stat_cat_entry', -); - -#XXX Fix stored proc calls -sub multiranged_asset_stat_cat_entry { - my $self = shift; - my $client = shift; - my $ous = shift; - my $sc = ''.shift(); - - return undef unless (defined($ous) and @$ous); - my $s_table = asset::stat_cat_entry->table; - - my $collector = ' INTERSECT '; - $collector = ' UNION ' if ($self->api_name =~ /union/o); - - my $select = <<" SQL"; - SELECT s.* - FROM $s_table s - WHERE s.owner IN ( XXX ) and s.stat_cat = ? - ORDER BY value - SQL - - my $binds = join($collector, map { 'SELECT id FROM actor.org_unit_full_path(?)' } grep {defined} @$ous); - $select =~ s/XXX/$binds/so; - - my $sth = asset::stat_cat->db_Main->prepare_cached($select); - $sth->execute(map {"$_"} @$ous,$sc); - - for my $sce ( map { asset::stat_cat_entry->construct($_) } $sth->fetchall_hash ) { - $client->respond( $sce->to_fieldmapper ); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.multiranged.intersect.asset.stat_cat_entry.search.stat_cat', - api_level => 1, - stream => 1, - method => 'multiranged_asset_stat_cat_entry', -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.multiranged.union.asset.stat_cat_entry.search.stat_cat', - api_level => 1, - stream => 1, - method => 'multiranged_asset_stat_cat_entry', -); - - -sub cn_ranged_tree { - my $self = shift; - my $client = shift; - my $cn = shift; - my $ou = shift; - my $depth = shift || 0; - - my $ou_list = - actor::org_unit - ->db_Main - ->selectcol_arrayref( - 'SELECT id FROM actor.org_unit_descendants(?,?)', - {}, - $ou, - $depth - ); - - return undef unless ($ou_list and @$ou_list); - - $cn = asset::call_number->retrieve( $cn ); - return undef unless ($cn); - return undef if ($cn->deleted); - - my $call_number = $cn->to_fieldmapper; - $call_number->copies([]); - - $call_number->record( $cn->record->to_fieldmapper ); - $call_number->record->fixed_fields( $cn->record->record_descriptor->next->to_fieldmapper ); - - for my $cp ( $cn->copies(circ_lib => $ou_list) ) { - next if ($cp->deleted); - my $copy = $cp->to_fieldmapper; - $copy->status( $cp->status->to_fieldmapper ); - $copy->location( $cp->location->to_fieldmapper ); - - push @{ $call_number->copies }, $copy; - } - - return $call_number; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.asset.call_number.ranged_tree', - method => 'cn_ranged_tree', - argc => 1, - api_level => 1, -); - - -# XXX Since this is all we need in open-ils.storage for serial stuff ATM, just -# XXX putting it here instead of creating a whole new file. -sub issuance_ranged_tree { - my $self = shift; - my $client = shift; - my $iss = shift; - my $ou = shift; - my $depth = shift || 0; - - my $ou_list = - actor::org_unit - ->db_Main - ->selectcol_arrayref( - 'SELECT id FROM actor.org_unit_descendants(?,?)', - {}, - $ou, - $depth - ); - - return undef unless ($ou_list and @$ou_list); - - $iss = serial::issuance->retrieve( $iss ); - return undef unless ($iss); - - my $issuance = $iss->to_fieldmapper; - $issuance->items([]); - - # Now, gather issuances on the same bib, with the same label and date_published ... - my @subs = map { $_->id } serial::subscription->search( record_entry => $iss->subscription->record_entry->id ); - - my @similar_iss = serial::issuance->search_where( - subscription => \@subs, - label => $iss->label, - date_published => $iss->date_published - ); - - # ... and add all /their/ items to the target issuance - for my $i ( @similar_iss ) { - for my $it ( $i->items() ) { - next unless $it->unit and not $it->unit->deleted; - next unless (grep { $it->unit->circ_lib eq $_ } @$ou_list); - - my $unit = $it->unit->to_fieldmapper; - $unit->status( $it->unit->status->to_fieldmapper ); - $unit->location( $it->unit->location->to_fieldmapper ); - - my $item = $it->to_fieldmapper; - $item->unit( $unit ); - - push @{ $issuance->items }, $item; - } - } - - return $issuance; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.serial.issuance.ranged_tree', - method => 'issuance_ranged_tree', - argc => 1, - api_level => 1, -); - -sub merge_record_assets { - my $self = shift; - my $client = shift; - my $target = shift; - my @sources = @_; - - my $count = 0; - for my $source ( @sources ) { - $count += asset::call_number - ->db_Main - ->selectcol_arrayref( - "SELECT asset.merge_record_assets(?,?);", - {}, - $target, - $source - )->[0]; - } - - return $count; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.asset.merge_record_assets', - method => 'merge_record_assets', - argc => 2, - api_level => 1, -); - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/authority.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/authority.pm deleted file mode 100644 index f21530f745..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/authority.pm +++ /dev/null @@ -1,261 +0,0 @@ -package OpenILS::Application::Storage::Publisher::authority; -use base qw/OpenILS::Application::Storage::Publisher/; -use vars qw/$VERSION/; -use OpenSRF::EX qw/:try/; -use OpenILS::Application::Storage::FTS; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::Normalize qw( naco_normalize ); -use OpenSRF::Utils::Logger qw/:level/; -use OpenSRF::Utils::Cache; -use Data::Dumper; -use Digest::MD5 qw/md5_hex/; -use XML::LibXML; -use Time::HiRes qw/time sleep/; -use Unicode::Normalize; - -my $log = 'OpenSRF::Utils::Logger'; - -$VERSION = 1; - -my $parser = XML::LibXML->new; - -sub validate_tag { - my $self = shift; - my $client = shift; - my %args = @_; - - my @tags = @{$args{tags}}; - my @searches = @{$args{searches}}; - - my $search_table = authority::full_rec->table; - - my @values; - my @selects; - for my $t ( @tags ) { - for my $search ( @searches ) { - my $sf = $$search{subfield}; - my $term = naco_normalize($$search{term}, $sf); - - $tag = [$tag] if (!ref($tag)); - - push @values, $t, $sf, $term; - - push @selects, - "SELECT record FROM $search_table ". - "WHERE tag = ? AND subfield = ? AND value = ?"; - } - - my $sql; - if ($self->api_name =~ /id_list/) { - $sql = 'SELECT DISTINCT record FROM ('; - } else { - $sql = 'SELECT COUNT(DISTINCT record) FROM ('; - } - $sql .= 'SELECT record FROM (('.join(') INTERSECT (', @selects).')) AS x '; - $sql .= "JOIN $search_table recheck USING (record) WHERE recheck.tag = ? "; - $sql .= "GROUP BY 1 HAVING (COUNT(recheck.id) - ?) = 0) AS foo;"; - - if ($self->api_name =~ /id_list/) { - my $id_list = authority::full_rec->db_Main->selectcol_arrayref( $sql, {}, @values, $t, scalar(@searches) ); - return $id_list; - } else { - my $count = authority::full_rec->db_Main->selectcol_arrayref( $sql, {}, @values, $t, scalar(@searches) )->[0]; - return $count if ($count > 0); - } - } - - return 0; -} -__PACKAGE__->register_method( - api_name => "open-ils.storage.authority.validate.tag", - method => 'validate_tag', - api_level => 1, -); - -__PACKAGE__->register_method( - api_name => "open-ils.storage.authority.validate.tag.id_list", - method => 'validate_tag', - api_level => 1, -); - - -sub find_authority_marc { - my $self = shift; - my $client = shift; - my %args = @_; - - my $term = NFD(lc($args{term})); - my $tag = $args{tag}; - my $subfield = $args{subfield}; - my $limit = $args{limit} || 100; - my $offset = $args{offset} || 0; - - if ($limit) { - $limit = "LIMIT $limit"; - } else { - $limit = ''; - } - - if ($offset) { - $offset = "OFFSET $offset"; - } else { - $offset = ''; - } - - my $tag_where = "AND f.tag LIKE '$tag'"; - if (ref $tag) { - $tag_where = "AND f.tag IN ('".join("','",@$tag)."')"; - } - - my $sf_where = "AND f.subfield = '$subfield'"; - if (ref $subfield) { - $sf_where = "AND f.subfield IN ('".join("','",@$subfield)."')"; - } - - my $search_table = authority::full_rec->table; - my $marc_table = authority::record_entry->table; - - my ($index_col) = authority::full_rec->columns('FTS'); - $index_col ||= 'value'; - - my $fts = OpenILS::Application::Storage::FTS->compile(default => $term, 'f.value', "f.$index_col"); - - $term =~ s/\W+$//gso; - $term =~ s/'/''/gso; - $term =~ s/\pM//gso; - - my $fts_where = $fts->sql_where_clause; - my $fts_words = join '%', $fts->words; - - return undef unless ($fts_words); - - my $fts_words_where = "f.value LIKE '$fts_words\%'"; - my $fts_start_where = "f.value LIKE '$term\%'"; - my $fts_eq_where = "f.value = '$term'"; - - my $fts_rank = join '+', $fts->fts_rank; - - my $select = <<" SQL"; - SELECT a.marc, sum($fts_rank), count(f.record), first(f.value) - FROM $search_table f, - $marc_table a - WHERE $fts_start_where - $tag_where - $sf_where - AND a.id = f.record - GROUP BY 1 - ORDER BY 2 desc, 3 desc, 4 - $limit - $offset - - SQL - - $log->debug("Authority Search SQL :: [$select]",DEBUG); - - my $recs = authority::full_rec->db_Main->selectcol_arrayref( $select ); - - $log->debug("Search yielded ".scalar(@$recs)." results.",DEBUG); - - $client->respond($_) for (@$recs); - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.storage.authority.search.marc", - method => 'find_authority_marc', - api_level => 1, - stream => 1, - cachable => 1, -); - -sub _empty_check { - my $term = shift; - my $class = shift || 'metabib::full_rec'; - - my $table = $class->table; - - my ($index_col) = $class->columns('FTS'); - $index_col ||= 'value'; - - my $fts = OpenILS::Application::Storage::FTS->compile(default => $term, 'm.value', "m.$index_col"); - my $fts_where = $fts->sql_where_clause; - - my $sql = <<" SQL"; - SELECT TRUE - FROM $table m - WHERE $fts_where - LIMIT 1 - SQL - - return $class->db_Main->selectcol_arrayref($sql)->[0]; -} - -my $prevtime; - -sub find_see_from_controlled { - my $self = shift; - my $client = shift; - my $term = shift; - my $limit = shift; - my $offset = shift; - - $prevtime = time; - - (my $class = $self->api_name) =~ s/^.+authority.([^\.]+)\.see.+$/$1/o; - my $sf = 'a'; - $sf = 't' if ($class eq 'title'); - - my @marc = $self->method_lookup('open-ils.storage.authority.search.marc') - ->run( term => $term, tag => [400,410,411,430,450,455], subfield => $sf, limit => $limit, offset => $offset ); - - - for my $m ( @marc ) { - my $doc = $parser->parse_string($m); - my @nodes = $doc->documentElement->findnodes('//*[substring(@tag,1,1)="1"]/*[@code="a" or @code="d" or @code="x"]'); - my $list = [ map { $_->textContent } @nodes ]; - $client->respond( $list ) if (_empty_check(join(' ',@$list), "metabib::${class}_field_entry")); - } - return undef; -} -for my $class ( qw/title author subject keyword series identifier/ ) { - __PACKAGE__->register_method( - api_name => "open-ils.storage.authority.$class.see_from.controlled", - method => 'find_see_from_controlled', - api_level => 1, - stream => 1, - cachable => 1, - ); -} - -sub find_see_also_from_controlled { - my $self = shift; - my $client = shift; - my $term = shift; - my $limit = shift; - my $offset = shift; - - (my $class = $self->api_name) =~ s/^.+authority.([^\.]+)\.see.+$/$1/o; - my $sf = 'a'; - $sf = 't' if ($class eq 'title'); - - my @marc = $self->method_lookup('open-ils.storage.authority.search.marc') - ->run( term => $term, tag => [500,510,511,530,550,555], subfield => $sf, limit => $limit, offset => $offset ); - for my $m ( @marc ) { - my $doc = $parser->parse_string($m); - my @nodes = $doc->documentElement->findnodes('//*[substring(@tag,1,1)="1"]/*[@code="a" or @code="d" or @code="x"]'); - my $list = [ map { $_->textContent } @nodes ]; - $client->respond( $list ) if (_empty_check(join(' ',@$list), "metabib::${class}_field_entry")); - } - return undef; -} -for my $class ( qw/title author subject keyword series identifier/ ) { - __PACKAGE__->register_method( - api_name => "open-ils.storage.authority.$class.see_also_from.controlled", - method => 'find_see_also_from_controlled', - api_level => 1, - stream => 1, - cachable => 1, - ); -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/biblio.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/biblio.pm deleted file mode 100644 index 5b609bee73..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/biblio.pm +++ /dev/null @@ -1,500 +0,0 @@ -package OpenILS::Application::Storage::Publisher::biblio; -use base qw/OpenILS::Application::Storage/; -use vars qw/$VERSION/; -use OpenSRF::EX qw/:try/; -#use OpenILS::Application::Storage::CDBI::biblio; -#use OpenILS::Application::Storage::CDBI::asset; -use OpenILS::Utils::Fieldmapper; - -$VERSION = 1; - -sub record_copy_count { - my $self = shift; - my $client = shift; - - my %args = @_; - - my $cn_table = asset::call_number->table; - my $cp_table = asset::copy->table; - my $st_table = config::copy_status->table; - my $src_table = config::bib_source->table; - my $br_table = biblio::record_entry->table; - my $loc_table = asset::copy_location->table; - my $out_table = actor::org_unit_type->table; - - my $descendants = "actor.org_unit_descendants(u.id)"; - my $ancestors = "actor.org_unit_ancestors(?) u JOIN $out_table t ON (u.ou_type = t.id)"; - - if ($args{org_unit} < 0) { - $args{org_unit} *= -1; - $ancestors = "(select org_unit as id from actor.org_lasso_map where lasso = ?) u CROSS JOIN (SELECT -1 AS depth) t"; - } - - my $visible = 'AND a.opac_visible = TRUE AND st.opac_visible = TRUE AND loc.opac_visible = TRUE AND cp.opac_visible = TRUE'; - if ($self->api_name =~ /staff/o) { - $visible = '' - } - - my $sql = <<" SQL"; - SELECT t.depth, - u.id AS org_unit, - sum( - (SELECT count(cp.id) - FROM $cn_table cn - JOIN $cp_table cp ON (cn.id = cp.call_number) - JOIN $descendants a ON (cp.circ_lib = a.id) - JOIN $st_table st ON (cp.status = st.id) - JOIN $loc_table loc ON (cp.location = loc.id) - WHERE cn.record = ? - $visible - AND cn.deleted IS FALSE - AND cp.deleted IS FALSE) - ) AS count, - sum( - (SELECT count(cp.id) - FROM $cn_table cn - JOIN $cp_table cp ON (cn.id = cp.call_number) - JOIN $descendants a ON (cp.circ_lib = a.id) - JOIN $st_table st ON (cp.status = st.id) - JOIN $loc_table loc ON (cp.location = loc.id) - WHERE cn.record = ? - $visible - AND cn.deleted IS FALSE - AND cp.deleted IS FALSE - AND cp.status IN (0,7,12)) - ) AS available, - sum( - (SELECT count(cp.id) - FROM $cn_table cn - JOIN $cp_table cp ON (cn.id = cp.call_number) - JOIN $st_table st ON (cp.status = st.id) - JOIN $loc_table loc ON (cp.location = loc.id) - WHERE cn.record = ? - AND st.opac_visible = TRUE - AND loc.opac_visible = TRUE - AND cp.opac_visible = TRUE - AND cn.deleted IS FALSE - AND cp.deleted IS FALSE) - ) AS unshadow, - sum( - (SELECT sum(1) - FROM $br_table br - JOIN $src_table src ON (src.id = br.source) - WHERE br.id = ? - AND src.transcendant IS TRUE - ) - ) AS transcendant - FROM $ancestors - GROUP BY 1,2 - SQL - - my $sth = biblio::record_entry->db_Main->prepare_cached($sql); - $sth->execute(''.$args{record}, ''.$args{record}, ''.$args{record}, ''.$args{record}, ''.$args{org_unit}); - while ( my $row = $sth->fetchrow_hashref ) { - $client->respond( $row ); - } - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.biblio.record_entry.copy_count', - method => 'record_copy_count', - api_level => 1, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.biblio.record_entry.copy_count.staff', - method => 'record_copy_count', - api_level => 1, - stream => 1, - cachable => 1, -); - -sub record_ranged_tree { - my $self = shift; - my $client = shift; - my $r = shift; - my $ou = shift; - my $depth = shift; - my $limit = shift || 0; - my $offset = shift || 0; - - my $ou_sql = defined($depth) ? - "SELECT id FROM actor.org_unit_descendants(?,?)": - "SELECT id FROM actor.org_unit_descendants(?)"; - - my $ou_list = - actor::org_unit - ->db_Main - ->selectcol_arrayref( - $ou_sql, - {}, - $ou, - (defined($depth) ? ($depth) : ()), - ); - - return undef unless ($ou_list and @$ou_list); - - $r = biblio::record_entry->retrieve( $r ); - return undef unless ($r); - - my $rec = $r->to_fieldmapper; - $rec->call_numbers([]); - - $rec->fixed_fields( $r->record_descriptor->next->to_fieldmapper ); - - my $offset_count = 0; - my $limit_count = 0; - for my $cn ( $r->call_numbers ) { - next if ($cn->deleted); - my $call_number = $cn->to_fieldmapper; - $call_number->copies([]); - - - for my $cp ( $cn->copies(circ_lib => $ou_list) ) { - next if ($cp->deleted); - if ($offset > 0 && $offset_count < $offset) { - $offset_count++; - next; - } - - last if ($limit > 0 && $limit_count >= $limit); - - my $copy = $cp->to_fieldmapper; - $copy->status( $cp->status->to_fieldmapper ); - $copy->location( $cp->location->to_fieldmapper ); - push @{ $call_number->copies }, $copy; - - $limit_count++; - } - - last if ($limit > 0 && $limit_count >= $limit); - - push @{ $rec->call_numbers }, $call_number if (@{ $call_number->copies }); - } - - return $rec; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.biblio.record_entry.ranged_tree', - method => 'record_ranged_tree', - argc => 1, - api_level => 1, -); - -sub record_by_barcode { - my $self = shift; - my $client = shift; - - my $cn_table = asset::call_number->table; - my $cp_table = asset::copy->table; - - my $id = ''.shift; - my ($r) = biblio::record_entry->db_Main->selectrow_array( <<" SQL", {}, $id ); - SELECT cn.record - FROM $cn_table cn - JOIN $cp_table cp ON (cp.call_number = cn.id) - WHERE cp.barcode = ? - SQL - - my $rec = biblio::record_entry->retrieve( $r ); - - return $rec->to_fieldmapper if ($rec); - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.biblio.record_entry.retrieve_by_barcode', - method => 'record_by_barcode', - api_level => 1, - cachable => 1, -); - -sub record_by_copy { - my $self = shift; - my $client = shift; - - my $cn_table = asset::call_number->table; - my $cp_table = asset::copy->table; - - my $id = ''.shift; - my ($r) = biblio::record_entry->db_Main->selectrow_array( <<" SQL", {}, $id ); - SELECT cn.record - FROM $cn_table cn - JOIN $cp_table cp ON (cp.call_number = cn.id) - WHERE cp.id = ? - SQL - - my $rec = biblio::record_entry->retrieve( $r ); - return undef unless ($rec); - - my $r_fm = $rec->to_fieldmapper; - my $ff = $rec->record_descriptor->next; - $r_fm->fixed_fields( $ff->to_fieldmapper ) if ($ff); - - return $r_fm; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.fleshed.biblio.record_entry.retrieve_by_copy', - method => 'record_by_copy', - api_level => 1, - cachable => 1, -); - - -=comment Old version - -my $org_unit_lookup; -sub record_copy_count { - my $self = shift; - my $client = shift; - my $oid = shift; - my @recs = @_; - - if ($self->api_name !~ /batch/o) { - @recs = ($recs[0]); - } - - throw OpenSRF::EX::InvalidArg ( "No org_unit id passed!" ) - unless ($oid); - - throw OpenSRF::EX::InvalidArg ( "No record id passed!" ) - unless (@recs); - - $org_unit_lookup ||= $self->method_lookup('open-ils.storage.direct.actor.org_unit.retrieve'); - my ($org_unit) = $org_unit_lookup->run($oid); - - # XXX Use descendancy tree here!!! - my $short_name_hack = $org_unit->shortname; - $short_name_hack = '' if (!$org_unit->parent_ou); - $short_name_hack .= '%'; - # XXX Use descendancy tree here!!! - - my $rec_list = join(',',@recs); - - my $cp_table = asset::copy->table; - my $cn_table = asset::call_number->table; - - my $select =<<" SQL"; - SELECT count(cp.*) as copies - FROM $cn_table cn - JOIN $cp_table cp ON (cp.call_number = cn.id) - WHERE cn.owning_lib LIKE ? AND - cn.record IN ($rec_list) - SQL - - my $sth = asset::copy->db_Main->prepare_cached($select); - $sth->execute($short_name_hack); - - my $results = $sth->fetchall_hashref('record'); - - $client->respond($$results{$_}{copies} || 0) for (@recs); - - return undef; -} -__PACKAGE__->register_method( - method => 'record_copy_count', - api_name => 'open-ils.storage.direct.biblio.record_copy_count', - api_level => 1, - argc => 1, -); -__PACKAGE__->register_method( - method => 'record_copy_count', - api_name => 'open-ils.storage.direct.biblio.record_copy_count.batch', - api_level => 1, - argc => 1, - stream => 1, -); - -=cut - -sub global_record_copy_count { - my $self = shift; - my $client = shift; - - my $rec = shift; - - my $cn_table = asset::call_number->table; - my $cp_table = asset::copy->table; - my $cl_table = asset::copy_location->table; - my $cs_table = config::copy_status->table; - - my $copies_visible = 'AND cp.opac_visible IS TRUE AND cs.opac_visible IS TRUE AND cl.opac_visible IS TRUE'; - $copies_visible = '' if ($self->api_name =~ /staff/o); - - my $sql = <<" SQL"; - - SELECT owning_lib, sum(avail), sum(tot) - FROM ( - SELECT cn.owning_lib, count(cp.id) as avail, 0 as tot - FROM $cn_table cn - JOIN $cp_table cp ON (cn.id = cp.call_number) - JOIN $cs_table cs ON (cs.id = cp.status) - JOIN $cl_table cl ON (cl.id = cp.location) - WHERE cn.record = ? - AND cp.status IN (0,7,12) - $copies_visible - GROUP BY 1 - UNION - SELECT cn.owning_lib, 0 as avail, count(cp.id) as tot - FROM $cn_table cn - JOIN $cp_table cp ON (cn.id = cp.call_number) - JOIN $cs_table cs ON (cs.id = cp.status) - JOIN $cl_table cl ON (cl.id = cp.location) - WHERE cn.record = ? - $copies_visible - GROUP BY 1 - ) x - GROUP BY 1 - SQL - - my $sth = biblio::record_entry->db_Main->prepare_cached($sql); - $sth->execute("$rec", "$rec"); - - $client->respond( $_ ) for (@{$sth->fetchall_arrayref}); - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.biblio.record_entry.global_copy_count', - method => 'global_record_copy_count', - api_level => 1, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.biblio.record_entry.global_copy_count.staff', - method => 'global_record_copy_count', - api_level => 1, - stream => 1, - cachable => 1, -); - -sub record_copy_status_count { - my $self = shift; - my $client = shift; - - my $rec = shift; - my $ou = shift || 1; - my $depth = shift || 0; - - - my $descendants = "actor.org_unit_descendants(?,?)"; - - my $cn_table = asset::call_number->table; - my $cp_table = asset::copy->table; - my $cl_table = asset::copy_location->table; - my $cs_table = config::copy_status->table; - - my $sql = <<" SQL"; - - SELECT cp.circ_lib, cn.label, cp.status, count(cp.id) - FROM $cp_table cp, - $cn_table cn, - $cl_table cl, - $cs_table cs, - $descendants d - WHERE cn.record = ? - AND cp.call_number = cn.id - AND cp.location = cl.id - AND cp.circ_lib = d.id - AND cp.status = cs.id - AND cl.opac_visible IS TRUE - AND cp.opac_visible IS TRUE - AND cp.deleted IS FALSE - AND cs.opac_visible IS TRUE - GROUP BY 1,2,3; - SQL - - my $sth = biblio::record_entry->db_Main->prepare_cached($sql); - $sth->execute($ou, $depth, "$rec" ); - - my %data = (); - for my $row (@{$sth->fetchall_arrayref}) { - $data{$$row[0]}{$$row[1]}{$$row[2]} += $$row[3]; - } - - for my $ou (keys %data) { - for my $cn (keys %{$data{$ou}}) { - $client->respond( [$ou, $cn, $data{$ou}{$cn}] ); - } - } - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.biblio.record_entry.status_copy_count', - method => 'record_copy_status_count', - api_level => 1, - stream => 1, - cachable => 1, -); - - -sub record_copy_status_location_count { - my $self = shift; - my $client = shift; - - my $rec = shift; - my $ou = shift || 1; - my $depth = shift || 0; - - - my $descendants = "actor.org_unit_descendants(?,?)"; - - my $cn_table = asset::call_number->table; - my $cp_table = asset::copy->table; - my $cl_table = asset::copy_location->table; - my $cs_table = config::copy_status->table; - - # FIXME using oils_i18n_xlate here is exposing a hitherto unexposed - # implementation detail of json_query; doing it this way because - # json_query currently doesn't grok joining a function to tables - my $sql = <<" SQL"; - - SELECT cp.circ_lib, - cn.label, - oils_i18n_xlate('asset.copy_location', 'acpl', 'name', 'id', cl.id::TEXT, ?), - cp.status, - count(cp.id) - FROM $cp_table cp, - $cn_table cn, - $cl_table cl, - $cs_table cs, - $descendants d - WHERE cn.record = ? - AND cp.call_number = cn.id - AND cp.location = cl.id - AND cp.circ_lib = d.id - AND cp.status = cs.id - AND cl.opac_visible IS TRUE - AND cp.opac_visible IS TRUE - AND cp.deleted IS FALSE - AND cs.opac_visible IS TRUE - GROUP BY 1,2,3,4; - SQL - - my $sth = biblio::record_entry->db_Main->prepare_cached($sql); - my $ses_locale = $client->session ? $client->session->session_locale : 'en-US'; - $sth->execute($ses_locale, $ou, $depth, "$rec" ); - - my %data = (); - for my $row (@{$sth->fetchall_arrayref}) { - $data{$$row[0]}{$$row[1]}{$$row[2]}{$$row[3]} += $$row[4]; - } - - for my $ou (keys %data) { - for my $cn (keys %{$data{$ou}}) { - for my $cl (keys %{$data{$ou}{$cn}}) { - $client->respond( [$ou, $cn, $cl, $data{$ou}{$cn}{$cl}] ); - } - } - } - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.biblio.record_entry.status_copy_location_count', - method => 'record_copy_status_location_count', - api_level => 1, - stream => 1, - cachable => 1, -); - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/config.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/config.pm deleted file mode 100644 index 33644ce437..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/config.pm +++ /dev/null @@ -1,81 +0,0 @@ -package OpenILS::Application::Storage::Publisher::config; -use base qw/OpenILS::Application::Storage/; -use OpenILS::Application::Storage::CDBI::config; - - -sub retrieve_all { - my $self = shift; - my $client = shift; - - $self->api_name =~ /direct\.config\.(.+)\.retrieve/o; - - my $class = 'config::'.$1; - for my $rec ( $class->retrieve_all ) { - $client->respond( $rec->to_fieldmapper ); - } - - return undef; -} - -for my $class ( - qw/metabib_field standing identification_type copy_status - non_cataloged_type audience_map item_form_map item_type_map - language_map lit_form_map bib_source net_access_level/ ) { - - __PACKAGE__->register_method( - method => 'retrieve_all', - api_name => "open-ils.storage.direct.config.$class.retrieve.all", - argc => 0, - stream => 1, - ); -} - - -# XXX arg, with the descendancy SPs... -sub ranged_config_non_cat { - my $self = shift; - my $client = shift; - my @binds = @_; - - my $ctable = config::non_cataloged_type->table; - - my $descendants = defined($binds[1]) ? - "actor.org_unit_full_path(?, ?)" : - "actor.org_unit_full_path(?)" ; - - - my $sql = <<" SQL"; - SELECT DISTINCT c.* - FROM $ctable c - JOIN $descendants d - ON (d.id = c.owning_lib) - SQL - - my $sth = config::non_cataloged_type->db_Main->prepare($sql); - $sth->execute(@binds); - - while ( my $rec = $sth->fetchrow_hashref ) { - - my $cnct = new Fieldmapper::config::non_cataloged_type; - $cnct->name($rec->{name}); - $cnct->owning_lib($rec->{owning_lib}); - $cnct->id($rec->{id}); - $cnct->circ_duration($rec->{circ_duration}); - $cnct->in_house($rec->{in_house}); - - $client->respond( $cnct ); - } - - return undef; -} -__PACKAGE__->register_method( - method => 'ranged_config_non_cat', - api_name => 'open-ils.storage.ranged.config.non_cataloged_type.retrieve', - argc => 1, - stream => 1, - notes => <<" NOTES", - Returns - NOTES -); - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/container.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/container.pm deleted file mode 100644 index fe60ee6336..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/container.pm +++ /dev/null @@ -1,6 +0,0 @@ -package OpenILS::Application::Storage::Publisher::container; -use base qw/OpenILS::Application::Storage/; -#use OpenILS::Application::Storage::CDBI::config; - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/metabib.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/metabib.pm deleted file mode 100644 index c70b5cd0ea..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/metabib.pm +++ /dev/null @@ -1,3192 +0,0 @@ -package OpenILS::Application::Storage::Publisher::metabib; -use base qw/OpenILS::Application::Storage::Publisher/; -use vars qw/$VERSION/; -use OpenSRF::EX qw/:try/; -use OpenILS::Application::Storage::FTS; -use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::Logger qw/:level/; -use OpenSRF::Utils::Cache; -use OpenSRF::Utils::JSON; -use Data::Dumper; -use Digest::MD5 qw/md5_hex/; - - -my $log = 'OpenSRF::Utils::Logger'; - -$VERSION = 1; - -sub ordered_records_from_metarecord { - my $self = shift; - my $client = shift; - my $mr = shift; - my $formats = shift; - my $org = shift || 1; - my $depth = shift; - - my (@types,@forms,@blvl); - - if ($formats) { - my ($t, $f, $b) = split '-', $formats; - @types = split '', $t; - @forms = split '', $f; - @blvl = split '', $b; - } - - my $descendants = - defined($depth) ? - "actor.org_unit_descendants($org, $depth)" : - "actor.org_unit_descendants($org)" ; - - - my $copies_visible = 'AND d.opac_visible IS TRUE AND cp.opac_visible IS TRUE AND cs.opac_visible IS TRUE AND cl.opac_visible IS TRUE'; - $copies_visible = '' if ($self->api_name =~ /staff/o); - - my $sm_table = metabib::metarecord_source_map->table; - my $rd_table = metabib::record_descriptor->table; - my $fr_table = metabib::full_rec->table; - my $cn_table = asset::call_number->table; - my $cl_table = asset::copy_location->table; - my $cp_table = asset::copy->table; - my $cs_table = config::copy_status->table; - my $src_table = config::bib_source->table; - my $out_table = actor::org_unit_type->table; - my $br_table = biblio::record_entry->table; - - my $sql = <<" SQL"; - SELECT record, - item_type, - item_form, - quality, - FIRST(COALESCE(LTRIM(SUBSTR( value, COALESCE(SUBSTRING(ind2 FROM E'\\\\d+'),'0')::INT + 1 )),'zzzzzzzz')) AS title - FROM ( - SELECT rd.record, - rd.item_type, - rd.item_form, - br.quality, - fr.tag, - fr.subfield, - fr.value, - fr.ind2 - SQL - - if ($copies_visible) { - $sql .= <<" SQL"; - FROM $sm_table sm, - $br_table br, - $fr_table fr, - $rd_table rd - WHERE rd.record = sm.source - AND fr.record = sm.source - AND br.id = sm.source - AND sm.metarecord = ? - AND (EXISTS ((SELECT 1 - FROM $cp_table cp - JOIN $cn_table cn ON (cp.call_number = cn.id) - JOIN $cs_table cs ON (cp.status = cs.id) - JOIN $cl_table cl ON (cp.location = cl.id) - JOIN $descendants d ON (cp.circ_lib = d.id) - WHERE cn.record = sm.source - $copies_visible - LIMIT 1)) - OR EXISTS (( - SELECT 1 - FROM $src_table src - WHERE src.id = br.source - AND src.transcendant IS TRUE)) - ) - - SQL - } else { - $sql .= <<" SQL"; - FROM $sm_table sm - JOIN $br_table br ON (sm.source = br.id) - JOIN $fr_table fr ON (fr.record = br.id) - JOIN $rd_table rd ON (rd.record = br.id) - WHERE sm.metarecord = ? - AND (( EXISTS ( - SELECT 1 - FROM $cp_table cp, - $cn_table cn, - $descendants d - WHERE cn.record = br.id - AND cn.deleted = FALSE - AND cp.deleted = FALSE - AND cp.circ_lib = d.id - AND cn.id = cp.call_number - LIMIT 1 - ) OR NOT EXISTS ( - SELECT 1 - FROM $cp_table cp, - $cn_table cn - WHERE cn.record = br.id - AND cn.deleted = FALSE - AND cp.deleted = FALSE - AND cn.id = cp.call_number - LIMIT 1 - )) - OR EXISTS (( - SELECT 1 - FROM $src_table src - WHERE src.id = br.source - AND src.transcendant IS TRUE)) - ) - SQL - } - - if (@types) { - $sql .= ' AND rd.item_type IN ('.join(',',map{'?'}@types).')'; - } - - if (@forms) { - $sql .= ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')'; - } - - if (@blvl) { - $sql .= ' AND rd.bib_level IN ('.join(',',map{'?'}@blvl).')'; - } - - - - $sql .= <<" SQL"; - OFFSET 0 - ) AS x - WHERE tag = '245' - AND subfield = 'a' - GROUP BY record, item_type, item_form, quality - ORDER BY - CASE - WHEN item_type IS NULL -- default - THEN 0 - WHEN item_type = '' -- default - THEN 0 - WHEN item_type IN ('a','t') -- books - THEN 1 - WHEN item_type = 'g' -- movies - THEN 2 - WHEN item_type IN ('i','j') -- sound recordings - THEN 3 - WHEN item_type = 'm' -- software - THEN 4 - WHEN item_type = 'k' -- images - THEN 5 - WHEN item_type IN ('e','f') -- maps - THEN 6 - WHEN item_type IN ('o','p') -- mixed - THEN 7 - WHEN item_type IN ('c','d') -- music - THEN 8 - WHEN item_type = 'r' -- 3d - THEN 9 - END, - title ASC, - quality DESC - SQL - - my $ids = metabib::metarecord_source_map->db_Main->selectcol_arrayref($sql, {}, "$mr", @types, @forms, @blvl); - return $ids if ($self->api_name =~ /atomic$/o); - - $client->respond( $_ ) for ( @$ids ); - return undef; - -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.ordered.metabib.metarecord.records', - method => 'ordered_records_from_metarecord', - api_level => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.ordered.metabib.metarecord.records.staff', - method => 'ordered_records_from_metarecord', - api_level => 1, - cachable => 1, -); - -__PACKAGE__->register_method( - api_name => 'open-ils.storage.ordered.metabib.metarecord.records.atomic', - method => 'ordered_records_from_metarecord', - api_level => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.ordered.metabib.metarecord.records.staff.atomic', - method => 'ordered_records_from_metarecord', - api_level => 1, - cachable => 1, -); - -sub isxn_search { - my $self = shift; - my $client = shift; - my $isxn = lc(shift()); - - $isxn =~ s/^\s*//o; - $isxn =~ s/\s*$//o; - $isxn =~ s/-//o if ($self->api_name =~ /isbn/o); - - my $tag = ($self->api_name =~ /isbn/o) ? "'020' OR f.tag = '024'" : "'022'"; - - my $fr_table = metabib::full_rec->table; - my $bib_table = biblio::record_entry->table; - - my $sql = <<" SQL"; - SELECT DISTINCT f.record - FROM $fr_table f - JOIN $bib_table b ON (b.id = f.record) - WHERE (f.tag = $tag) - AND f.value LIKE ? - AND b.deleted IS FALSE - SQL - - my $list = metabib::full_rec->db_Main->selectcol_arrayref($sql, {}, "$isxn%"); - $client->respond($_) for (@$list); - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.id_list.biblio.record_entry.search.isbn', - method => 'isxn_search', - api_level => 1, - stream => 1, -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.id_list.biblio.record_entry.search.issn', - method => 'isxn_search', - api_level => 1, - stream => 1, -); - -sub metarecord_copy_count { - my $self = shift; - my $client = shift; - - my %args = @_; - - my $sm_table = metabib::metarecord_source_map->table; - my $rd_table = metabib::record_descriptor->table; - my $cn_table = asset::call_number->table; - my $cp_table = asset::copy->table; - my $br_table = biblio::record_entry->table; - my $src_table = config::bib_source->table; - my $cl_table = asset::copy_location->table; - my $cs_table = config::copy_status->table; - my $out_table = actor::org_unit_type->table; - - my $descendants = "actor.org_unit_descendants(u.id)"; - my $ancestors = "actor.org_unit_ancestors(?) u JOIN $out_table t ON (u.ou_type = t.id)"; - - if ($args{org_unit} < 0) { - $args{org_unit} *= -1; - $ancestors = "(select org_unit as id from actor.org_lasso_map where lasso = ?) u CROSS JOIN (SELECT -1 AS depth) t"; - } - - my $copies_visible = 'AND a.opac_visible IS TRUE AND cp.opac_visible IS TRUE AND cs.opac_visible IS TRUE AND cl.opac_visible IS TRUE'; - $copies_visible = '' if ($self->api_name =~ /staff/o); - - my (@types,@forms,@blvl); - my ($t_filter, $f_filter, $b_filter) = ('','',''); - - if ($args{format}) { - my ($t, $f, $b) = split '-', $args{format}; - @types = split '', $t; - @forms = split '', $f; - @blvl = split '', $b; - - if (@types) { - $t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')'; - } - - if (@forms) { - $f_filter .= ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')'; - } - - if (@blvl) { - $b_filter .= ' AND rd.bib_level IN ('.join(',',map{'?'}@blvl).')'; - } - } - - my $sql = <<" SQL"; - SELECT t.depth, - u.id AS org_unit, - sum( - (SELECT count(cp.id) - FROM $sm_table r - JOIN $cn_table cn ON (cn.record = r.source) - JOIN $rd_table rd ON (cn.record = rd.record) - JOIN $cp_table cp ON (cn.id = cp.call_number) - JOIN $cs_table cs ON (cp.status = cs.id) - JOIN $cl_table cl ON (cp.location = cl.id) - JOIN $descendants a ON (cp.circ_lib = a.id) - WHERE r.metarecord = ? - AND cn.deleted IS FALSE - AND cp.deleted IS FALSE - $copies_visible - $t_filter - $f_filter - $b_filter - ) - ) AS count, - sum( - (SELECT count(cp.id) - FROM $sm_table r - JOIN $cn_table cn ON (cn.record = r.source) - JOIN $rd_table rd ON (cn.record = rd.record) - JOIN $cp_table cp ON (cn.id = cp.call_number) - JOIN $cs_table cs ON (cp.status = cs.id) - JOIN $cl_table cl ON (cp.location = cl.id) - JOIN $descendants a ON (cp.circ_lib = a.id) - WHERE r.metarecord = ? - AND cp.status IN (0,7,12) - AND cn.deleted IS FALSE - AND cp.deleted IS FALSE - $copies_visible - $t_filter - $f_filter - $b_filter - ) - ) AS available, - sum( - (SELECT count(cp.id) - FROM $sm_table r - JOIN $cn_table cn ON (cn.record = r.source) - JOIN $rd_table rd ON (cn.record = rd.record) - JOIN $cp_table cp ON (cn.id = cp.call_number) - JOIN $cs_table cs ON (cp.status = cs.id) - JOIN $cl_table cl ON (cp.location = cl.id) - WHERE r.metarecord = ? - AND cn.deleted IS FALSE - AND cp.deleted IS FALSE - AND cp.opac_visible IS TRUE - AND cs.opac_visible IS TRUE - AND cl.opac_visible IS TRUE - $t_filter - $f_filter - $b_filter - ) - ) AS unshadow, - sum( - (SELECT sum(1) - FROM $sm_table r - JOIN $br_table br ON (br.id = r.source) - JOIN $src_table src ON (src.id = br.source) - WHERE r.metarecord = ? - AND src.transcendant IS TRUE - ) - ) AS transcendant - - FROM $ancestors - GROUP BY 1,2 - SQL - - my $sth = metabib::metarecord_source_map->db_Main->prepare_cached($sql); - $sth->execute( ''.$args{metarecord}, - @types, - @forms, - @blvl, - ''.$args{metarecord}, - @types, - @forms, - @blvl, - ''.$args{metarecord}, - @types, - @forms, - @blvl, - ''.$args{metarecord}, - ''.$args{org_unit}, - ); - - while ( my $row = $sth->fetchrow_hashref ) { - $client->respond( $row ); - } - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.metabib.metarecord.copy_count', - method => 'metarecord_copy_count', - api_level => 1, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.metabib.metarecord.copy_count.staff', - method => 'metarecord_copy_count', - api_level => 1, - stream => 1, - cachable => 1, -); - -sub biblio_multi_search_full_rec { - my $self = shift; - my $client = shift; - my %args = @_; - - my $class_join = $args{class_join} || 'AND'; - my $limit = $args{limit} || 100; - my $offset = $args{offset} || 0; - my $sort = $args{'sort'}; - my $sort_dir = $args{sort_dir} || 'DESC'; - - my @binds; - my @selects; - - for my $arg (@{ $args{searches} }) { - my $term = $$arg{term}; - my $limiters = $$arg{restrict}; - - my ($index_col) = metabib::full_rec->columns('FTS'); - $index_col ||= 'value'; - my $search_table = metabib::full_rec->table; - - my $fts = OpenILS::Application::Storage::FTS->compile('default' => $term, 'value',"$index_col"); - - my $fts_where = $fts->sql_where_clause(); - my @fts_ranks = $fts->fts_rank; - - my $rank = join(' + ', @fts_ranks); - - my @wheres; - for my $limit (@$limiters) { - if ($$limit{tag} =~ /^\d+$/ and $$limit{tag} < 10) { - # MARC control field; mfr.subfield is NULL - push @wheres, "( tag = ? AND $fts_where )"; - push @binds, $$limit{tag}; - $log->debug("Limiting query using { tag => $$limit{tag} }", DEBUG); - } else { - push @wheres, "( tag = ? AND subfield LIKE ? AND $fts_where )"; - push @binds, $$limit{tag}, $$limit{subfield}; - $log->debug("Limiting query using { tag => $$limit{tag}, subfield => $$limit{subfield} }", DEBUG); - } - } - my $where = join(' OR ', @wheres); - - push @selects, "SELECT id, record, $rank as sum FROM $search_table WHERE $where"; - - } - - my $descendants = defined($args{depth}) ? - "actor.org_unit_descendants($args{org_unit}, $args{depth})" : - "actor.org_unit_descendants($args{org_unit})" ; - - - my $metabib_record_descriptor = metabib::record_descriptor->table; - my $metabib_full_rec = metabib::full_rec->table; - my $asset_call_number_table = asset::call_number->table; - my $asset_copy_table = asset::copy->table; - my $cs_table = config::copy_status->table; - my $cl_table = asset::copy_location->table; - my $br_table = biblio::record_entry->table; - - my $cj = 'HAVING COUNT(x.id) = ' . scalar(@selects) if ($class_join eq 'AND'); - my $search_table = - '(SELECT x.record, sum(x.sum) FROM (('. - join(') UNION ALL (', @selects). - ")) x GROUP BY 1 $cj ORDER BY 2 DESC )"; - - my $has_vols = 'AND cn.owning_lib = d.id'; - my $has_copies = 'AND cp.call_number = cn.id'; - my $copies_visible = 'AND d.opac_visible IS TRUE AND cp.opac_visible IS TRUE AND cs.opac_visible IS TRUE AND cl.opac_visible IS TRUE'; - - if ($self->api_name =~ /staff/o) { - $copies_visible = ''; - $has_copies = '' if ($ou_type == 0); - $has_vols = '' if ($ou_type == 0); - } - - my ($t_filter, $f_filter) = ('',''); - my ($a_filter, $l_filter, $lf_filter) = ('','',''); - - if (my $a = $args{audience}) { - $a = [$a] if (!ref($a)); - my @aud = @$a; - - $a_filter = ' AND rd.audience IN ('.join(',',map{'?'}@aud).')'; - push @binds, @aud; - } - - if (my $l = $args{language}) { - $l = [$l] if (!ref($l)); - my @lang = @$l; - - $l_filter = ' AND rd.item_lang IN ('.join(',',map{'?'}@lang).')'; - push @binds, @lang; - } - - if (my $f = $args{lit_form}) { - $f = [$f] if (!ref($f)); - my @lit_form = @$f; - - $lf_filter = ' AND rd.lit_form IN ('.join(',',map{'?'}@lit_form).')'; - push @binds, @lit_form; - } - - if (my $f = $args{item_form}) { - $f = [$f] if (!ref($f)); - my @forms = @$f; - - $f_filter = ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')'; - push @binds, @forms; - } - - if (my $t = $args{item_type}) { - $t = [$t] if (!ref($t)); - my @types = @$t; - - $t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')'; - push @binds, @types; - } - - - if ($args{format}) { - my ($t, $f) = split '-', $args{format}; - my @types = split '', $t; - my @forms = split '', $f; - if (@types) { - $t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')'; - } - - if (@forms) { - $f_filter .= ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')'; - } - push @binds, @types, @forms; - } - - my $relevance = 'sum(f.sum)'; - $relevance = 1 if (!$copies_visible); - - my $rank = $relevance; - if (lc($sort) eq 'pubdate') { - $rank = <<" RANK"; - ( FIRST (( - SELECT COALESCE(SUBSTRING(frp.value FROM E'\\\\d+'),'9999')::INT - FROM $metabib_full_rec frp - WHERE frp.record = f.record - AND frp.tag = '260' - AND frp.subfield = 'c' - LIMIT 1 - )) ) - RANK - } elsif (lc($sort) eq 'create_date') { - $rank = <<" RANK"; - ( FIRST (( SELECT create_date FROM $br_table rbr WHERE rbr.id = f.record)) ) - RANK - } elsif (lc($sort) eq 'edit_date') { - $rank = <<" RANK"; - ( FIRST (( SELECT edit_date FROM $br_table rbr WHERE rbr.id = f.record)) ) - RANK - } elsif (lc($sort) eq 'title') { - $rank = <<" RANK"; - ( FIRST (( - SELECT COALESCE(LTRIM(SUBSTR( frt.value, COALESCE(SUBSTRING(frt.ind2 FROM E'\\\\d+'),'0')::INT + 1 )),'zzzzzzzz') - FROM $metabib_full_rec frt - WHERE frt.record = f.record - AND frt.tag = '245' - AND frt.subfield = 'a' - LIMIT 1 - )) ) - RANK - } elsif (lc($sort) eq 'author') { - $rank = <<" RANK"; - ( FIRST(( - SELECT COALESCE(LTRIM(fra.value),'zzzzzzzz') - FROM $metabib_full_rec fra - WHERE fra.record = f.record - AND fra.tag LIKE '1%' - AND fra.subfield = 'a' - ORDER BY fra.tag::text::int - LIMIT 1 - )) ) - RANK - } else { - $sort = undef; - } - - - if ($copies_visible) { - $select = <<" SQL"; - SELECT f.record, $relevance, count(DISTINCT cp.id), $rank - FROM $search_table f, - $asset_call_number_table cn, - $asset_copy_table cp, - $cs_table cs, - $cl_table cl, - $br_table br, - $metabib_record_descriptor rd, - $descendants d - WHERE br.id = f.record - AND cn.record = f.record - AND rd.record = f.record - AND cp.status = cs.id - AND cp.location = cl.id - AND br.deleted IS FALSE - AND cn.deleted IS FALSE - AND cp.deleted IS FALSE - $has_vols - $has_copies - $copies_visible - $t_filter - $f_filter - $a_filter - $l_filter - $lf_filter - GROUP BY f.record HAVING count(DISTINCT cp.id) > 0 - ORDER BY 4 $sort_dir,3 DESC - SQL - } else { - $select = <<" SQL"; - SELECT f.record, 1, 1, $rank - FROM $search_table f, - $br_table br, - $metabib_record_descriptor rd - WHERE br.id = f.record - AND rd.record = f.record - AND br.deleted IS FALSE - $t_filter - $f_filter - $a_filter - $l_filter - $lf_filter - GROUP BY 1,2,3 - ORDER BY 4 $sort_dir - SQL - } - - - $log->debug("Search SQL :: [$select]",DEBUG); - - my $recs = metabib::full_rec->db_Main->selectall_arrayref("$select;", {}, @binds); - $log->debug("Search yielded ".scalar(@$recs)." results.",DEBUG); - - my $max = 0; - $max = 1 if (!@$recs); - for (@$recs) { - $max = $$_[1] if ($$_[1] > $max); - } - - my $count = @$recs; - for my $rec (@$recs[$offset .. $offset + $limit - 1]) { - next unless ($$rec[0]); - my ($rid,$rank,$junk,$skip) = @$rec; - $client->respond( [$rid, sprintf('%0.3f',$rank/$max), $count] ); - } - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.biblio.full_rec.multi_search', - method => 'biblio_multi_search_full_rec', - api_level => 1, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.biblio.full_rec.multi_search.staff', - method => 'biblio_multi_search_full_rec', - api_level => 1, - stream => 1, - cachable => 1, -); - -sub search_full_rec { - my $self = shift; - my $client = shift; - - my %args = @_; - - my $term = $args{term}; - my $limiters = $args{restrict}; - - my ($index_col) = metabib::full_rec->columns('FTS'); - $index_col ||= 'value'; - my $search_table = metabib::full_rec->table; - - my $fts = OpenILS::Application::Storage::FTS->compile('default' => $term, 'value',"$index_col"); - - my $fts_where = $fts->sql_where_clause(); - my @fts_ranks = $fts->fts_rank; - - my $rank = join(' + ', @fts_ranks); - - my @binds; - my @wheres; - for my $limit (@$limiters) { - if ($$limit{tag} =~ /^\d+$/ and $$limit{tag} < 10) { - # MARC control field; mfr.subfield is NULL - push @wheres, "( tag = ? AND $fts_where )"; - push @binds, $$limit{tag}; - $log->debug("Limiting query using { tag => $$limit{tag} }", DEBUG); - } else { - push @wheres, "( tag = ? AND subfield LIKE ? AND $fts_where )"; - push @binds, $$limit{tag}, $$limit{subfield}; - $log->debug("Limiting query using { tag => $$limit{tag}, subfield => $$limit{subfield} }", DEBUG); - } - } - my $where = join(' OR ', @wheres); - - my $select = "SELECT record, sum($rank) FROM $search_table WHERE $where GROUP BY 1 ORDER BY 2 DESC;"; - - $log->debug("Search SQL :: [$select]",DEBUG); - - my $recs = metabib::full_rec->db_Main->selectall_arrayref($select, {}, @binds); - $log->debug("Search yielded ".scalar(@$recs)." results.",DEBUG); - - $client->respond($_) for (@$recs); - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.storage.direct.metabib.full_rec.search_fts.value', - method => 'search_full_rec', - api_level => 1, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => 'open-ils.storage.direct.metabib.full_rec.search_fts.index_vector', - method => 'search_full_rec', - api_level => 1, - stream => 1, - cachable => 1, -); - - -# XXX factored most of the PG dependant stuff out of here... need to find a way to do "dependants". -sub search_class_fts { - my $self = shift; - my $client = shift; - my %args = @_; - - my $term = $args{term}; - my $ou = $args{org_unit}; - my $ou_type = $args{depth}; - my $limit = $args{limit}; - my $offset = $args{offset}; - - my $limit_clause = ''; - my $offset_clause = ''; - - $limit_clause = "LIMIT $limit" if (defined $limit and int($limit) > 0); - $offset_clause = "OFFSET $offset" if (defined $offset and int($offset) > 0); - - my (@types,@forms); - my ($t_filter, $f_filter) = ('',''); - - if ($args{format}) { - my ($t, $f) = split '-', $args{format}; - @types = split '', $t; - @forms = split '', $f; - if (@types) { - $t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')'; - } - - if (@forms) { - $f_filter .= ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')'; - } - } - - - - my $descendants = defined($ou_type) ? - "actor.org_unit_descendants($ou, $ou_type)" : - "actor.org_unit_descendants($ou)"; - - my $class = $self->{cdbi}; - my $search_table = $class->table; - - my $metabib_record_descriptor = metabib::record_descriptor->table; - my $metabib_metarecord = metabib::metarecord->table; - my $metabib_metarecord_source_map_table = metabib::metarecord_source_map->table; - my $asset_call_number_table = asset::call_number->table; - my $asset_copy_table = asset::copy->table; - my $cs_table = config::copy_status->table; - my $cl_table = asset::copy_location->table; - - my ($index_col) = $class->columns('FTS'); - $index_col ||= 'value'; - - (my $search_class = $self->api_name) =~ s/.*metabib.(\w+).search_fts.*/$1/o; - my $fts = OpenILS::Application::Storage::FTS->compile($search_class => $term, 'f.value', "f.$index_col"); - - my $fts_where = $fts->sql_where_clause; - my @fts_ranks = $fts->fts_rank; - - my $rank = join(' + ', @fts_ranks); - - my $has_vols = 'AND cn.owning_lib = d.id'; - my $has_copies = 'AND cp.call_number = cn.id'; - my $copies_visible = 'AND d.opac_visible IS TRUE AND cp.opac_visible IS TRUE AND cs.opac_visible IS TRUE AND cl.opac_visible IS TRUE'; - - my $visible_count = ', count(DISTINCT cp.id)'; - my $visible_count_test = 'HAVING count(DISTINCT cp.id) > 0'; - - if ($self->api_name =~ /staff/o) { - $copies_visible = ''; - $visible_count_test = ''; - $has_copies = '' if ($ou_type == 0); - $has_vols = '' if ($ou_type == 0); - } - - my $rank_calc = <<" RANK"; - , (SUM( $rank - * CASE WHEN f.value ILIKE ? THEN 1.2 ELSE 1 END -- phrase order - * CASE WHEN f.value ILIKE ? THEN 1.5 ELSE 1 END -- first word match - * CASE WHEN f.value ~* ? THEN 2 ELSE 1 END -- only word match - )/COUNT(m.source)), MIN(COALESCE(CHAR_LENGTH(f.value),1)) - RANK - - $rank_calc = ',1 , 1' if ($self->api_name =~ /unordered/o); - - if ($copies_visible) { - $select = <<" SQL"; - SELECT m.metarecord $rank_calc $visible_count, CASE WHEN COUNT(DISTINCT m.source) = 1 THEN MAX(m.source) ELSE MAX(0) END - FROM $search_table f, - $metabib_metarecord_source_map_table m, - $asset_call_number_table cn, - $asset_copy_table cp, - $cs_table cs, - $cl_table cl, - $metabib_record_descriptor rd, - $descendants d - WHERE $fts_where - AND m.source = f.source - AND cn.record = m.source - AND rd.record = m.source - AND cp.status = cs.id - AND cp.location = cl.id - $has_vols - $has_copies - $copies_visible - $t_filter - $f_filter - GROUP BY 1 $visible_count_test - ORDER BY 2 DESC,3 - $limit_clause $offset_clause - SQL - } else { - $select = <<" SQL"; - SELECT m.metarecord $rank_calc, 0, CASE WHEN COUNT(DISTINCT m.source) = 1 THEN MAX(m.source) ELSE MAX(0) END - FROM $search_table f, - $metabib_metarecord_source_map_table m, - $metabib_record_descriptor rd - WHERE $fts_where - AND m.source = f.source - AND rd.record = m.source - $t_filter - $f_filter - GROUP BY 1, 4 - ORDER BY 2 DESC,3 - $limit_clause $offset_clause - SQL - } - - $log->debug("Field Search SQL :: [$select]",DEBUG); - - my $SQLstring = join('%',$fts->words); - my $REstring = join('\\s+',$fts->words); - my $first_word = ($fts->words)[0].'%'; - my $recs = ($self->api_name =~ /unordered/o) ? - $class->db_Main->selectall_arrayref($select, {}, @types, @forms) : - $class->db_Main->selectall_arrayref($select, {}, - '%'.lc($SQLstring).'%', # phrase order match - lc($first_word), # first word match - '^\\s*'.lc($REstring).'\\s*/?\s*$', # full exact match - @types, @forms - ); - - $log->debug("Search yielded ".scalar(@$recs)." results.",DEBUG); - - $client->respond($_) for (map { [@$_[0,1,3,4]] } @$recs); - return undef; -} - -for my $class ( qw/title author subject keyword series identifier/ ) { - __PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.$class.search_fts.metarecord", - method => 'search_class_fts', - api_level => 1, - stream => 1, - cdbi => "metabib::${class}_field_entry", - cachable => 1, - ); - __PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.$class.search_fts.metarecord.unordered", - method => 'search_class_fts', - api_level => 1, - stream => 1, - cdbi => "metabib::${class}_field_entry", - cachable => 1, - ); - __PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.$class.search_fts.metarecord.staff", - method => 'search_class_fts', - api_level => 1, - stream => 1, - cdbi => "metabib::${class}_field_entry", - cachable => 1, - ); - __PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.$class.search_fts.metarecord.staff.unordered", - method => 'search_class_fts', - api_level => 1, - stream => 1, - cdbi => "metabib::${class}_field_entry", - cachable => 1, - ); -} - -# XXX factored most of the PG dependant stuff out of here... need to find a way to do "dependants". -sub search_class_fts_count { - my $self = shift; - my $client = shift; - my %args = @_; - - my $term = $args{term}; - my $ou = $args{org_unit}; - my $ou_type = $args{depth}; - my $limit = $args{limit} || 100; - my $offset = $args{offset} || 0; - - my $descendants = defined($ou_type) ? - "actor.org_unit_descendants($ou, $ou_type)" : - "actor.org_unit_descendants($ou)"; - - my (@types,@forms); - my ($t_filter, $f_filter) = ('',''); - - if ($args{format}) { - my ($t, $f) = split '-', $args{format}; - @types = split '', $t; - @forms = split '', $f; - if (@types) { - $t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')'; - } - - if (@forms) { - $f_filter .= ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')'; - } - } - - - (my $search_class = $self->api_name) =~ s/.*metabib.(\w+).search_fts.*/$1/o; - - my $class = $self->{cdbi}; - my $search_table = $class->table; - - my $metabib_record_descriptor = metabib::record_descriptor->table; - my $metabib_metarecord_source_map_table = metabib::metarecord_source_map->table; - my $asset_call_number_table = asset::call_number->table; - my $asset_copy_table = asset::copy->table; - my $cs_table = config::copy_status->table; - my $cl_table = asset::copy_location->table; - - my ($index_col) = $class->columns('FTS'); - $index_col ||= 'value'; - - my $fts = OpenILS::Application::Storage::FTS->compile($search_class => $term, 'value',"$index_col"); - - my $fts_where = $fts->sql_where_clause; - - my $has_vols = 'AND cn.owning_lib = d.id'; - my $has_copies = 'AND cp.call_number = cn.id'; - my $copies_visible = 'AND d.opac_visible IS TRUE AND cp.opac_visible IS TRUE AND cs.opac_visible IS TRUE AND cl.opac_visible IS TRUE'; - if ($self->api_name =~ /staff/o) { - $copies_visible = ''; - $has_vols = '' if ($ou_type == 0); - $has_copies = '' if ($ou_type == 0); - } - - # XXX test an "EXISTS version of descendant checking... - my $select; - if ($copies_visible) { - $select = <<" SQL"; - SELECT count(distinct m.metarecord) - FROM $search_table f, - $metabib_metarecord_source_map_table m, - $metabib_metarecord_source_map_table mr, - $asset_call_number_table cn, - $asset_copy_table cp, - $cs_table cs, - $cl_table cl, - $metabib_record_descriptor rd, - $descendants d - WHERE $fts_where - AND mr.source = f.source - AND mr.metarecord = m.metarecord - AND cn.record = m.source - AND rd.record = m.source - AND cp.status = cs.id - AND cp.location = cl.id - $has_vols - $has_copies - $copies_visible - $t_filter - $f_filter - SQL - } else { - $select = <<" SQL"; - SELECT count(distinct m.metarecord) - FROM $search_table f, - $metabib_metarecord_source_map_table m, - $metabib_metarecord_source_map_table mr, - $metabib_record_descriptor rd - WHERE $fts_where - AND mr.source = f.source - AND mr.metarecord = m.metarecord - AND rd.record = m.source - $t_filter - $f_filter - SQL - } - - $log->debug("Field Search Count SQL :: [$select]",DEBUG); - - my $recs = $class->db_Main->selectrow_arrayref($select, {}, @types, @forms)->[0]; - - $log->debug("Count Search yielded $recs results.",DEBUG); - - return $recs; - -} -for my $class ( qw/title author subject keyword series identifier/ ) { - __PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.$class.search_fts.metarecord_count", - method => 'search_class_fts_count', - api_level => 1, - stream => 1, - cdbi => "metabib::${class}_field_entry", - cachable => 1, - ); - __PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.$class.search_fts.metarecord_count.staff", - method => 'search_class_fts_count', - api_level => 1, - stream => 1, - cdbi => "metabib::${class}_field_entry", - cachable => 1, - ); -} - - -# XXX factored most of the PG dependant stuff out of here... need to find a way to do "dependants". -sub postfilter_search_class_fts { - my $self = shift; - my $client = shift; - my %args = @_; - - my $term = $args{term}; - my $sort = $args{'sort'}; - my $sort_dir = $args{sort_dir} || 'DESC'; - my $ou = $args{org_unit}; - my $ou_type = $args{depth}; - my $limit = $args{limit} || 10; - my $visibility_limit = $args{visibility_limit} || 5000; - my $offset = $args{offset} || 0; - - my $outer_limit = 1000; - - my $limit_clause = ''; - my $offset_clause = ''; - - $limit_clause = "LIMIT $outer_limit"; - $offset_clause = "OFFSET $offset" if (defined $offset and int($offset) > 0); - - my (@types,@forms,@lang,@aud,@lit_form); - my ($t_filter, $f_filter) = ('',''); - my ($a_filter, $l_filter, $lf_filter) = ('','',''); - my ($ot_filter, $of_filter) = ('',''); - my ($oa_filter, $ol_filter, $olf_filter) = ('','',''); - - if (my $a = $args{audience}) { - $a = [$a] if (!ref($a)); - @aud = @$a; - - $a_filter = ' AND rd.audience IN ('.join(',',map{'?'}@aud).')'; - $oa_filter = ' AND ord.audience IN ('.join(',',map{'?'}@aud).')'; - } - - if (my $l = $args{language}) { - $l = [$l] if (!ref($l)); - @lang = @$l; - - $l_filter = ' AND rd.item_lang IN ('.join(',',map{'?'}@lang).')'; - $ol_filter = ' AND ord.item_lang IN ('.join(',',map{'?'}@lang).')'; - } - - if (my $f = $args{lit_form}) { - $f = [$f] if (!ref($f)); - @lit_form = @$f; - - $lf_filter = ' AND rd.lit_form IN ('.join(',',map{'?'}@lit_form).')'; - $olf_filter = ' AND ord.lit_form IN ('.join(',',map{'?'}@lit_form).')'; - } - - if ($args{format}) { - my ($t, $f) = split '-', $args{format}; - @types = split '', $t; - @forms = split '', $f; - if (@types) { - $t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')'; - $ot_filter = ' AND ord.item_type IN ('.join(',',map{'?'}@types).')'; - } - - if (@forms) { - $f_filter .= ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')'; - $of_filter .= ' AND ord.item_form IN ('.join(',',map{'?'}@forms).')'; - } - } - - - my $descendants = defined($ou_type) ? - "actor.org_unit_descendants($ou, $ou_type)" : - "actor.org_unit_descendants($ou)"; - - my $class = $self->{cdbi}; - my $search_table = $class->table; - - my $metabib_full_rec = metabib::full_rec->table; - my $metabib_record_descriptor = metabib::record_descriptor->table; - my $metabib_metarecord = metabib::metarecord->table; - my $metabib_metarecord_source_map_table = metabib::metarecord_source_map->table; - my $asset_call_number_table = asset::call_number->table; - my $asset_copy_table = asset::copy->table; - my $cs_table = config::copy_status->table; - my $cl_table = asset::copy_location->table; - my $br_table = biblio::record_entry->table; - - my ($index_col) = $class->columns('FTS'); - $index_col ||= 'value'; - - (my $search_class = $self->api_name) =~ s/.*metabib.(\w+).post_filter.*/$1/o; - - my $fts = OpenILS::Application::Storage::FTS->compile($search_class => $term, 'f.value', "f.$index_col"); - - my $SQLstring = join('%',map { lc($_) } $fts->words); - my $REstring = '^' . join('\s+',map { lc($_) } $fts->words) . '\W*$'; - my $first_word = lc(($fts->words)[0]).'%'; - - my $fts_where = $fts->sql_where_clause; - my @fts_ranks = $fts->fts_rank; - - my %bonus = (); - $bonus{'metabib::identifier_field_entry'} = - $bonus{'metabib::keyword_field_entry'} = [ - { 'CASE WHEN f.value ILIKE ? THEN 1.2 ELSE 1 END' => $SQLstring } - ]; - - $bonus{'metabib::title_field_entry'} = - $bonus{'metabib::series_field_entry'} = [ - { 'CASE WHEN f.value ILIKE ? THEN 1.5 ELSE 1 END' => $first_word }, - { 'CASE WHEN f.value ~* ? THEN 2 ELSE 1 END' => $REstring }, - @{ $bonus{'metabib::keyword_field_entry'} } - ]; - - my $bonus_list = join ' * ', map { keys %$_ } @{ $bonus{$class} }; - $bonus_list ||= '1'; - - my @bonus_values = map { values %$_ } @{ $bonus{$class} }; - - my $relevance = join(' + ', @fts_ranks); - $relevance = <<" RANK"; - (SUM( ( $relevance ) * ( $bonus_list ) )/COUNT(m.source)) - RANK - - my $string_default_sort = 'zzzz'; - $string_default_sort = 'AAAA' if ($sort_dir eq 'DESC'); - - my $number_default_sort = '9999'; - $number_default_sort = '0000' if ($sort_dir eq 'DESC'); - - my $rank = $relevance; - if (lc($sort) eq 'pubdate') { - $rank = <<" RANK"; - ( FIRST (( - SELECT COALESCE(SUBSTRING(frp.value FROM E'\\\\d+'),'$number_default_sort')::INT - FROM $metabib_full_rec frp - WHERE frp.record = mr.master_record - AND frp.tag = '260' - AND frp.subfield = 'c' - LIMIT 1 - )) ) - RANK - } elsif (lc($sort) eq 'create_date') { - $rank = <<" RANK"; - ( FIRST (( SELECT create_date FROM $br_table rbr WHERE rbr.id = mr.master_record)) ) - RANK - } elsif (lc($sort) eq 'edit_date') { - $rank = <<" RANK"; - ( FIRST (( SELECT edit_date FROM $br_table rbr WHERE rbr.id = mr.master_record)) ) - RANK - } elsif (lc($sort) eq 'title') { - $rank = <<" RANK"; - ( FIRST (( - SELECT COALESCE(LTRIM(SUBSTR( frt.value, COALESCE(SUBSTRING(frt.ind2 FROM E'\\\\d+'),'0')::INT + 1 )),'$string_default_sort') - FROM $metabib_full_rec frt - WHERE frt.record = mr.master_record - AND frt.tag = '245' - AND frt.subfield = 'a' - LIMIT 1 - )) ) - RANK - } elsif (lc($sort) eq 'author') { - $rank = <<" RANK"; - ( FIRST(( - SELECT COALESCE(LTRIM(fra.value),'$string_default_sort') - FROM $metabib_full_rec fra - WHERE fra.record = mr.master_record - AND fra.tag LIKE '1%' - AND fra.subfield = 'a' - ORDER BY fra.tag::text::int - LIMIT 1 - )) ) - RANK - } else { - $sort = undef; - } - - my $select = <<" SQL"; - SELECT m.metarecord, - $relevance, - CASE WHEN COUNT(DISTINCT smrs.source) = 1 THEN MIN(m.source) ELSE 0 END, - $rank - FROM $search_table f, - $metabib_metarecord_source_map_table m, - $metabib_metarecord_source_map_table smrs, - $metabib_metarecord mr, - $metabib_record_descriptor rd - WHERE $fts_where - AND smrs.metarecord = mr.id - AND m.source = f.source - AND m.metarecord = mr.id - AND rd.record = smrs.source - $t_filter - $f_filter - $a_filter - $l_filter - $lf_filter - GROUP BY m.metarecord - ORDER BY 4 $sort_dir, MIN(COALESCE(CHAR_LENGTH(f.value),1)) - LIMIT $visibility_limit - SQL - - if (0) { - $select = <<" SQL"; - - SELECT DISTINCT s.* - FROM $asset_call_number_table cn, - $metabib_metarecord_source_map_table mrs, - $asset_copy_table cp, - $cs_table cs, - $cl_table cl, - $br_table br, - $descendants d, - $metabib_record_descriptor ord, - ($select) s - WHERE mrs.metarecord = s.metarecord - AND br.id = mrs.source - AND cn.record = mrs.source - AND cp.status = cs.id - AND cp.location = cl.id - AND cn.owning_lib = d.id - AND cp.call_number = cn.id - AND cp.opac_visible IS TRUE - AND cs.opac_visible IS TRUE - AND cl.opac_visible IS TRUE - AND d.opac_visible IS TRUE - AND br.active IS TRUE - AND br.deleted IS FALSE - AND ord.record = mrs.source - $ot_filter - $of_filter - $oa_filter - $ol_filter - $olf_filter - ORDER BY 4 $sort_dir - SQL - } elsif ($self->api_name !~ /staff/o) { - $select = <<" SQL"; - - SELECT DISTINCT s.* - FROM ($select) s - WHERE EXISTS ( - SELECT 1 - FROM $asset_call_number_table cn, - $metabib_metarecord_source_map_table mrs, - $asset_copy_table cp, - $cs_table cs, - $cl_table cl, - $br_table br, - $descendants d, - $metabib_record_descriptor ord - - WHERE mrs.metarecord = s.metarecord - AND br.id = mrs.source - AND cn.record = mrs.source - AND cp.status = cs.id - AND cp.location = cl.id - AND cp.circ_lib = d.id - AND cp.call_number = cn.id - AND cp.opac_visible IS TRUE - AND cs.opac_visible IS TRUE - AND cl.opac_visible IS TRUE - AND d.opac_visible IS TRUE - AND br.active IS TRUE - AND br.deleted IS FALSE - AND ord.record = mrs.source - $ot_filter - $of_filter - $oa_filter - $ol_filter - $olf_filter - LIMIT 1 - ) - ORDER BY 4 $sort_dir - SQL - } else { - $select = <<" SQL"; - - SELECT DISTINCT s.* - FROM ($select) s - WHERE EXISTS ( - SELECT 1 - FROM $asset_call_number_table cn, - $asset_copy_table cp, - $metabib_metarecord_source_map_table mrs, - $br_table br, - $descendants d, - $metabib_record_descriptor ord - - WHERE mrs.metarecord = s.metarecord - AND br.id = mrs.source - AND cn.record = mrs.source - AND cn.id = cp.call_number - AND br.deleted IS FALSE - AND cn.deleted IS FALSE - AND ord.record = mrs.source - AND ( cn.owning_lib = d.id - OR ( cp.circ_lib = d.id - AND cp.deleted IS FALSE - ) - ) - $ot_filter - $of_filter - $oa_filter - $ol_filter - $olf_filter - LIMIT 1 - ) - OR NOT EXISTS ( - SELECT 1 - FROM $asset_call_number_table cn, - $metabib_metarecord_source_map_table mrs, - $metabib_record_descriptor ord - WHERE mrs.metarecord = s.metarecord - AND cn.record = mrs.source - AND ord.record = mrs.source - $ot_filter - $of_filter - $oa_filter - $ol_filter - $olf_filter - LIMIT 1 - ) - ORDER BY 4 $sort_dir - SQL - } - - - $log->debug("Field Search SQL :: [$select]",DEBUG); - - my $recs = $class->db_Main->selectall_arrayref( - $select, {}, - (@bonus_values > 0 ? @bonus_values : () ), - ( (!$sort && @bonus_values > 0) ? @bonus_values : () ), - @types, @forms, @aud, @lang, @lit_form, - @types, @forms, @aud, @lang, @lit_form, - ($self->api_name =~ /staff/o ? (@types, @forms, @aud, @lang, @lit_form) : () ) ); - - $log->debug("Search yielded ".scalar(@$recs)." results.",DEBUG); - - my $max = 0; - $max = 1 if (!@$recs); - for (@$recs) { - $max = $$_[1] if ($$_[1] > $max); - } - - my $count = scalar(@$recs); - for my $rec (@$recs[$offset .. $offset + $limit - 1]) { - my ($mrid,$rank,$skip) = @$rec; - $client->respond( [$mrid, sprintf('%0.3f',$rank/$max), $skip, $count] ); - } - return undef; -} - -for my $class ( qw/title author subject keyword series identifier/ ) { - __PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.$class.post_filter.search_fts.metarecord", - method => 'postfilter_search_class_fts', - api_level => 1, - stream => 1, - cdbi => "metabib::${class}_field_entry", - cachable => 1, - ); - __PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.$class.post_filter.search_fts.metarecord.staff", - method => 'postfilter_search_class_fts', - api_level => 1, - stream => 1, - cdbi => "metabib::${class}_field_entry", - cachable => 1, - ); -} - - - -my $_cdbi = { title => "metabib::title_field_entry", - author => "metabib::author_field_entry", - subject => "metabib::subject_field_entry", - keyword => "metabib::keyword_field_entry", - series => "metabib::series_field_entry", - identifier => "metabib::identifier_field_entry", -}; - -# XXX factored most of the PG dependant stuff out of here... need to find a way to do "dependants". -sub postfilter_search_multi_class_fts { - my $self = shift; - my $client = shift; - my %args = @_; - - my $sort = $args{'sort'}; - my $sort_dir = $args{sort_dir} || 'DESC'; - my $ou = $args{org_unit}; - my $ou_type = $args{depth}; - my $limit = $args{limit} || 10; - my $offset = $args{offset} || 0; - my $visibility_limit = $args{visibility_limit} || 5000; - - if (!$ou) { - $ou = actor::org_unit->search( { parent_ou => undef } )->next->id; - } - - if (!defined($args{org_unit})) { - die "No target organizational unit passed to ".$self->api_name; - } - - if (! scalar( keys %{$args{searches}} )) { - die "No search arguments were passed to ".$self->api_name; - } - - my $outer_limit = 1000; - - my $limit_clause = ''; - my $offset_clause = ''; - - $limit_clause = "LIMIT $outer_limit"; - $offset_clause = "OFFSET $offset" if (defined $offset and int($offset) > 0); - - my ($avail_filter,@types,@forms,@lang,@aud,@lit_form,@vformats) = (''); - my ($t_filter, $f_filter, $v_filter) = ('','',''); - my ($a_filter, $l_filter, $lf_filter) = ('','',''); - my ($ot_filter, $of_filter, $ov_filter) = ('','',''); - my ($oa_filter, $ol_filter, $olf_filter) = ('','',''); - - if ($args{available}) { - $avail_filter = ' AND cp.status IN (0,7,12)'; - } - - if (my $a = $args{audience}) { - $a = [$a] if (!ref($a)); - @aud = @$a; - - $a_filter = ' AND rd.audience IN ('.join(',',map{'?'}@aud).')'; - $oa_filter = ' AND ord.audience IN ('.join(',',map{'?'}@aud).')'; - } - - if (my $l = $args{language}) { - $l = [$l] if (!ref($l)); - @lang = @$l; - - $l_filter = ' AND rd.item_lang IN ('.join(',',map{'?'}@lang).')'; - $ol_filter = ' AND ord.item_lang IN ('.join(',',map{'?'}@lang).')'; - } - - if (my $f = $args{lit_form}) { - $f = [$f] if (!ref($f)); - @lit_form = @$f; - - $lf_filter = ' AND rd.lit_form IN ('.join(',',map{'?'}@lit_form).')'; - $olf_filter = ' AND ord.lit_form IN ('.join(',',map{'?'}@lit_form).')'; - } - - if (my $f = $args{item_form}) { - $f = [$f] if (!ref($f)); - @forms = @$f; - - $f_filter = ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')'; - $of_filter = ' AND ord.item_form IN ('.join(',',map{'?'}@forms).')'; - } - - if (my $t = $args{item_type}) { - $t = [$t] if (!ref($t)); - @types = @$t; - - $t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')'; - $ot_filter = ' AND ord.item_type IN ('.join(',',map{'?'}@types).')'; - } - - if (my $v = $args{vr_format}) { - $v = [$v] if (!ref($v)); - @vformats = @$v; - - $v_filter = ' AND rd.vr_format IN ('.join(',',map{'?'}@vformats).')'; - $ov_filter = ' AND ord.vr_format IN ('.join(',',map{'?'}@vformats).')'; - } - - - # XXX legacy format and item type support - if ($args{format}) { - my ($t, $f) = split '-', $args{format}; - @types = split '', $t; - @forms = split '', $f; - if (@types) { - $t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')'; - $ot_filter = ' AND ord.item_type IN ('.join(',',map{'?'}@types).')'; - } - - if (@forms) { - $f_filter .= ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')'; - $of_filter .= ' AND ord.item_form IN ('.join(',',map{'?'}@forms).')'; - } - } - - - - my $descendants = defined($ou_type) ? - "actor.org_unit_descendants($ou, $ou_type)" : - "actor.org_unit_descendants($ou)"; - - my $search_table_list = ''; - my $fts_list = ''; - my $join_table_list = ''; - my @rank_list; - - my $field_table = config::metabib_field->table; - - my @bonus_lists; - my @bonus_values; - my $prev_search_group; - my $curr_search_group; - my $search_class; - my $search_field; - my $metabib_field; - for my $search_group (sort keys %{$args{searches}}) { - (my $search_group_name = $search_group) =~ s/\|/_/gso; - ($search_class,$search_field) = split /\|/, $search_group; - $log->debug("Searching class [$search_class] and field [$search_field]",DEBUG); - - if ($search_field) { - unless ( $metabib_field = config::metabib_field->search( field_class => $search_class, name => $search_field )->next ) { - $log->warn("Requested class [$search_class] or field [$search_field] does not exist!"); - return undef; - } - } - - $prev_search_group = $curr_search_group if ($curr_search_group); - - $curr_search_group = $search_group_name; - - my $class = $_cdbi->{$search_class}; - my $search_table = $class->table; - - my ($index_col) = $class->columns('FTS'); - $index_col ||= 'value'; - - - my $fts = OpenILS::Application::Storage::FTS->compile($search_class => $args{searches}{$search_group}{term}, $search_group_name.'.value', "$search_group_name.$index_col"); - - my $fts_where = $fts->sql_where_clause; - my @fts_ranks = $fts->fts_rank; - - my $SQLstring = join('%',map { lc($_) } $fts->words); - my $REstring = '^' . join('\s+',map { lc($_) } $fts->words) . '\W*$'; - my $first_word = lc(($fts->words)[0]).'%'; - - $_.=" * (SELECT weight FROM $field_table WHERE $search_group_name.field = id)" for (@fts_ranks); - my $rank = join(' + ', @fts_ranks); - - my %bonus = (); - $bonus{'keyword'} = [ { "CASE WHEN $search_group_name.value LIKE ? THEN 10 ELSE 1 END" => $SQLstring } ]; - $bonus{'author'} = [ { "CASE WHEN $search_group_name.value ILIKE ? THEN 10 ELSE 1 END" => $first_word } ]; - - $bonus{'series'} = [ - { "CASE WHEN $search_group_name.value LIKE ? THEN 1.5 ELSE 1 END" => $first_word }, - { "CASE WHEN $search_group_name.value ~ ? THEN 20 ELSE 1 END" => $REstring }, - ]; - - $bonus{'title'} = [ @{ $bonus{'series'} }, @{ $bonus{'keyword'} } ]; - - my $bonus_list = join ' * ', map { keys %$_ } @{ $bonus{$search_class} }; - $bonus_list ||= '1'; - - push @bonus_lists, $bonus_list; - push @bonus_values, map { values %$_ } @{ $bonus{$search_class} }; - - - #--------------------- - - $search_table_list .= "$search_table $search_group_name, "; - push @rank_list,$rank; - $fts_list .= " AND $fts_where AND m.source = $search_group_name.source"; - - if ($metabib_field) { - $join_table_list .= " AND $search_group_name.field = " . $metabib_field->id; - $metabib_field = undef; - } - - if ($prev_search_group) { - $join_table_list .= " AND $prev_search_group.source = $curr_search_group.source"; - } - } - - my $metabib_record_descriptor = metabib::record_descriptor->table; - my $metabib_full_rec = metabib::full_rec->table; - my $metabib_metarecord = metabib::metarecord->table; - my $metabib_metarecord_source_map_table = metabib::metarecord_source_map->table; - my $asset_call_number_table = asset::call_number->table; - my $asset_copy_table = asset::copy->table; - my $cs_table = config::copy_status->table; - my $cl_table = asset::copy_location->table; - my $br_table = biblio::record_entry->table; - my $source_table = config::bib_source->table; - - my $bonuses = join (' * ', @bonus_lists); - my $relevance = join (' + ', @rank_list); - $relevance = "SUM( ($relevance) * ($bonuses) )/COUNT(DISTINCT smrs.source)"; - - my $string_default_sort = 'zzzz'; - $string_default_sort = 'AAAA' if ($sort_dir eq 'DESC'); - - my $number_default_sort = '9999'; - $number_default_sort = '0000' if ($sort_dir eq 'DESC'); - - - - my $secondary_sort = <<" SORT"; - ( FIRST (( - SELECT COALESCE(LTRIM(SUBSTR( sfrt.value, COALESCE(SUBSTRING(sfrt.ind2 FROM E'\\\\d+'),'0')::INT + 1 )),'$string_default_sort') - FROM $metabib_full_rec sfrt, - $metabib_metarecord mr - WHERE sfrt.record = mr.master_record - AND sfrt.tag = '245' - AND sfrt.subfield = 'a' - LIMIT 1 - )) ) - SORT - - my $rank = $relevance; - if (lc($sort) eq 'pubdate') { - $rank = <<" RANK"; - ( FIRST (( - SELECT COALESCE(SUBSTRING(frp.value FROM E'\\\\d+'),'$number_default_sort')::INT - FROM $metabib_full_rec frp - WHERE frp.record = mr.master_record - AND frp.tag = '260' - AND frp.subfield = 'c' - LIMIT 1 - )) ) - RANK - } elsif (lc($sort) eq 'create_date') { - $rank = <<" RANK"; - ( FIRST (( SELECT create_date FROM $br_table rbr WHERE rbr.id = mr.master_record)) ) - RANK - } elsif (lc($sort) eq 'edit_date') { - $rank = <<" RANK"; - ( FIRST (( SELECT edit_date FROM $br_table rbr WHERE rbr.id = mr.master_record)) ) - RANK - } elsif (lc($sort) eq 'title') { - $rank = <<" RANK"; - ( FIRST (( - SELECT COALESCE(LTRIM(SUBSTR( frt.value, COALESCE(SUBSTRING(frt.ind2 FROM E'\\\\d+'),'0')::INT + 1 )),'$string_default_sort') - FROM $metabib_full_rec frt - WHERE frt.record = mr.master_record - AND frt.tag = '245' - AND frt.subfield = 'a' - LIMIT 1 - )) ) - RANK - $secondary_sort = <<" SORT"; - ( FIRST (( - SELECT COALESCE(SUBSTRING(sfrp.value FROM E'\\\\d+'),'$number_default_sort')::INT - FROM $metabib_full_rec sfrp - WHERE sfrp.record = mr.master_record - AND sfrp.tag = '260' - AND sfrp.subfield = 'c' - LIMIT 1 - )) ) - SORT - } elsif (lc($sort) eq 'author') { - $rank = <<" RANK"; - ( FIRST(( - SELECT COALESCE(LTRIM(fra.value),'$string_default_sort') - FROM $metabib_full_rec fra - WHERE fra.record = mr.master_record - AND fra.tag LIKE '1%' - AND fra.subfield = 'a' - ORDER BY fra.tag::text::int - LIMIT 1 - )) ) - RANK - } else { - push @bonus_values, @bonus_values; - $sort = undef; - } - - - my $select = <<" SQL"; - SELECT m.metarecord, - $relevance, - CASE WHEN COUNT(DISTINCT smrs.source) = 1 THEN FIRST(m.source) ELSE 0 END, - $rank, - $secondary_sort - FROM $search_table_list - $metabib_metarecord mr, - $metabib_metarecord_source_map_table m, - $metabib_metarecord_source_map_table smrs - WHERE m.metarecord = smrs.metarecord - AND mr.id = m.metarecord - $fts_list - $join_table_list - GROUP BY m.metarecord - -- ORDER BY 4 $sort_dir - LIMIT $visibility_limit - SQL - - if ($self->api_name !~ /staff/o) { - $select = <<" SQL"; - - SELECT s.* - FROM ($select) s - WHERE EXISTS ( - SELECT 1 - FROM $asset_call_number_table cn, - $metabib_metarecord_source_map_table mrs, - $asset_copy_table cp, - $cs_table cs, - $cl_table cl, - $br_table br, - $descendants d, - $metabib_record_descriptor ord - WHERE mrs.metarecord = s.metarecord - AND br.id = mrs.source - AND cn.record = mrs.source - AND cp.status = cs.id - AND cp.location = cl.id - AND cp.circ_lib = d.id - AND cp.call_number = cn.id - AND cp.opac_visible IS TRUE - AND cs.opac_visible IS TRUE - AND cl.opac_visible IS TRUE - AND d.opac_visible IS TRUE - AND br.active IS TRUE - AND br.deleted IS FALSE - AND cp.deleted IS FALSE - AND cn.deleted IS FALSE - AND ord.record = mrs.source - $ot_filter - $of_filter - $ov_filter - $oa_filter - $ol_filter - $olf_filter - $avail_filter - LIMIT 1 - ) - OR EXISTS ( - SELECT 1 - FROM $br_table br, - $metabib_metarecord_source_map_table mrs, - $metabib_record_descriptor ord, - $source_table src - WHERE mrs.metarecord = s.metarecord - AND ord.record = mrs.source - AND br.id = mrs.source - AND br.source = src.id - AND src.transcendant IS TRUE - $ot_filter - $of_filter - $ov_filter - $oa_filter - $ol_filter - $olf_filter - ) - ORDER BY 4 $sort_dir, 5 - SQL - } else { - $select = <<" SQL"; - - SELECT DISTINCT s.* - FROM ($select) s, - $metabib_metarecord_source_map_table omrs, - $metabib_record_descriptor ord - WHERE omrs.metarecord = s.metarecord - AND ord.record = omrs.source - AND ( EXISTS ( - SELECT 1 - FROM $asset_call_number_table cn, - $asset_copy_table cp, - $descendants d, - $br_table br - WHERE br.id = omrs.source - AND cn.record = omrs.source - AND br.deleted IS FALSE - AND cn.deleted IS FALSE - AND cp.call_number = cn.id - AND ( cn.owning_lib = d.id - OR ( cp.circ_lib = d.id - AND cp.deleted IS FALSE - ) - ) - $avail_filter - LIMIT 1 - ) - OR NOT EXISTS ( - SELECT 1 - FROM $asset_call_number_table cn - WHERE cn.record = omrs.source - AND cn.deleted IS FALSE - LIMIT 1 - ) - OR EXISTS ( - SELECT 1 - FROM $br_table br, - $metabib_metarecord_source_map_table mrs, - $metabib_record_descriptor ord, - $source_table src - WHERE mrs.metarecord = s.metarecord - AND br.id = mrs.source - AND br.source = src.id - AND src.transcendant IS TRUE - $ot_filter - $of_filter - $ov_filter - $oa_filter - $ol_filter - $olf_filter - ) - ) - $ot_filter - $of_filter - $ov_filter - $oa_filter - $ol_filter - $olf_filter - - ORDER BY 4 $sort_dir, 5 - SQL - } - - - $log->debug("Field Search SQL :: [$select]",DEBUG); - - my $recs = $_cdbi->{title}->db_Main->selectall_arrayref( - $select, {}, - @bonus_values, - @types, @forms, @vformats, @aud, @lang, @lit_form, - @types, @forms, @vformats, @aud, @lang, @lit_form, - # ($self->api_name =~ /staff/o ? (@types, @forms, @aud, @lang, @lit_form) : () ) - ); - - $log->debug("Search yielded ".scalar(@$recs)." results.",DEBUG); - - my $max = 0; - $max = 1 if (!@$recs); - for (@$recs) { - $max = $$_[1] if ($$_[1] > $max); - } - - my $count = scalar(@$recs); - for my $rec (@$recs[$offset .. $offset + $limit - 1]) { - next unless ($$rec[0]); - my ($mrid,$rank,$skip) = @$rec; - $client->respond( [$mrid, sprintf('%0.3f',$rank/$max), $skip, $count] ); - } - return undef; -} - -__PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.post_filter.multiclass.search_fts.metarecord", - method => 'postfilter_search_multi_class_fts', - api_level => 1, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.post_filter.multiclass.search_fts.metarecord.staff", - method => 'postfilter_search_multi_class_fts', - api_level => 1, - stream => 1, - cachable => 1, -); - -__PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.multiclass.search_fts", - method => 'postfilter_search_multi_class_fts', - api_level => 1, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.multiclass.search_fts.staff", - method => 'postfilter_search_multi_class_fts', - api_level => 1, - stream => 1, - cachable => 1, -); - -# XXX factored most of the PG dependant stuff out of here... need to find a way to do "dependants". -sub biblio_search_multi_class_fts { - my $self = shift; - my $client = shift; - my %args = @_; - - my $sort = $args{'sort'}; - my $sort_dir = $args{sort_dir} || 'DESC'; - my $ou = $args{org_unit}; - my $ou_type = $args{depth}; - my $limit = $args{limit} || 10; - my $offset = $args{offset} || 0; - my $pref_lang = $args{prefered_language} || 'eng'; - my $visibility_limit = $args{visibility_limit} || 5000; - - if (!$ou) { - $ou = actor::org_unit->search( { parent_ou => undef } )->next->id; - } - - if (! scalar( keys %{$args{searches}} )) { - die "No search arguments were passed to ".$self->api_name; - } - - my $outer_limit = 1000; - - my $limit_clause = ''; - my $offset_clause = ''; - - $limit_clause = "LIMIT $outer_limit"; - $offset_clause = "OFFSET $offset" if (defined $offset and int($offset) > 0); - - my ($avail_filter,@types,@forms,@lang,@aud,@lit_form,@vformats) = (''); - my ($t_filter, $f_filter, $v_filter) = ('','',''); - my ($a_filter, $l_filter, $lf_filter) = ('','',''); - my ($ot_filter, $of_filter, $ov_filter) = ('','',''); - my ($oa_filter, $ol_filter, $olf_filter) = ('','',''); - - if ($args{available}) { - $avail_filter = ' AND cp.status IN (0,7,12)'; - } - - if (my $a = $args{audience}) { - $a = [$a] if (!ref($a)); - @aud = @$a; - - $a_filter = ' AND rd.audience IN ('.join(',',map{'?'}@aud).')'; - $oa_filter = ' AND ord.audience IN ('.join(',',map{'?'}@aud).')'; - } - - if (my $l = $args{language}) { - $l = [$l] if (!ref($l)); - @lang = @$l; - - $l_filter = ' AND rd.item_lang IN ('.join(',',map{'?'}@lang).')'; - $ol_filter = ' AND ord.item_lang IN ('.join(',',map{'?'}@lang).')'; - } - - if (my $f = $args{lit_form}) { - $f = [$f] if (!ref($f)); - @lit_form = @$f; - - $lf_filter = ' AND rd.lit_form IN ('.join(',',map{'?'}@lit_form).')'; - $olf_filter = ' AND ord.lit_form IN ('.join(',',map{'?'}@lit_form).')'; - } - - if (my $f = $args{item_form}) { - $f = [$f] if (!ref($f)); - @forms = @$f; - - $f_filter = ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')'; - $of_filter = ' AND ord.item_form IN ('.join(',',map{'?'}@forms).')'; - } - - if (my $t = $args{item_type}) { - $t = [$t] if (!ref($t)); - @types = @$t; - - $t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')'; - $ot_filter = ' AND ord.item_type IN ('.join(',',map{'?'}@types).')'; - } - - if (my $v = $args{vr_format}) { - $v = [$v] if (!ref($v)); - @vformats = @$v; - - $v_filter = ' AND rd.vr_format IN ('.join(',',map{'?'}@vformats).')'; - $ov_filter = ' AND ord.vr_format IN ('.join(',',map{'?'}@vformats).')'; - } - - # XXX legacy format and item type support - if ($args{format}) { - my ($t, $f) = split '-', $args{format}; - @types = split '', $t; - @forms = split '', $f; - if (@types) { - $t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')'; - $ot_filter = ' AND ord.item_type IN ('.join(',',map{'?'}@types).')'; - } - - if (@forms) { - $f_filter .= ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')'; - $of_filter .= ' AND ord.item_form IN ('.join(',',map{'?'}@forms).')'; - } - } - - - my $descendants = defined($ou_type) ? - "actor.org_unit_descendants($ou, $ou_type)" : - "actor.org_unit_descendants($ou)"; - - my $search_table_list = ''; - my $fts_list = ''; - my $join_table_list = ''; - my @rank_list; - - my $field_table = config::metabib_field->table; - - my @bonus_lists; - my @bonus_values; - my $prev_search_group; - my $curr_search_group; - my $search_class; - my $search_field; - my $metabib_field; - for my $search_group (sort keys %{$args{searches}}) { - (my $search_group_name = $search_group) =~ s/\|/_/gso; - ($search_class,$search_field) = split /\|/, $search_group; - $log->debug("Searching class [$search_class] and field [$search_field]",DEBUG); - - if ($search_field) { - unless ( $metabib_field = config::metabib_field->search( field_class => $search_class, name => $search_field )->next ) { - $log->warn("Requested class [$search_class] or field [$search_field] does not exist!"); - return undef; - } - } - - $prev_search_group = $curr_search_group if ($curr_search_group); - - $curr_search_group = $search_group_name; - - my $class = $_cdbi->{$search_class}; - my $search_table = $class->table; - - my ($index_col) = $class->columns('FTS'); - $index_col ||= 'value'; - - - my $fts = OpenILS::Application::Storage::FTS->compile($search_class => $args{searches}{$search_group}{term}, $search_group_name.'.value', "$search_group_name.$index_col"); - - my $fts_where = $fts->sql_where_clause; - my @fts_ranks = $fts->fts_rank; - - my $SQLstring = join('%',map { lc($_) } $fts->words) .'%'; - my $REstring = '^' . join('\s+',map { lc($_) } $fts->words) . '\W*$'; - my $first_word = lc(($fts->words)[0]).'%'; - - $_.=" * (SELECT weight FROM $field_table WHERE $search_group_name.field = id)" for (@fts_ranks); - my $rank = join(' + ', @fts_ranks); - - my %bonus = (); - $bonus{'subject'} = []; - $bonus{'author'} = [ { "CASE WHEN $search_group_name.value ILIKE ? THEN 1.5 ELSE 1 END" => $first_word } ]; - - $bonus{'keyword'} = [ { "CASE WHEN $search_group_name.value ILIKE ? THEN 10 ELSE 1 END" => $SQLstring } ]; - - $bonus{'series'} = [ - { "CASE WHEN $search_group_name.value ILIKE ? THEN 1.5 ELSE 1 END" => $first_word }, - { "CASE WHEN $search_group_name.value ~ ? THEN 20 ELSE 1 END" => $REstring }, - ]; - - $bonus{'title'} = [ @{ $bonus{'series'} }, @{ $bonus{'keyword'} } ]; - - if ($pref_lang) { - push @{ $bonus{'title'} }, { "CASE WHEN rd.item_lang = ? THEN 10 ELSE 1 END" => $pref_lang }; - push @{ $bonus{'author'} }, { "CASE WHEN rd.item_lang = ? THEN 10 ELSE 1 END" => $pref_lang }; - push @{ $bonus{'subject'} }, { "CASE WHEN rd.item_lang = ? THEN 10 ELSE 1 END" => $pref_lang }; - push @{ $bonus{'keyword'} }, { "CASE WHEN rd.item_lang = ? THEN 10 ELSE 1 END" => $pref_lang }; - push @{ $bonus{'series'} }, { "CASE WHEN rd.item_lang = ? THEN 10 ELSE 1 END" => $pref_lang }; - } - - my $bonus_list = join ' * ', map { keys %$_ } @{ $bonus{$search_class} }; - $bonus_list ||= '1'; - - push @bonus_lists, $bonus_list; - push @bonus_values, map { values %$_ } @{ $bonus{$search_class} }; - - #--------------------- - - $search_table_list .= "$search_table $search_group_name, "; - push @rank_list,$rank; - $fts_list .= " AND $fts_where AND b.id = $search_group_name.source"; - - if ($metabib_field) { - $fts_list .= " AND $curr_search_group.field = " . $metabib_field->id; - $metabib_field = undef; - } - - if ($prev_search_group) { - $join_table_list .= " AND $prev_search_group.source = $curr_search_group.source"; - } - } - - my $metabib_record_descriptor = metabib::record_descriptor->table; - my $metabib_full_rec = metabib::full_rec->table; - my $metabib_metarecord = metabib::metarecord->table; - my $metabib_metarecord_source_map_table = metabib::metarecord_source_map->table; - my $asset_call_number_table = asset::call_number->table; - my $asset_copy_table = asset::copy->table; - my $cs_table = config::copy_status->table; - my $cl_table = asset::copy_location->table; - my $br_table = biblio::record_entry->table; - my $source_table = config::bib_source->table; - - - my $bonuses = join (' * ', @bonus_lists); - my $relevance = join (' + ', @rank_list); - $relevance = "AVG( ($relevance) * ($bonuses) )"; - - my $string_default_sort = 'zzzz'; - $string_default_sort = 'AAAA' if ($sort_dir eq 'DESC'); - - my $number_default_sort = '9999'; - $number_default_sort = '0000' if ($sort_dir eq 'DESC'); - - my $rank = $relevance; - if (lc($sort) eq 'pubdate') { - $rank = <<" RANK"; - ( FIRST (( - SELECT COALESCE(SUBSTRING(frp.value FROM E'\\\\d{4}'),'$number_default_sort')::INT - FROM $metabib_full_rec frp - WHERE frp.record = b.id - AND frp.tag = '260' - AND frp.subfield = 'c' - LIMIT 1 - )) ) - RANK - } elsif (lc($sort) eq 'create_date') { - $rank = <<" RANK"; - ( FIRST (( SELECT create_date FROM $br_table rbr WHERE rbr.id = b.id)) ) - RANK - } elsif (lc($sort) eq 'edit_date') { - $rank = <<" RANK"; - ( FIRST (( SELECT edit_date FROM $br_table rbr WHERE rbr.id = b.id)) ) - RANK - } elsif (lc($sort) eq 'title') { - $rank = <<" RANK"; - ( FIRST (( - SELECT COALESCE(LTRIM(SUBSTR( frt.value, COALESCE(SUBSTRING(frt.ind2 FROM E'\\\\d+'),'0')::INT + 1 )),'$string_default_sort') - FROM $metabib_full_rec frt - WHERE frt.record = b.id - AND frt.tag = '245' - AND frt.subfield = 'a' - LIMIT 1 - )) ) - RANK - } elsif (lc($sort) eq 'author') { - $rank = <<" RANK"; - ( FIRST(( - SELECT COALESCE(LTRIM(fra.value),'$string_default_sort') - FROM $metabib_full_rec fra - WHERE fra.record = b.id - AND fra.tag LIKE '1%' - AND fra.subfield = 'a' - ORDER BY fra.tag::text::int - LIMIT 1 - )) ) - RANK - } else { - push @bonus_values, @bonus_values; - $sort = undef; - } - - - my $select = <<" SQL"; - SELECT b.id, - $relevance AS rel, - $rank AS rank, - b.source - FROM $search_table_list - $metabib_record_descriptor rd, - $source_table src, - $br_table b - WHERE rd.record = b.id - AND b.active IS TRUE - AND b.deleted IS FALSE - $fts_list - $join_table_list - $t_filter - $f_filter - $v_filter - $a_filter - $l_filter - $lf_filter - GROUP BY b.id, b.source - ORDER BY 3 $sort_dir - LIMIT $visibility_limit - SQL - - if ($self->api_name !~ /staff/o) { - $select = <<" SQL"; - - SELECT s.* - FROM ($select) s - LEFT OUTER JOIN $source_table src ON (s.source = src.id) - WHERE EXISTS ( - SELECT 1 - FROM $asset_call_number_table cn, - $asset_copy_table cp, - $cs_table cs, - $cl_table cl, - $descendants d - WHERE cn.record = s.id - AND cp.status = cs.id - AND cp.location = cl.id - AND cp.call_number = cn.id - AND cp.opac_visible IS TRUE - AND cs.opac_visible IS TRUE - AND cl.opac_visible IS TRUE - AND d.opac_visible IS TRUE - AND cp.deleted IS FALSE - AND cn.deleted IS FALSE - AND cp.circ_lib = d.id - $avail_filter - LIMIT 1 - ) - OR src.transcendant IS TRUE - ORDER BY 3 $sort_dir - SQL - } else { - $select = <<" SQL"; - - SELECT s.* - FROM ($select) s - LEFT OUTER JOIN $source_table src ON (s.source = src.id) - WHERE EXISTS ( - SELECT 1 - FROM $asset_call_number_table cn, - $asset_copy_table cp, - $descendants d - WHERE cn.record = s.id - AND cp.call_number = cn.id - AND cn.deleted IS FALSE - AND cp.circ_lib = d.id - AND cp.deleted IS FALSE - $avail_filter - LIMIT 1 - ) - OR NOT EXISTS ( - SELECT 1 - FROM $asset_call_number_table cn - WHERE cn.record = s.id - LIMIT 1 - ) - OR src.transcendant IS TRUE - ORDER BY 3 $sort_dir - SQL - } - - - $log->debug("Field Search SQL :: [$select]",DEBUG); - - my $recs = $_cdbi->{title}->db_Main->selectall_arrayref( - $select, {}, - @bonus_values, @types, @forms, @vformats, @aud, @lang, @lit_form - ); - - $log->debug("Search yielded ".scalar(@$recs)." results.",DEBUG); - - my $count = scalar(@$recs); - for my $rec (@$recs[$offset .. $offset + $limit - 1]) { - next unless ($$rec[0]); - my ($mrid,$rank) = @$rec; - $client->respond( [$mrid, sprintf('%0.3f',$rank), $count] ); - } - return undef; -} - -__PACKAGE__->register_method( - api_name => "open-ils.storage.biblio.multiclass.search_fts.record", - method => 'biblio_search_multi_class_fts', - api_level => 1, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => "open-ils.storage.biblio.multiclass.search_fts.record.staff", - method => 'biblio_search_multi_class_fts', - api_level => 1, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => "open-ils.storage.biblio.multiclass.search_fts", - method => 'biblio_search_multi_class_fts', - api_level => 1, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => "open-ils.storage.biblio.multiclass.search_fts.staff", - method => 'biblio_search_multi_class_fts', - api_level => 1, - stream => 1, - cachable => 1, -); - - -my %locale_map; -my $default_preferred_language; -my $default_preferred_language_weight; - -# XXX factored most of the PG dependant stuff out of here... need to find a way to do "dependants". -sub staged_fts { - my $self = shift; - my $client = shift; - my %args = @_; - - if (!$locale_map{COMPLETE}) { - - my @locales = config::i18n_locale->search_where({ code => { '<>' => '' } }); - for my $locale ( @locales ) { - $locale_map{lc($locale->code)} = $locale->marc_code; - } - $locale_map{COMPLETE} = 1; - - } - - if (!$default_preferred_language) { - - $default_preferred_language = OpenSRF::Utils::SettingsClient - ->new - ->config_value( - apps => 'open-ils.storage' => app_settings => 'default_preferred_language' - ); - - } - - if (!$default_preferred_language_weight) { - - $default_preferred_language_weight = OpenSRF::Utils::SettingsClient - ->new - ->config_value( - apps => 'open-ils.storage' => app_settings => 'default_preferred_language_weight' - ); - - } - - # inclusion, exclusion, delete_adjusted_inclusion, delete_adjusted_exclusion - my $estimation_strategy = $args{estimation_strategy} || 'inclusion'; - - my $ou = $args{org_unit}; - my $limit = $args{limit} || 10; - my $offset = $args{offset} || 0; - - if (!$ou) { - $ou = actor::org_unit->search( { parent_ou => undef } )->next->id; - } - - if (! scalar( keys %{$args{searches}} )) { - die "No search arguments were passed to ".$self->api_name; - } - - my (@between,@statuses,@locations,@types,@forms,@lang,@aud,@lit_form,@vformats,@bib_level); - - if (!defined($args{preferred_language})) { - my $ses_locale = $client->session ? $client->session->session_locale : $default_preferred_language; - $args{preferred_language} = - $locale_map{ lc($ses_locale) } || 'eng'; - } - - if (!defined($args{preferred_language_weight})) { - $args{preferred_language_weight} = $default_preferred_language_weight || 2; - } - - if ($args{available}) { - @statuses = (0,7,12); - } - - if (my $s = $args{locations}) { - $s = [$s] if (!ref($s)); - @locations = @$s; - } - - if (my $b = $args{between}) { - if (ref($b) && @$b == 2) { - @between = @$b; - } - } - - if (my $s = $args{statuses}) { - $s = [$s] if (!ref($s)); - @statuses = @$s; - } - - if (my $a = $args{audience}) { - $a = [$a] if (!ref($a)); - @aud = @$a; - } - - if (my $l = $args{language}) { - $l = [$l] if (!ref($l)); - @lang = @$l; - } - - if (my $f = $args{lit_form}) { - $f = [$f] if (!ref($f)); - @lit_form = @$f; - } - - if (my $f = $args{item_form}) { - $f = [$f] if (!ref($f)); - @forms = @$f; - } - - if (my $t = $args{item_type}) { - $t = [$t] if (!ref($t)); - @types = @$t; - } - - if (my $b = $args{bib_level}) { - $b = [$b] if (!ref($b)); - @bib_level = @$b; - } - - if (my $v = $args{vr_format}) { - $v = [$v] if (!ref($v)); - @vformats = @$v; - } - - # XXX legacy format and item type support - if ($args{format}) { - my ($t, $f) = split '-', $args{format}; - @types = split '', $t; - @forms = split '', $f; - } - - my %stored_proc_search_args; - for my $search_group (sort keys %{$args{searches}}) { - (my $search_group_name = $search_group) =~ s/\|/_/gso; - my ($search_class,$search_field) = split /\|/, $search_group; - $log->debug("Searching class [$search_class] and field [$search_field]",DEBUG); - - if ($search_field) { - unless ( config::metabib_field->search( field_class => $search_class, name => $search_field )->next ) { - $log->warn("Requested class [$search_class] or field [$search_field] does not exist!"); - return undef; - } - } - - my $class = $_cdbi->{$search_class}; - my $search_table = $class->table; - - my ($index_col) = $class->columns('FTS'); - $index_col ||= 'value'; - - - my $fts = OpenILS::Application::Storage::FTS->compile( - $search_class => $args{searches}{$search_group}{term}, - $search_group_name.'.value', - "$search_group_name.$index_col" - ); - $fts->sql_where_clause; # this builds the ranks for us - - my @fts_ranks = $fts->fts_rank; - my @fts_queries = $fts->fts_query; - my @phrases = map { lc($_) } $fts->phrases; - my @words = map { lc($_) } $fts->words; - - $stored_proc_search_args{$search_group} = { - fts_rank => \@fts_ranks, - fts_query => \@fts_queries, - phrase => \@phrases, - word => \@words, - }; - - } - - my $param_search_ou = $ou; - my $param_depth = $args{depth}; $param_depth = 'NULL' unless (defined($param_depth) and length($param_depth) > 0 ); - my $param_searches = OpenSRF::Utils::JSON->perl2JSON( \%stored_proc_search_args ); $param_searches =~ s/\$//go; $param_searches = '$$'.$param_searches.'$$'; - my $param_statuses = '$${' . join(',', map { s/\$//go; "\"$_\"" } @statuses ) . '}$$'; - my $param_locations = '$${' . join(',', map { s/\$//go; "\"$_\"" } @locations) . '}$$'; - my $param_audience = '$${' . join(',', map { s/\$//go; "\"$_\"" } @aud ) . '}$$'; - my $param_language = '$${' . join(',', map { s/\$//go; "\"$_\"" } @lang ) . '}$$'; - my $param_lit_form = '$${' . join(',', map { s/\$//go; "\"$_\"" } @lit_form ) . '}$$'; - my $param_types = '$${' . join(',', map { s/\$//go; "\"$_\"" } @types ) . '}$$'; - my $param_forms = '$${' . join(',', map { s/\$//go; "\"$_\"" } @forms ) . '}$$'; - my $param_vformats = '$${' . join(',', map { s/\$//go; "\"$_\"" } @vformats ) . '}$$'; - my $param_bib_level = '$${' . join(',', map { s/\$//go; "\"$_\"" } @bib_level) . '}$$'; - my $param_before = $args{before}; $param_before = 'NULL' unless (defined($param_before) and length($param_before) > 0 ); - my $param_after = $args{after} ; $param_after = 'NULL' unless (defined($param_after ) and length($param_after ) > 0 ); - my $param_during = $args{during}; $param_during = 'NULL' unless (defined($param_during) and length($param_during) > 0 ); - my $param_between = '$${"' . join('","', map { int($_) } @between) . '"}$$'; - my $param_pref_lang = $args{preferred_language}; $param_pref_lang =~ s/\$//go; $param_pref_lang = '$$'.$param_pref_lang.'$$'; - my $param_pref_lang_multiplier = $args{preferred_language_weight}; $param_pref_lang_multiplier ||= 'NULL'; - my $param_sort = $args{'sort'}; $param_sort =~ s/\$//go; $param_sort = '$$'.$param_sort.'$$'; - my $param_sort_desc = defined($args{sort_dir}) && $args{sort_dir} =~ /^d/io ? "'t'" : "'f'"; - my $metarecord = $self->api_name =~ /metabib/o ? "'t'" : "'f'"; - my $staff = $self->api_name =~ /staff/o ? "'t'" : "'f'"; - my $param_rel_limit = $args{core_limit}; $param_rel_limit ||= 'NULL'; - my $param_chk_limit = $args{check_limit}; $param_chk_limit ||= 'NULL'; - my $param_skip_chk = $args{skip_check}; $param_skip_chk ||= 'NULL'; - - my $sth = metabib::metarecord_source_map->db_Main->prepare(<<" SQL"); - SELECT * - FROM search.staged_fts( - $param_search_ou\:\:INT, - $param_depth\:\:INT, - $param_searches\:\:TEXT, - $param_statuses\:\:INT[], - $param_locations\:\:INT[], - $param_audience\:\:TEXT[], - $param_language\:\:TEXT[], - $param_lit_form\:\:TEXT[], - $param_types\:\:TEXT[], - $param_forms\:\:TEXT[], - $param_vformats\:\:TEXT[], - $param_bib_level\:\:TEXT[], - $param_before\:\:TEXT, - $param_after\:\:TEXT, - $param_during\:\:TEXT, - $param_between\:\:TEXT[], - $param_pref_lang\:\:TEXT, - $param_pref_lang_multiplier\:\:REAL, - $param_sort\:\:TEXT, - $param_sort_desc\:\:BOOL, - $metarecord\:\:BOOL, - $staff\:\:BOOL, - $param_rel_limit\:\:INT, - $param_chk_limit\:\:INT, - $param_skip_chk\:\:INT - ); - SQL - - $sth->execute; - - my $recs = $sth->fetchall_arrayref({}); - my $summary_row = pop @$recs; - - my $total = $$summary_row{total}; - my $checked = $$summary_row{checked}; - my $visible = $$summary_row{visible}; - my $deleted = $$summary_row{deleted}; - my $excluded = $$summary_row{excluded}; - - my $estimate = $visible; - if ( $total > $checked && $checked ) { - - $$summary_row{hit_estimate} = FTS_paging_estimate($self, $client, $checked, $visible, $excluded, $deleted, $total); - $estimate = $$summary_row{estimated_hit_count} = $$summary_row{hit_estimate}{$estimation_strategy}; - - } - - delete $$summary_row{id}; - delete $$summary_row{rel}; - delete $$summary_row{record}; - - $client->respond( $summary_row ); - - $log->debug("Search yielded ".scalar(@$recs)." checked, visible results with an approximate visible total of $estimate.",DEBUG); - - for my $rec (@$recs[$offset .. $offset + $limit - 1]) { - delete $$rec{checked}; - delete $$rec{visible}; - delete $$rec{excluded}; - delete $$rec{deleted}; - delete $$rec{total}; - $$rec{rel} = sprintf('%0.3f',$$rec{rel}); - - $client->respond( $rec ); - } - return undef; -} -__PACKAGE__->register_method( - api_name => "open-ils.storage.biblio.multiclass.staged.search_fts", - method => 'staged_fts', - api_level => 0, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => "open-ils.storage.biblio.multiclass.staged.search_fts.staff", - method => 'staged_fts', - api_level => 0, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.multiclass.staged.search_fts", - method => 'staged_fts', - api_level => 0, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.multiclass.staged.search_fts.staff", - method => 'staged_fts', - api_level => 0, - stream => 1, - cachable => 1, -); - -sub FTS_paging_estimate { - my $self = shift; - my $client = shift; - - my $checked = shift; - my $visible = shift; - my $excluded = shift; - my $deleted = shift; - my $total = shift; - - my $deleted_ratio = $deleted / $checked; - my $delete_adjusted_total = $total - ( $total * $deleted_ratio ); - - my $exclusion_ratio = $excluded / $checked; - my $delete_adjusted_exclusion_ratio = $excluded / ($checked - $deleted); - - my $inclusion_ratio = $visible / $checked; - my $delete_adjusted_inclusion_ratio = $visible / ($checked - $deleted); - - return { - exclusion => int($delete_adjusted_total - ( $delete_adjusted_total * $exclusion_ratio )), - inclusion => int($delete_adjusted_total * $inclusion_ratio), - delete_adjusted_exclusion => int($delete_adjusted_total - ( $delete_adjusted_total * $delete_adjusted_exclusion_ratio )), - delete_adjusted_inclusion => int($delete_adjusted_total * $delete_adjusted_inclusion_ratio) - }; -} -__PACKAGE__->register_method( - api_name => "open-ils.storage.fts_paging_estimate", - method => 'FTS_paging_estimate', - argc => 5, - strict => 1, - api_level => 1, - signature => { - 'return'=> q# - Hash of estimation values based on four variant estimation strategies: - exclusion -- Estimate based on the ratio of excluded records on the current superpage; - inclusion -- Estimate based on the ratio of visible records on the current superpage; - delete_adjusted_exclusion -- Same as exclusion strategy, but the ratio is adjusted by deleted count; - delete_adjusted_inclusion -- Same as inclusion strategy, but the ratio is adjusted by deleted count; - #, - desc => q# - Helper method used to determin the approximate number of - hits for a search that spans multiple superpages. For - sparse superpages, the inclusion estimate will likely be the - best estimate. The exclusion strategy is the original, but - inclusion is the default. - #, - params => [ - { name => 'checked', - desc => 'Number of records check -- nominally the size of a superpage, or a remaining amount from the last superpage.', - type => 'number' - }, - { name => 'visible', - desc => 'Number of records visible to the search location on the current superpage.', - type => 'number' - }, - { name => 'excluded', - desc => 'Number of records excluded from the search location on the current superpage.', - type => 'number' - }, - { name => 'deleted', - desc => 'Number of deleted records on the current superpage.', - type => 'number' - }, - { name => 'total', - desc => 'Total number of records up to check_limit (superpage_size * max_superpages).', - type => 'number' - } - ] - } -); - - -sub xref_count { - my $self = shift; - my $client = shift; - my $args = shift; - - my $term = $$args{term}; - my $limit = $$args{max} || 1; - my $min = $$args{min} || 1; - my @classes = @{$$args{class}}; - - $limit = $min if ($min > $limit); - - if (!@classes) { - @classes = ( qw/ title author subject series keyword / ); - } - - my %matches; - my $bre_table = biblio::record_entry->table; - my $cn_table = asset::call_number->table; - my $cp_table = asset::copy->table; - - for my $search_class ( @classes ) { - - my $class = $_cdbi->{$search_class}; - my $search_table = $class->table; - - my ($index_col) = $class->columns('FTS'); - $index_col ||= 'value'; - - - my $where = OpenILS::Application::Storage::FTS - ->compile($search_class => $term, $search_class.'.value', "$search_class.$index_col") - ->sql_where_clause; - - my $SQL = <<" SQL"; - SELECT COUNT(DISTINCT X.source) - FROM (SELECT $search_class.source - FROM $search_table $search_class - JOIN $bre_table b ON (b.id = $search_class.source) - WHERE $where - AND NOT b.deleted - AND b.active - LIMIT $limit) X - HAVING COUNT(DISTINCT X.source) >= $min; - SQL - - my $res = $class->db_Main->selectrow_arrayref( $SQL ); - $matches{$search_class} = $res ? $res->[0] : 0; - } - - return \%matches; -} -__PACKAGE__->register_method( - api_name => "open-ils.storage.search.xref", - method => 'xref_count', - api_level => 1, -); - -sub query_parser_fts { - my $self = shift; - my $client = shift; - my %args = @_; - - - # grab the query parser and initialize it - my $parser = $OpenILS::Application::Storage::QParser; - $parser->use; - - if (!$parser->initialization_complete) { - my $cstore = OpenSRF::AppSession->create( 'open-ils.cstore' ); - $parser->initialize( - config_metabib_field_index_norm_map => - $cstore->request( - 'open-ils.cstore.direct.config.metabib_field_index_norm_map.search.atomic', - { id => { "!=" => undef } }, - { flesh => 1, flesh_fields => { cmfinm => [qw/norm/] }, order_by => [{ class => "cmfinm", field => "pos" }] } - )->gather(1), - search_relevance_adjustment => - $cstore->request( - 'open-ils.cstore.direct.search.relevance_adjustment.search.atomic', - { id => { "!=" => undef } } - )->gather(1), - config_metabib_field => - $cstore->request( - 'open-ils.cstore.direct.config.metabib_field.search.atomic', - { id => { "!=" => undef } } - )->gather(1), - config_metabib_search_alias => - $cstore->request( - 'open-ils.cstore.direct.config.metabib_search_alias.search.atomic', - { alias => { "!=" => undef } } - )->gather(1), - ); - - $cstore->disconnect; - die("Cannot initialize $parser!") unless ($parser->initialization_complete); - } - - - # populate the locale/language map - if (!$locale_map{COMPLETE}) { - - my @locales = config::i18n_locale->search_where({ code => { '<>' => '' } }); - for my $locale ( @locales ) { - $locale_map{lc($locale->code)} = $locale->marc_code; - } - $locale_map{COMPLETE} = 1; - - } - - # I hope we have a query! - if (! $args{query} ) { - die "No query was passed to ".$self->api_name; - } - - - my $simple_plan = $args{_simple_plan}; - # remove bad chunks of the %args hash - for my $bad ( grep { /^_/ } keys(%args)) { - delete($args{$bad}); - } - - - # parse the query and supply any query-level %arg-based defaults - # we expect, and make use of, query, superpage, superpage_size, debug and core_limit args - my $query = $parser->new( %args )->parse; - - - # set the locale-based default prefered location - if (!$query->parse_tree->find_filter('preferred_language')) { - $parser->default_preferred_language( $args{preferred_language} ); - if (!$parser->default_preferred_language) { - my $ses_locale = $client->session ? $client->session->session_locale : ''; - $parser->default_preferred_language( $locale_map{ lc($ses_locale) } ); - } - $parser->default_preferred_language( - OpenSRF::Utils::SettingsClient->new->config_value( - apps => 'open-ils.storage' => app_settings => 'default_preferred_language' - ) - ) if (!$parser->default_preferred_language); - } - - - # set the global default language multiplier - if (!$query->parse_tree->find_filter('preferred_language_weight') and !$query->parse_tree->find_filter('preferred_language_multiplier')) { - $parser->default_preferred_language_multiplier($args{preferred_language_weight}); - $parser->default_preferred_language_multiplier($args{preferred_language_multiplier}); - $parser->default_preferred_language_multiplier( - OpenSRF::Utils::SettingsClient->new->config_value( - apps => 'open-ils.storage' => app_settings => 'default_preferred_language_weight' - ) - ) if (!$parser->default_preferred_language_multiplier); - } - - # gather the site, if one is specified, defaulting to the in-query version - my $ou = $args{org_unit}; - if (my ($filter) = $query->parse_tree->find_filter('site')) { - $ou = $filter->args->[0] if (@{$filter->args}); - } - $ou = actor::org_unit->search( { shortname => $ou } )->next->id if ($ou and $ou !~ /^\d+$/); - - - # gather lasso, as with $ou - my $lasso = $args{lasso}; - if (my ($filter) = $query->parse_tree->find_filter('lasso')) { - $lasso = $filter->args->[0] if (@{$filter->args}); - } - $lasso = actor::org_lasso->search( { name => $lasso } )->next->id if ($lasso and $lasso !~ /^\d+$/); - $lasso = -$lasso if ($lasso); - - -# # XXX once we have org_unit containers, we can make user-defined lassos .. WHEEE -# # gather user lasso, as with $ou and lasso -# my $mylasso = $args{my_lasso}; -# if (my ($filter) = $query->parse_tree->find_filter('my_lasso')) { -# $mylasso = $filter->args->[0] if (@{$filter->args}); -# } -# $mylasso = actor::org_unit->search( { name => $mylasso } )->next->id if ($mylasso and $mylasso !~ /^\d+$/); - - - # if we have a lasso, go with that, otherwise ... ou - $ou = $lasso if ($lasso); - - - # get the default $ou if we have nothing - $ou = actor::org_unit->search( { parent_ou => undef } )->next->id if (!$ou and !$lasso and !$mylasso); - - - # XXX when user lassos are here, check to make sure we don't have one -- it'll be passed in the depth, with an ou of 0 - # gather the depth, if one is specified, defaulting to the in-query version - my $depth = $args{depth}; - if (my ($filter) = $query->parse_tree->find_filter('depth')) { - $depth = $filter->args->[0] if (@{$filter->args}); - } - $depth = actor::org_unit->search_where( [{ name => $depth },{ opac_label => $depth }], {limit => 1} )->next->id if ($depth and $depth !~ /^\d+$/); - - - # gather the limit or default to 10 - my $limit = $args{check_limit} || 'NULL'; - if (my ($filter) = $query->parse_tree->find_filter('limit')) { - $limit = $filter->args->[0] if (@{$filter->args}); - } - if (my ($filter) = $query->parse_tree->find_filter('check_limit')) { - $limit = $filter->args->[0] if (@{$filter->args}); - } - - - # gather the offset or default to 0 - my $offset = $args{skip_check} || $args{offset} || 0; - if (my ($filter) = $query->parse_tree->find_filter('offset')) { - $offset = $filter->args->[0] if (@{$filter->args}); - } - if (my ($filter) = $query->parse_tree->find_filter('skip_check')) { - $offset = $filter->args->[0] if (@{$filter->args}); - } - - - # gather the estimation strategy or default to inclusion - my $estimation_strategy = $args{estimation_strategy} || 'inclusion'; - if (my ($filter) = $query->parse_tree->find_filter('estimation_strategy')) { - $estimation_strategy = $filter->args->[0] if (@{$filter->args}); - } - - - # gather the estimation strategy or default to inclusion - my $core_limit = $args{core_limit}; - if (my ($filter) = $query->parse_tree->find_filter('core_limit')) { - $core_limit = $filter->args->[0] if (@{$filter->args}); - } - - - # gather statuses, and then forget those if we have an #available modifier - my @statuses; - if (my ($filter) = $query->parse_tree->find_filter('statuses')) { - @statuses = @{$filter->args} if (@{$filter->args}); - } - @statuses = (0,7,12) if ($query->parse_tree->find_modifier('available')); - - - # gather locations - my @location; - if (my ($filter) = $query->parse_tree->find_filter('locations')) { - @location = @{$filter->args} if (@{$filter->args}); - } - - - my $param_check = $limit || $query->superpage_size || 'NULL'; - my $param_offset = $offset || 'NULL'; - my $param_limit = $core_limit || 'NULL'; - - my $sp = $query->superpage || 1; - if ($sp > 1) { - $param_offset = ($sp - 1) * $sp_size; - } - - my $param_search_ou = $ou; - my $param_depth = $depth; $param_depth = 'NULL' unless (defined($depth) and length($depth) > 0 ); - my $param_core_query = "\$core_query_$$\$" . $query->parse_tree->toSQL . "\$core_query_$$\$"; - my $param_statuses = '$${' . join(',', map { s/\$//go; "\"$_\""} @statuses) . '}$$'; - my $param_locations = '$${' . join(',', map { s/\$//go; "\"$_\""} @location) . '}$$'; - my $staff = ($self->api_name =~ /staff/ or $query->parse_tree->find_modifier('staff')) ? "'t'" : "'f'"; - my $metarecord = ($self->api_name =~ /metabib/ or $query->parse_tree->find_modifier('metabib') or $query->parse_tree->find_modifier('metarecord')) ? "'t'" : "'f'"; - - my $sth = metabib::metarecord_source_map->db_Main->prepare(<<" SQL"); - SELECT * /* bib search */ - FROM search.query_parser_fts( - $param_search_ou\:\:INT, - $param_depth\:\:INT, - $param_core_query\:\:TEXT, - $param_statuses\:\:INT[], - $param_locations\:\:INT[], - $param_offset\:\:INT, - $param_check\:\:INT, - $param_limit\:\:INT, - $metarecord\:\:BOOL, - $staff\:\:BOOL - ); - SQL - - $sth->execute; - - my $recs = $sth->fetchall_arrayref({}); - my $summary_row = pop @$recs; - - my $total = $$summary_row{total}; - my $checked = $$summary_row{checked}; - my $visible = $$summary_row{visible}; - my $deleted = $$summary_row{deleted}; - my $excluded = $$summary_row{excluded}; - - my $estimate = $visible; - if ( $total > $checked && $checked ) { - - $$summary_row{hit_estimate} = FTS_paging_estimate($self, $client, $checked, $visible, $excluded, $deleted, $total); - $estimate = $$summary_row{estimated_hit_count} = $$summary_row{hit_estimate}{$estimation_strategy}; - - } - - delete $$summary_row{id}; - delete $$summary_row{rel}; - delete $$summary_row{record}; - - if (defined($simple_plan)) { - $$summary_row{complex_query} = $simple_plan ? 0 : 1; - } else { - $$summary_row{complex_query} = $query->simple_plan ? 0 : 1; - } - - $client->respond( $summary_row ); - - $log->debug("Search yielded ".scalar(@$recs)." checked, visible results with an approximate visible total of $estimate.",DEBUG); - - for my $rec (@$recs) { - delete $$rec{checked}; - delete $$rec{visible}; - delete $$rec{excluded}; - delete $$rec{deleted}; - delete $$rec{total}; - $$rec{rel} = sprintf('%0.3f',$$rec{rel}); - - $client->respond( $rec ); - } - return undef; -} - -sub query_parser_fts_wrapper { - my $self = shift; - my $client = shift; - my %args = @_; - - $log->debug("Entering compatability wrapper function for old-style staged search", DEBUG); - # grab the query parser and initialize it - my $parser = $OpenILS::Application::Storage::QParser; - $parser->use; - - if (!$parser->initialization_complete) { - my $cstore = OpenSRF::AppSession->create( 'open-ils.cstore' ); - $parser->initialize( - config_metabib_field_index_norm_map => - $cstore->request( - 'open-ils.cstore.direct.config.metabib_field_index_norm_map.search.atomic', - { id => { "!=" => undef } }, - { flesh => 1, flesh_fields => { cmfinm => [qw/norm/] }, order_by => [{ class => "cmfinm", field => "pos" }] } - )->gather(1), - search_relevance_adjustment => - $cstore->request( - 'open-ils.cstore.direct.search.relevance_adjustment.search.atomic', - { id => { "!=" => undef } } - )->gather(1), - config_metabib_field => - $cstore->request( - 'open-ils.cstore.direct.config.metabib_field.search.atomic', - { id => { "!=" => undef } } - )->gather(1), - config_metabib_search_alias => - $cstore->request( - 'open-ils.cstore.direct.config.metabib_search_alias.search.atomic', - { alias => { "!=" => undef } } - )->gather(1), - ); - - $cstore->disconnect; - die("Cannot initialize $parser!") unless ($parser->initialization_complete); - } - - if (! scalar( keys %{$args{searches}} )) { - die "No search arguments were passed to ".$self->api_name; - } - - $log->debug("Constructing QueryParser query from staged search hash ...", DEBUG); - my $base_query = ''; - for my $sclass ( keys %{$args{searches}} ) { - $log->debug(" --> staged search key: $sclass --> term: $args{searches}{$sclass}{term}", DEBUG); - $base_query .= " $sclass: $args{searches}{$sclass}{term}"; - } - - my $query = $base_query; - $log->debug("Full base query: $base_query", DEBUG); - - $query = "$args{facets} $query" if ($args{facets}); - - if (!$locale_map{COMPLETE}) { - - my @locales = config::i18n_locale->search_where({ code => { '<>' => '' } }); - for my $locale ( @locales ) { - $locale_map{lc($locale->code)} = $locale->marc_code; - } - $locale_map{COMPLETE} = 1; - - } - - my $base_plan = $parser->new( query => $base_query )->parse; - - $query = "preferred_language($args{preferred_language}) $query" - if ($args{preferred_language} and !$base_plan->parse_tree->find_filter('preferred_language')); - $query = "preferred_language_weight($args{preferred_language_weight}) $query" - if ($args{preferred_language_weight} and !$base_plan->parse_tree->find_filter('preferred_language_weight') and !$base_plan->parse_tree->find_filter('preferred_language_multiplier')); - - $query = "estimation_strategy($args{estimation_strategy}) $query" if ($args{estimation_strategy}); - $query = "site($args{org_unit}) $query" if ($args{org_unit}); - $query = "depth($args{depth}) $query" if (defined($args{depth})); - $query = "sort($args{sort}) $query" if ($args{sort}); - $query = "limit($args{limit}) $query" if ($args{limit}); - $query = "core_limit($args{core_limit}) $query" if ($args{core_limit}); - $query = "skip_check($args{skip_check}) $query" if ($args{skip_check}); - $query = "superpage($args{superpage}) $query" if ($args{superpage}); - $query = "offset($args{offset}) $query" if ($args{offset}); - $query = "#metarecord $query" if ($self->api_name =~ /metabib/); - $query = "#available $query" if ($args{available}); - $query = "#descending $query" if ($args{sort_dir} && $args{sort_dir} =~ /^d/i); - $query = "#staff $query" if ($self->api_name =~ /staff/); - $query = "before($args{before}) $query" if (defined($args{before}) and $args{before} =~ /^\d+$/); - $query = "after($args{after}) $query" if (defined($args{after}) and $args{after} =~ /^\d+$/); - $query = "during($args{during}) $query" if (defined($args{during}) and $args{during} =~ /^\d+$/); - $query = "between($args{between}[0],$args{between}[1]) $query" - if ( ref($args{between}) and @{$args{between}} == 2 and $args{between}[0] =~ /^\d+$/ and $args{between}[1] =~ /^\d+$/ ); - - - my (@between,@statuses,@locations,@types,@forms,@lang,@aud,@lit_form,@vformats,@bib_level); - - # XXX legacy format and item type support - if ($args{format}) { - my ($t, $f) = split '-', $args{format}; - $args{item_type} = [ split '', $t ]; - $args{item_form} = [ split '', $f ]; - } - - for my $filter ( qw/locations statuses between audience language lit_form item_form item_type bib_level vr_format/ ) { - if (my $s = $args{$filter}) { - $s = [$s] if (!ref($s)); - - my @filter_list = @$s; - - next if ($filter eq 'between' and scalar(@filter_list) != 2); - next if (@filter_list == 0); - - my $filter_string = join ',', @filter_list; - $query = "$filter($filter_string) $query"; - } - } - - $log->debug("Full QueryParser query: $query", DEBUG); - - return query_parser_fts($self, $client, query => $query, _simple_plan => $base_plan->simple_plan ); -} -__PACKAGE__->register_method( - api_name => "open-ils.storage.biblio.multiclass.staged.search_fts", - method => 'query_parser_fts_wrapper', - api_level => 1, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => "open-ils.storage.biblio.multiclass.staged.search_fts.staff", - method => 'query_parser_fts_wrapper', - api_level => 1, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.multiclass.staged.search_fts", - method => 'query_parser_fts_wrapper', - api_level => 1, - stream => 1, - cachable => 1, -); -__PACKAGE__->register_method( - api_name => "open-ils.storage.metabib.multiclass.staged.search_fts.staff", - method => 'query_parser_fts_wrapper', - api_level => 1, - stream => 1, - cachable => 1, -); - - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/money.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/money.pm deleted file mode 100644 index 22ab1f308d..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/money.pm +++ /dev/null @@ -1,612 +0,0 @@ -package OpenILS::Application::Storage::Publisher::money; -use base qw/OpenILS::Application::Storage/; -use OpenSRF::Utils::Logger qw/:level/; - -my $log = 'OpenSRF::Utils::Logger'; - -sub _make_mbts { - my @xacts = @_; - - my @mbts; - for my $x (@xacts) { - my $s = new Fieldmapper::money::billable_transaction_summary; - $s->id( $x->id ); - $s->usr( $x->usr ); - $s->xact_start( $x->xact_start ); - $s->xact_finish( $x->xact_finish ); - - my $to = 0; - my $lb = undef; - for my $b ($x->billings) { - next if ($b->voided); - #$log->debug( "billing is ".$b->amount, DEBUG ); - $to += ($b->amount * 100); - $lb ||= $b->billing_ts; - if ($b->billing_ts ge $lb) { - $lb = $b->billing_ts; - $s->last_billing_note($b->note); - $s->last_billing_ts($b->billing_ts); - $s->last_billing_type($b->billing_type); - } - } - - $s->total_owed( sprintf('%0.2f', ($to) / 100 ) ); - - my $tp = 0; - my $lp = undef; - for my $p ($x->payments) { - #$log->debug( "payment is ".$p->amount." voided = ".$p->voided, DEBUG ); - next if ($p->voided eq 't'); - $tp += ($p->amount * 100); - $lp ||= $p->payment_ts; - if ($p->payment_ts ge $lp) { - $lp = $p->payment_ts; - $s->last_payment_note($p->note); - $s->last_payment_ts($p->payment_ts); - $s->last_payment_type($p->payment_type); - } - } - $s->total_paid( sprintf('%0.2f', ($tp) / 100 ) ); - - $s->balance_owed( sprintf('%0.2f', (($to) - ($tp)) / 100) ); - #$log->debug( "balance of ".$x->id." == ".$s->balance_owed, DEBUG ); - - if (action::circulation->retrieve($x->id)) { - $s->xact_type( 'circulation' ); - } elsif (money::grocery->retrieve($x->id)) { - $s->xact_type( 'grocery' ); - } elsif (booking::reservation->retrieve($x->id)) { - $s->xact_type( 'reservation' ); - } - - push @mbts, $s; - } - - return @mbts; -} - -sub search_mbts { - my $self = shift; - my $client = shift; - my $search = shift; - - my @xacts = money::billable_transaction->search_where( $search ); - $client->respond( $_ ) for (_make_mbts(@xacts)); - - return undef; -} -__PACKAGE__->register_method( - method => 'search_mbts', - api_name => 'open-ils.storage.money.billable_transaction.summary.search', - stream => 1, - argc => 1, -); - -sub search_ous { - my $self = shift; - my $client = shift; - my $usr = shift; - - my @xacts = $self->method_lookup( 'open-ils.storage.money.billable_transaction.summary.search' )->run( { usr => $usr, xact_finish => undef } ); - - my ($total,$owed,$paid) = (0.0,0.0,0.0); - for my $x (@xacts) { - $total += $x->total_owed; - $owed += $x->balance_owed; - $paid += $x->total_paid; - } - - my $ous = Fieldmapper::money::open_user_summary->new; - $ous->usr( $usr ); - $ous->total_paid( sprintf('%0.2f', $paid) ); - $ous->total_owed( sprintf('%0.2f', $total) ); - $ous->balance_owed( sprintf('%0.2f', $owed) ); - - return $ous; -} -__PACKAGE__->register_method( - method => 'search_ous', - api_name => 'open-ils.storage.money.open_user_summary.search', - argc => 1, -); - - -sub new_collections { - my $self = shift; - my $client = shift; - my $age = shift; - my $amount = shift; - my @loc = @_; - - my $mct = money::collections_tracker->table; - my $mb = money::billing->table; - my $circ = action::circulation->table; - my $mg = money::grocery->table; - my $res = booking::reservation->table; - my $descendants = "actor.org_unit_descendants((select id from actor.org_unit where shortname = ?))"; - - my $SQL = <<" SQL"; - -select - usr, - MAX(last_billing) as last_pertinent_billing, - SUM(total_billing) - SUM(COALESCE(p.amount,0)) as threshold_amount - from (select - x.id, - x.usr, - MAX(b.billing_ts) as last_billing, - SUM(b.amount) AS total_billing - from action.circulation x - left join money.collections_tracker c ON (c.usr = x.usr AND c.location = ?) - join money.billing b on (b.xact = x.id) - where x.xact_finish is null - and c.id is null - and x.circ_lib in (XX) - and b.billing_ts < current_timestamp - ? * '1 day'::interval - and not b.voided - group by 1,2 - - union all - - select - x.id, - x.usr, - MAX(b.billing_ts) as last_billing, - SUM(b.amount) AS total_billing - from money.grocery x - left join money.collections_tracker c ON (c.usr = x.usr AND c.location = ?) - join money.billing b on (b.xact = x.id) - where x.xact_finish is null - and c.id is null - and x.billing_location in (XX) - and b.billing_ts < current_timestamp - ? * '1 day'::interval - and not b.voided - group by 1,2 - - union all - - select - x.id, - x.usr, - MAX(b.billing_ts) as last_billing, - SUM(b.amount) AS total_billing - from booking.reservation x - left join money.collections_tracker c ON (c.usr = x.usr AND c.location = ?) - join money.billing b on (b.xact = x.id) - where x.xact_finish is null - and c.id is null - and x.pickup_lib in (XX) - and b.billing_ts < current_timestamp - ? * '1 day'::interval - and not b.voided - group by 1,2 - ) full_list - left join money.payment p on (full_list.id = p.xact) - group by 1 - having SUM(total_billing) - SUM(COALESCE(p.amount,0)) > ? -; - SQL - - my @l_ids; - for my $l (@loc) { - my ($org) = actor::org_unit->search( shortname => uc($l) ); - next unless $org; - - my $o_list = actor::org_unit->db_Main->selectcol_arrayref( "SELECT id FROM actor.org_unit_descendants(?);", {}, $org->id ); - next unless (@$o_list); - - my $o_txt = join ',' => @$o_list; - - (my $real_sql = $SQL) =~ s/XX/$o_txt/gsm; - - my $sth = money::collections_tracker->db_Main->prepare($real_sql); - $sth->execute( $org->id, $age, $org->id, $age, $org->id, $age, $amount ); - - while (my $row = $sth->fetchrow_hashref) { - #$row->{usr} = actor::user->retrieve($row->{usr})->to_fieldmapper; - $client->respond( $row ); - } - } - return undef; -} -__PACKAGE__->register_method( - method => 'new_collections', - api_name => 'open-ils.storage.money.collections.users_of_interest', - stream => 1, - argc => 3, -); - -sub users_owing_money { - my $self = shift; - my $client = shift; - my $start = shift; - my $end = shift; - my $amount = shift; - my @loc = @_; - - my $mct = money::collections_tracker->table; - my $mb = money::billing->table; - my $circ = action::circulation->table; - my $mg = money::grocery->table; - my $descendants = "actor.org_unit_descendants((select id from actor.org_unit where shortname = ?))"; - - my $SQL = <<" SQL"; - -select - usr, - SUM(total_billing) - SUM(COALESCE(p.amount,0)) as threshold_amount - from (select - x.id, - x.usr, - SUM(b.amount) AS total_billing - from action.circulation x - join money.billing b on (b.xact = x.id) - where x.xact_finish is null - and x.circ_lib in (XX) - and b.billing_ts between ? and ? - and not b.voided - group by 1,2 - - union all - - select - x.id, - x.usr, - SUM(b.amount) AS total_billing - from money.grocery x - join money.billing b on (b.xact = x.id) - where x.xact_finish is null - and x.billing_location in (XX) - and b.billing_ts between ? and ? - and not b.voided - group by 1,2 - - union all - - select - x.id, - x.usr, - SUM(b.amount) AS total_billing - from booking.reservation x - join money.billing b on (b.xact = x.id) - where x.xact_finish is null - and x.pickup_lib in (XX) - and b.billing_ts between ? and ? - and not b.voided - group by 1,2 - ) full_list - left join money.payment p on (full_list.id = p.xact) - group by 1 - having SUM(total_billing) - SUM(COALESCE(p.amount,0)) > ? -; - SQL - - my @l_ids; - for my $l (@loc) { - my ($org) = actor::org_unit->search( shortname => uc($l) ); - next unless $org; - - my $o_list = actor::org_unit->db_Main->selectcol_arrayref( "SELECT id FROM actor.org_unit_descendants(?);", {}, $org->id ); - next unless (@$o_list); - - my $o_txt = join ',' => @$o_list; - - (my $real_sql = $SQL) =~ s/XX/$o_txt/gsm; - - my $sth = money::collections_tracker->db_Main->prepare($real_sql); - $sth->execute( $start, $end, $start, $end, $amount ); - - while (my $row = $sth->fetchrow_hashref) { - #$row->{usr} = actor::user->retrieve($row->{usr})->to_fieldmapper; - $client->respond( $row ); - } - } - return undef; -} -__PACKAGE__->register_method( - method => 'users_owing_money', - api_name => 'open-ils.storage.money.collections.users_owing_money', - stream => 1, - argc => 4, -); - -sub active_in_collections { - my $self = shift; - my $client = shift; - my $startdate = shift; - my $enddate = shift; - my @loc = @_; - - my $mct = money::collections_tracker->table; - my $mb = money::billing->table; - my $circ = action::circulation->table; - my $mg = money::grocery->table; - - my $SQL = <<" SQL"; -SELECT usr, - MAX(last_pertinent_billing) AS last_pertinent_billing, - MAX(last_pertinent_payment) AS last_pertinent_payment - FROM ( - SELECT lt.usr, - NULL::TIMESTAMPTZ AS last_pertinent_billing, - NULL::TIMESTAMPTZ AS last_pertinent_payment - FROM booking.reservation lt - JOIN money.collections_tracker cl ON (lt.usr = cl.usr) - JOIN money.billing bl ON (lt.id = bl.xact) - WHERE cl.location = ? - AND lt.pickup_lib IN (XX) - AND bl.void_time BETWEEN ? AND ? - GROUP BY 1 - - UNION ALL - SELECT lt.usr, - MAX(bl.billing_ts) AS last_pertinent_billing, - NULL::TIMESTAMPTZ AS last_pertinent_payment - FROM booking.reservation lt - JOIN money.collections_tracker cl ON (lt.usr = cl.usr) - JOIN money.billing bl ON (lt.id = bl.xact) - WHERE cl.location = ? - AND lt.pickup_lib IN (XX) - AND bl.billing_ts BETWEEN ? AND ? - GROUP BY 1 - - UNION ALL - SELECT lt.usr, - NULL::TIMESTAMPTZ AS last_pertinent_billing, - MAX(pm.payment_ts) AS last_pertinent_payment - FROM booking.reservation lt - JOIN money.collections_tracker cl ON (lt.usr = cl.usr) - JOIN money.payment pm ON (lt.id = pm.xact) - WHERE cl.location = ? - AND lt.pickup_lib IN (XX) - AND pm.payment_ts BETWEEN ? AND ? - GROUP BY 1 - - UNION ALL - SELECT lt.usr, - NULL::TIMESTAMPTZ AS last_pertinent_billing, - NULL::TIMESTAMPTZ AS last_pertinent_payment - FROM money.grocery lt - JOIN money.collections_tracker cl ON (lt.usr = cl.usr) - JOIN money.billing bl ON (lt.id = bl.xact) - WHERE cl.location = ? - AND lt.billing_location IN (XX) - AND bl.void_time BETWEEN ? AND ? - GROUP BY 1 - - UNION ALL - SELECT lt.usr, - MAX(bl.billing_ts) AS last_pertinent_billing, - NULL::TIMESTAMPTZ AS last_pertinent_payment - FROM money.grocery lt - JOIN money.collections_tracker cl ON (lt.usr = cl.usr) - JOIN money.billing bl ON (lt.id = bl.xact) - WHERE cl.location = ? - AND lt.billing_location IN (XX) - AND bl.billing_ts BETWEEN ? AND ? - GROUP BY 1 - - UNION ALL - SELECT lt.usr, - NULL::TIMESTAMPTZ AS last_pertinent_billing, - MAX(pm.payment_ts) AS last_pertinent_payment - FROM money.grocery lt - JOIN money.collections_tracker cl ON (lt.usr = cl.usr) - JOIN money.payment pm ON (lt.id = pm.xact) - WHERE cl.location = ? - AND lt.billing_location IN (XX) - AND pm.payment_ts BETWEEN ? AND ? - GROUP BY 1 - - UNION ALL - SELECT lt.usr, - NULL::TIMESTAMPTZ AS last_pertinent_billing, - NULL::TIMESTAMPTZ AS last_pertinent_payment - FROM action.circulation lt - JOIN money.collections_tracker cl ON (lt.usr = cl.usr) - WHERE cl.location = ? - AND lt.circ_lib IN (XX) - AND lt.checkin_time BETWEEN ? AND ? - GROUP BY 1 - - UNION ALL - SELECT lt.usr, - NULL::TIMESTAMPTZ AS last_pertinent_billing, - MAX(pm.payment_ts) AS last_pertinent_payment - FROM action.circulation lt - JOIN money.collections_tracker cl ON (lt.usr = cl.usr) - JOIN money.payment pm ON (lt.id = pm.xact) - WHERE cl.location = ? - AND lt.circ_lib IN (XX) - AND pm.payment_ts BETWEEN ? AND ? - GROUP BY 1 - - UNION ALL - SELECT lt.usr, - NULL::TIMESTAMPTZ AS last_pertinent_billing, - NULL::TIMESTAMPTZ AS last_pertinent_payment - FROM action.circulation lt - JOIN money.collections_tracker cl ON (lt.usr = cl.usr) - JOIN money.billing bl ON (lt.id = bl.xact) - WHERE cl.location = ? - AND lt.circ_lib IN (XX) - AND bl.void_time BETWEEN ? AND ? - GROUP BY 1 - - UNION ALL - SELECT lt.usr, - MAX(bl.billing_ts) AS last_pertinent_billing, - NULL::TIMESTAMPTZ AS last_pertinent_payment - FROM action.circulation lt - JOIN money.collections_tracker cl ON (lt.usr = cl.usr) - JOIN money.billing bl ON (lt.id = bl.xact) - WHERE cl.location = ? - AND lt.circ_lib IN (XX) - AND bl.billing_ts BETWEEN ? AND ? - GROUP BY 1 - ) foo - GROUP BY 1 -; - SQL - - my @l_ids; - for my $l (@loc) { - my ($org) = actor::org_unit->search( shortname => uc($l) ); - next unless $org; - - my $o_list = actor::org_unit->db_Main->selectcol_arrayref( "SELECT id FROM actor.org_unit_descendants(?);", {}, $org->id ); - next unless (@$o_list); - - my $o_txt = join ',' => @$o_list; - - (my $real_sql = $SQL) =~ s/XX/$o_txt/gsm; - - my $sth = money::collections_tracker->db_Main->prepare($real_sql); - $sth->execute( - # reservation queries - $org->id, $startdate, $enddate, - $org->id, $startdate, $enddate, - $org->id, $startdate, $enddate, - - # grocery queries - $org->id, $startdate, $enddate, - $org->id, $startdate, $enddate, - $org->id, $startdate, $enddate, - - # circ queries - $org->id, $startdate, $enddate, - $org->id, $startdate, $enddate, - $org->id, $startdate, $enddate, - $org->id, $startdate, $enddate - ); - - while (my $row = $sth->fetchrow_hashref) { - $row->{usr} = actor::user->retrieve($row->{usr})->to_fieldmapper; - $client->respond( $row ); - } - } - return undef; -} -__PACKAGE__->register_method( - method => 'active_in_collections', - api_name => 'open-ils.storage.money.collections.users_with_activity', - stream => 1, - argc => 3, -); - -sub ou_desk_payments { - my $self = shift; - my $client = shift; - my $lib = shift; - my $startdate = shift; - my $enddate = shift; - - return undef unless ($startdate =~ /^\d{4}-\d{2}-\d{2}$/o); - return undef unless ($enddate =~ /^\d{4}-\d{2}-\d{2}$/o); - return undef unless ($lib =~ /^\d+$/o); - - my $sql = <<" SQL"; - - SELECT ws.id as workstation, - SUM( CASE WHEN p.payment_type = 'cash_payment' THEN p.amount ELSE 0.0 END ) as cash_payment, - SUM( CASE WHEN p.payment_type = 'check_payment' THEN p.amount ELSE 0.0 END ) as check_payment, - SUM( CASE WHEN p.payment_type = 'credit_card_payment' THEN p.amount ELSE 0.0 END ) as credit_card_payment - FROM money.desk_payment_view p - JOIN actor.workstation ws ON (ws.id = p.cash_drawer) - WHERE p.payment_ts >= '$startdate' - AND p.payment_ts < '$enddate'::TIMESTAMPTZ + INTERVAL '1 day' - AND p.voided IS FALSE - AND ws.owning_lib = $lib - GROUP BY 1 - ORDER BY 1; - - SQL - - my $rows = money::payment->db_Main->selectall_arrayref( $sql ); - - for my $r (@$rows) { - my $x = new Fieldmapper::money::workstation_payment_summary; - $x->workstation( actor::workstation->retrieve($$r[0])->to_fieldmapper ); - $x->cash_payment($$r[1]); - $x->check_payment($$r[2]); - $x->credit_card_payment($$r[3]); - - $client->respond($x); - } - - return undef; -} -__PACKAGE__->register_method( - method => 'ou_desk_payments', - api_name => 'open-ils.storage.money.org_unit.desk_payments', - stream => 1, - argc => 3, -); - -sub ou_user_payments { - my $self = shift; - my $client = shift; - my $lib = shift; - my $startdate = shift; - my $enddate = shift; - - return undef unless ($startdate =~ /^\d{4}-\d{2}-\d{2}$/o); - return undef unless ($enddate =~ /^\d{4}-\d{2}-\d{2}$/o); - return undef unless ($lib =~ /^\d+$/o); - - my $sql = <<" SQL"; - - SELECT au.id as usr, - SUM( CASE WHEN p.payment_type = 'forgive_payment' THEN p.amount ELSE 0.0 END ) as forgive_payment, - SUM( CASE WHEN p.payment_type = 'work_payment' THEN p.amount ELSE 0.0 END ) as work_payment, - SUM( CASE WHEN p.payment_type = 'credit_payment' THEN p.amount ELSE 0.0 END ) as credit_payment, - SUM( CASE WHEN p.payment_type = 'goods_payment' THEN p.amount ELSE 0.0 END ) as goods_payment - FROM money.bnm_payment_view p - JOIN actor.usr au ON (au.id = p.accepting_usr) - WHERE p.payment_ts >= '$startdate' - AND p.payment_ts < '$enddate'::TIMESTAMPTZ + INTERVAL '1 day' - AND p.voided IS FALSE - AND au.home_ou = $lib - AND p.payment_type IN ('credit_payment','forgive_payment','work_payment','goods_payment') - GROUP BY 1 - ORDER BY 1; - - SQL - - my $rows = money::payment->db_Main->selectall_arrayref( $sql ); - - for my $r (@$rows) { - my $x = new Fieldmapper::money::user_payment_summary; - $x->usr( actor::user->retrieve($$r[0])->to_fieldmapper ); - $x->forgive_payment($$r[1]); - $x->work_payment($$r[2]); - $x->credit_payment($$r[3]); - $x->goods_payment($$r[4]); - - $client->respond($x); - } - - return undef; -} -__PACKAGE__->register_method( - method => 'ou_user_payments', - api_name => 'open-ils.storage.money.org_unit.user_payments', - stream => 1, - argc => 3, -); - -sub mark_unrecovered { - my $self = shift; - my $xact = shift; - - my $x = money::billable_xact->retrieve($xact); - $x->unrecovered( 't' ); - return $x->update; -} -__PACKAGE__->register_method( - method => 'mark_unrecovered', - api_name => 'open-ils.storage.money.billable_xact.mark_unrecovered', - argc => 1, -); - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/permission.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/permission.pm deleted file mode 100644 index 5253627bc9..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/Publisher/permission.pm +++ /dev/null @@ -1,110 +0,0 @@ -package OpenILS::Application::Storage::Publisher::permission; -use base qw/OpenILS::Application::Storage/; -#use OpenILS::Application::Storage::CDBI::config; - - -sub retrieve_all { - my $self = shift; - my $client = shift; - - for my $rec ( permission::grp_tree->retrieve_all ) { - $client->respond( $rec->to_fieldmapper ); - } - - return undef; -} -__PACKAGE__->register_method( - method => 'retrieve_all', - api_name => 'open-ils.storage.direct.permission.grp_tree.retrieve.all', - argc => 0, - stream => 1, -); - -sub retrieve_perms { - my $self = shift; - my $client = shift; - - for my $rec ( sort { $a->code cmp $b->code } permission::perm_list->retrieve_all ) { - $client->respond( $rec->to_fieldmapper ); - } - - return undef; -} -__PACKAGE__->register_method( - method => 'retrieve_perms', - api_name => 'open-ils.storage.direct.permission.perm_list.retrieve.all', - argc => 0, - stream => 1, -); - -sub usr_has_perm { - my $self = shift; - my $client = shift; - my $usr = shift; - my $perm = shift; - my $target = shift; - - return permission::usr_grp_map->db_Main->selectrow_arrayref(<<" SQL",{}, "$usr", "$perm", "$target")->[0]; - SELECT permission.usr_has_perm(?,?,?) - SQL -} -__PACKAGE__->register_method( - method => 'usr_has_perm', - api_name => 'open-ils.storage.permission.user_has_perm', - argc => 3, -); - -sub usr_has_home_perm { - my $self = shift; - my $client = shift; - my $usr = shift; - my $perm = shift; - my $target = shift; - - return permission::usr_grp_map->db_Main->selectrow_arrayref(<<" SQL",{}, "$usr", "$perm", "$target")->[0]; - SELECT permission.usr_has_home_perm(?,?,?) - SQL -} -__PACKAGE__->register_method( - method => 'usr_has_home_perm', - api_name => 'open-ils.storage.permission.user_has_home_perm', - argc => 3, -); - -sub usr_has_work_perm { - my $self = shift; - my $client = shift; - my $usr = shift; - my $perm = shift; - my $target = shift; - - return permission::usr_grp_map->db_Main->selectrow_arrayref(<<" SQL",{}, "$usr", "$perm", "$target")->[0]; - SELECT permission.usr_has_work_perm(?,?,?) - SQL -} -__PACKAGE__->register_method( - method => 'usr_has_work_perm', - api_name => 'open-ils.storage.permission.user_has_work_perm', - argc => 3, -); - -sub usr_perms { - my $self = shift; - my $client = shift; - my $usr = shift; - - my $sth = permission::usr_perm_map->db_Main->prepare('SELECT DISTINCT * FROM permission.usr_perms(?)'); - $sth->execute("$usr"); - - $client->respond( $_->to_fieldmapper ) for ( map { permission::usr_perm_map->construct($_) } $sth->fetchall_hash ); - - return undef; -} -__PACKAGE__->register_method( - method => 'usr_perms', - api_name => 'open-ils.storage.permission.user_perms', - argc => 1, - stream => 1, -); - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Storage/QueryParser.pm b/Open-ILS/src/perlmods/OpenILS/Application/Storage/QueryParser.pm deleted file mode 100644 index 6338384388..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Storage/QueryParser.pm +++ /dev/null @@ -1,1091 +0,0 @@ -package QueryParser; -our %parser_config = ( - QueryParser => { - filters => [], - modifiers => [], - operators => { - 'and' => '&&', - 'or' => '||', - group_start => '(', - group_end => ')', - required => '+', - modifier => '#' - } - } -); - -sub facet_class_count { - my $self = shift; - return @{$self->facet_classes}; -} - -sub search_class_count { - my $self = shift; - return @{$self->search_classes}; -} - -sub filter_count { - my $self = shift; - return @{$self->filters}; -} - -sub modifier_count { - my $self = shift; - return @{$self->modifiers}; -} - -sub custom_data { - my $class = shift; - $class = ref($class) || $class; - - $parser_config{$class}{custom_data} ||= {}; - return $parser_config{$class}{custom_data}; -} - -sub operators { - my $class = shift; - $class = ref($class) || $class; - - $parser_config{$class}{operators} ||= {}; - return $parser_config{$class}{operators}; -} - -sub filters { - my $class = shift; - $class = ref($class) || $class; - - $parser_config{$class}{filters} ||= []; - return $parser_config{$class}{filters}; -} - -sub modifiers { - my $class = shift; - $class = ref($class) || $class; - - $parser_config{$class}{modifiers} ||= []; - return $parser_config{$class}{modifiers}; -} - -sub new { - my $class = shift; - $class = ref($class) || $class; - - my %opts = @_; - - my $self = bless {} => $class; - - for my $o (keys %{QueryParser->operators}) { - $class->operator($o => QueryParser->operator($o)) unless ($class->operator($o)); - } - - for my $opt ( keys %opts) { - $self->$opt( $opts{$opt} ) if ($self->can($opt)); - } - - return $self; -} - -sub new_plan { - my $self = shift; - my $pkg = ref($self) || $self; - return do{$pkg.'::query_plan'}->new( QueryParser => $self, @_ ); -} - -sub add_search_filter { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $filter = shift; - - return $filter if (grep { $_ eq $filter } @{$pkg->filters}); - push @{$pkg->filters}, $filter; - return $filter; -} - -sub add_search_modifier { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $modifier = shift; - - return $modifier if (grep { $_ eq $modifier } @{$pkg->modifiers}); - push @{$pkg->modifiers}, $modifier; - return $modifier; -} - -sub add_facet_class { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $class = shift; - - return $class if (grep { $_ eq $class } @{$pkg->facet_classes}); - - push @{$pkg->facet_classes}, $class; - $pkg->facet_fields->{$class} = []; - - return $class; -} - -sub add_search_class { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $class = shift; - - return $class if (grep { $_ eq $class } @{$pkg->search_classes}); - - push @{$pkg->search_classes}, $class; - $pkg->search_fields->{$class} = []; - $pkg->default_search_class( $pkg->search_classes->[0] ) if (@{$pkg->search_classes} == 1); - - return $class; -} - -sub operator { - my $class = shift; - $class = ref($class) || $class; - my $opname = shift; - my $op = shift; - - return undef unless ($opname); - - $parser_config{$class}{operators} ||= {}; - $parser_config{$class}{operators}{$opname} = $op if ($op); - - return $parser_config{$class}{operators}{$opname}; -} - -sub facet_classes { - my $class = shift; - $class = ref($class) || $class; - my $classes = shift; - - $parser_config{$class}{facet_classes} ||= []; - $parser_config{$class}{facet_classes} = $classes if (ref($classes) && @$classes); - return $parser_config{$class}{facet_classes}; -} - -sub search_classes { - my $class = shift; - $class = ref($class) || $class; - my $classes = shift; - - $parser_config{$class}{classes} ||= []; - $parser_config{$class}{classes} = $classes if (ref($classes) && @$classes); - return $parser_config{$class}{classes}; -} - -sub add_query_normalizer { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $class = shift; - my $field = shift; - my $func = shift; - my $params = shift || []; - - return $func if (grep { $_ eq $func } @{$pkg->query_normalizers->{$class}->{$field}}); - - push(@{$pkg->query_normalizers->{$class}->{$field}}, { function => $func, params => $params }); - - return $func; -} - -sub query_normalizers { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - - my $class = shift; - my $field = shift; - - $parser_config{$pkg}{normalizers} ||= {}; - if ($class) { - if ($field) { - $parser_config{$pkg}{normalizers}{$class}{$field} ||= []; - return $parser_config{$pkg}{normalizers}{$class}{$field}; - } else { - return $parser_config{$pkg}{normalizers}{$class}; - } - } - - return $parser_config{$pkg}{normalizers}; -} - -sub default_search_class { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $class = shift; - $QueryParser::parser_config{$pkg}{default_class} = $pkg->add_search_class( $class ) if $class; - - return $QueryParser::parser_config{$pkg}{default_class}; -} - -sub remove_facet_class { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $class = shift; - - return $class if (!grep { $_ eq $class } @{$pkg->facet_classes}); - - $pkg->facet_classes( [ grep { $_ ne $class } @{$pkg->facet_classes} ] ); - delete $QueryParser::parser_config{$pkg}{facet_fields}{$class}; - - return $class; -} - -sub remove_search_class { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $class = shift; - - return $class if (!grep { $_ eq $class } @{$pkg->search_classes}); - - $pkg->search_classes( [ grep { $_ ne $class } @{$pkg->search_classes} ] ); - delete $QueryParser::parser_config{$pkg}{fields}{$class}; - - return $class; -} - -sub add_facet_field { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $class = shift; - my $field = shift; - - $pkg->add_facet_class( $class ); - - return { $class => $field } if (grep { $_ eq $field } @{$pkg->facet_fields->{$class}}); - - push @{$pkg->facet_fields->{$class}}, $field; - - return { $class => $field }; -} - -sub facet_fields { - my $class = shift; - $class = ref($class) || $class; - - $parser_config{$class}{facet_fields} ||= {}; - return $parser_config{$class}{facet_fields}; -} - -sub add_search_field { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $class = shift; - my $field = shift; - - $pkg->add_search_class( $class ); - - return { $class => $field } if (grep { $_ eq $field } @{$pkg->search_fields->{$class}}); - - push @{$pkg->search_fields->{$class}}, $field; - - return { $class => $field }; -} - -sub search_fields { - my $class = shift; - $class = ref($class) || $class; - - $parser_config{$class}{fields} ||= {}; - return $parser_config{$class}{fields}; -} - -sub add_search_class_alias { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $class = shift; - my $alias = shift; - - $pkg->add_search_class( $class ); - - return { $class => $alias } if (grep { $_ eq $alias } @{$pkg->search_class_aliases->{$class}}); - - push @{$pkg->search_class_aliases->{$class}}, $alias; - - return { $class => $alias }; -} - -sub search_class_aliases { - my $class = shift; - $class = ref($class) || $class; - - $parser_config{$class}{class_map} ||= {}; - return $parser_config{$class}{class_map}; -} - -sub add_search_field_alias { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $class = shift; - my $field = shift; - my $alias = shift; - - return { $class => { $field => $alias } } if (grep { $_ eq $alias } @{$pkg->search_field_aliases->{$class}{$field}}); - - push @{$pkg->search_field_aliases->{$class}{$field}}, $alias; - - return { $class => { $field => $alias } }; -} - -sub search_field_aliases { - my $class = shift; - $class = ref($class) || $class; - - $parser_config{$class}{field_alias_map} ||= {}; - return $parser_config{$class}{field_alias_map}; -} - -sub remove_facet_field { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $class = shift; - my $field = shift; - - return { $class => $field } if (!$pkg->facet_fields->{$class} || !grep { $_ eq $field } @{$pkg->facet_fields->{$class}}); - - $pkg->facet_fields->{$class} = [ grep { $_ ne $field } @{$pkg->facet_fields->{$class}} ]; - - return { $class => $field }; -} - -sub remove_search_field { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $class = shift; - my $field = shift; - - return { $class => $field } if (!$pkg->search_fields->{$class} || !grep { $_ eq $field } @{$pkg->search_fields->{$class}}); - - $pkg->search_fields->{$class} = [ grep { $_ ne $field } @{$pkg->search_fields->{$class}} ]; - - return { $class => $field }; -} - -sub remove_search_field_alias { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $class = shift; - my $field = shift; - my $alias = shift; - - return { $class => { $field => $alias } } if (!$pkg->search_field_aliases->{$class}{$field} || !grep { $_ eq $alias } @{$pkg->search_field_aliases->{$class}{$field}}); - - $pkg->search_field_aliases->{$class}{$field} = [ grep { $_ ne $alias } @{$pkg->search_field_aliases->{$class}{$field}} ]; - - return { $class => { $field => $alias } }; -} - -sub remove_search_class_alias { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $class = shift; - my $alias = shift; - - return { $class => $alias } if (!$pkg->search_class_aliases->{$class} || !grep { $_ eq $alias } @{$pkg->search_class_aliases->{$class}}); - - $pkg->search_class_aliases->{$class} = [ grep { $_ ne $alias } @{$pkg->search_class_aliases->{$class}} ]; - - return { $class => $alias }; -} - -sub debug { - my $self = shift; - my $q = shift; - $self->{_debug} = $q if (defined $q); - return $self->{_debug}; -} - -sub query { - my $self = shift; - my $q = shift; - $self->{_query} = $q if (defined $q); - return $self->{_query}; -} - -sub parse_tree { - my $self = shift; - my $q = shift; - $self->{_parse_tree} = $q if (defined $q); - return $self->{_parse_tree}; -} - -sub parse { - my $self = shift; - my $pkg = ref($self) || $self; - warn " ** parse package is $pkg\n" if $self->debug; - $self->parse_tree( - $self->decompose( - $self->query( shift() ) - ) - ); - - return $self; -} - -sub decompose { - my $self = shift; - my $pkg = ref($self) || $self; - - warn " ** decompose package is $pkg\n" if $self->debug; - - $_ = shift; - my $current_class = shift || $self->default_search_class; - - my $recursing = shift || 0; - - # Build the search class+field uber-regexp - my $search_class_re = '^\s*('; - my $first_class = 1; - - my %seen_classes; - for my $class ( keys %{$pkg->search_fields} ) { - - for my $field ( @{$pkg->search_fields->{$class}} ) { - - for my $alias ( @{$pkg->search_field_aliases->{$class}{$field}} ) { - $alias = qr/$alias/; - s/(^|\s+)$alias[:=]/$1$class\|$field:/g; - } - } - - $search_class_re .= '|' unless ($first_class); - $first_class = 0; - $search_class_re .= $class . '(?:\|\w+)*'; - $seen_classes{$class} = 1; - } - - for my $class ( keys %{$pkg->search_class_aliases} ) { - - for my $alias ( @{$pkg->search_class_aliases->{$class}} ) { - $alias = qr/$alias/; - s/(^|[^|])\b$alias\|/$1$class\|/g; - s/(^|[^|])\b$alias[:=]/$1$class:/g; - } - - $search_class_re .= '|' unless ($first_class); - $first_class = 0; - - $search_class_re .= $class . '(?:\|\w+)*' if (!$seen_classes{$class}); - $seen_classes{$class} = 1; - } - $search_class_re .= '):'; - - warn " ** Search class RE: $search_class_re\n" if $self->debug; - - my $required_re = $pkg->operator('required'); - $required_re = qr/^\s*\Q$required_re\E/; - my $and_re = $pkg->operator('and'); - $and_re = qr/^\s*\Q$and_re\E/; - - my $or_re = $pkg->operator('or'); - $or_re = qr/^\s*\Q$or_re\E/; - - my $group_start_re = $pkg->operator('group_start'); - $group_start_re = qr/^\s*\Q$group_start_re\E/; - - my $group_end = $pkg->operator('group_end'); - my $group_end_re = qr/^\s*\Q$group_end\E/; - - my $modifier_tag_re = $pkg->operator('modifier'); - $modifier_tag_re = qr/^\s*\Q$modifier_tag_re\E/; - - - # Build the filter and modifier uber-regexps - my $facet_re = '^\s*((?:' . join( '|', @{$pkg->facet_classes}) . ')(?:\|\w+)*)\[(.+?)\]'; - warn " Facet RE: $facet_re\n" if $self->debug; - - my $filter_re = '^\s*(' . join( '|', @{$pkg->filters}) . ')\(([^()]+)\)'; - my $filter_as_class_re = '^\s*(' . join( '|', @{$pkg->filters}) . '):\s*(\S+)'; - - my $modifier_re = '^\s*'.$modifier_tag_re.'(' . join( '|', @{$pkg->modifiers}) . ')\b'; - my $modifier_as_class_re = '^\s*(' . join( '|', @{$pkg->modifiers}) . '):\s*(\S+)'; - - my $struct = $self->new_plan( level => $recursing ); - my $remainder = ''; - - my $last_type = ''; - while (!$remainder) { - if (/^\s*$/) { # end of an explicit group - last; - } elsif (/$group_end_re/) { # end of an explicit group - warn "Encountered explicit group end\n" if $self->debug; - - $_ = $'; - $remainder = $'; - - $last_type = ''; - } elsif ($self->filter_count && /$filter_re/) { # found a filter - warn "Encountered search filter: $1 set to $2\n" if $self->debug; - - $_ = $'; - $struct->new_filter( $1 => [ split '[, ]+', $2 ] ); - - $last_type = ''; - } elsif ($self->filter_count && /$filter_as_class_re/) { # found a filter - warn "Encountered search filter: $1 set to $2\n" if $self->debug; - - $_ = $'; - $struct->new_filter( $1 => [ split '[, ]+', $2 ] ); - - $last_type = ''; - } elsif ($self->modifier_count && /$modifier_re/) { # found a modifier - warn "Encountered search modifier: $1\n" if $self->debug; - - $_ = $'; - if (!$struct->top_plan) { - warn " Search modifiers only allowed at the top level of the query\n" if $self->debug; - } else { - $struct->new_modifier($1); - } - - $last_type = ''; - } elsif ($self->modifier_count && /$modifier_as_class_re/) { # found a modifier - warn "Encountered search modifier: $1\n" if $self->debug; - - my $mod = $1; - - $_ = $'; - if (!$struct->top_plan) { - warn " Search modifiers only allowed at the top level of the query\n" if $self->debug; - } elsif ($2 =~ /^[ty1]/i) { - $struct->new_modifier($mod); - } - - $last_type = ''; - } elsif (/$group_start_re/) { # start of an explicit group - warn "Encountered explicit group start\n" if $self->debug; - - my ($substruct, $subremainder) = $self->decompose( $', $current_class, $recursing + 1 ); - $struct->add_node( $substruct ); - $_ = $subremainder; - - $last_type = ''; - } elsif (/$and_re/) { # ANDed expression - $_ = $'; - next if ($last_type eq 'AND'); - next if ($last_type eq 'OR'); - warn "Encountered AND\n" if $self->debug; - - $struct->joiner( '&' ); - - $last_type = 'AND'; - } elsif (/$or_re/) { # ORed expression - $_ = $'; - next if ($last_type eq 'AND'); - next if ($last_type eq 'OR'); - warn "Encountered OR\n" if $self->debug; - - $struct->joiner( '|' ); - - $last_type = 'OR'; - } elsif ($self->facet_class_count && /$facet_re/) { # changing current class - warn "Encountered facet: $1 => $2\n" if $self->debug; - - my $facet = $1; - my $facet_value = [ split '\s*#\s*', $2 ]; - $struct->new_facet( $facet => $facet_value ); - $_ = $'; - - $last_type = ''; - } elsif ($self->search_class_count && /$search_class_re/) { # changing current class - - if ($last_type eq 'CLASS') { - $struct->remove_last_node( $current_class ); - warn "Encountered class change with no searches!\n" if $self->debug; - } - - warn "Encountered class change: $1\n" if $self->debug; - - $current_class = $1; - $struct->classed_node( $current_class ); - $_ = $'; - - $last_type = 'CLASS'; - } elsif (/^\s*"([^"]+)"/) { # phrase, always anded - warn "Encountered phrase: $1\n" if $self->debug; - - $struct->joiner( '&' ); - my $phrase = $1; - - my $class_node = $struct->classed_node($current_class); - $class_node->add_phrase( $phrase ); - $_ = $phrase . $'; - - $last_type = ''; - } elsif (/$required_re([^\s)]+)/) { # phrase, always anded - warn "Encountered required atom (mini phrase): $1\n" if $self->debug; - - my $phrase = $1; - - my $class_node = $struct->classed_node($current_class); - $class_node->add_phrase( $phrase ); - $_ = $phrase . $'; - $struct->joiner( '&' ); - - $last_type = ''; - } elsif (/^\s*([^$group_end\s]+)/o) { # atom - warn "Encountered atom: $1\n" if $self->debug; - warn "Remainder: $'\n" if $self->debug; - - my $atom = $1; - my $after = $'; - - $_ = $after; - $last_type = ''; - - my $negator = ($atom =~ s/^-//o) ? '!' : ''; - my $truncate = ($atom =~ s/\*$//o) ? '*' : ''; - - if (!grep { $atom eq $_ } ('&','|')) { # throw away & and |, not allowed in tsquery, and not really useful anyway - my $class_node = $struct->classed_node($current_class); - $class_node->add_fts_atom( $atom, suffix => $truncate, prefix => $negator, node => $class_node ); - $struct->joiner( '&' ); - } - } - - last unless ($_); - - } - - return $struct if !wantarray; - return ($struct, $remainder); -} - -sub find_class_index { - my $class = shift; - my $query = shift; - - my ($class_part, @field_parts) = split '\|', $class; - $class_part ||= $class; - - for my $idx ( 0 .. scalar(@$query) - 1 ) { - next unless ref($$query[$idx]); - return $idx if ( $$query[$idx]{requested_class} && $class eq $$query[$idx]{requested_class} ); - } - - push(@$query, { classname => $class_part, (@field_parts ? (fields => \@field_parts) : ()), requested_class => $class, ftsquery => [], phrases => [] }); - return -1; -} - -sub core_limit { - my $self = shift; - my $l = shift; - $self->{core_limit} = $l if ($l); - return $self->{core_limit}; -} - -sub superpage { - my $self = shift; - my $l = shift; - $self->{superpage} = $l if ($l); - return $self->{superpage}; -} - -sub superpage_size { - my $self = shift; - my $l = shift; - $self->{superpage_size} = $l if ($l); - return $self->{superpage_size}; -} - - -#------------------------------- -package QueryParser::query_plan; - -sub QueryParser { - my $self = shift; - return undef unless ref($self); - return $self->{QueryParser}; -} - -sub new { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my %args = (query => [], joiner => '&', @_); - - return bless \%args => $pkg; -} - -sub new_node { - my $self = shift; - my $pkg = ref($self) || $self; - my $node = do{$pkg.'::node'}->new( plan => $self, @_ ); - $self->add_node( $node ); - return $node; -} - -sub new_facet { - my $self = shift; - my $pkg = ref($self) || $self; - my $name = shift; - my $args = shift; - - my $node = do{$pkg.'::facet'}->new( plan => $self, name => $name, 'values' => $args ); - $self->add_node( $node ); - - return $node; -} - -sub new_filter { - my $self = shift; - my $pkg = ref($self) || $self; - my $name = shift; - my $args = shift; - - my $node = do{$pkg.'::filter'}->new( plan => $self, name => $name, args => $args ); - $self->add_filter( $node ); - - return $node; -} - -sub find_filter { - my $self = shift; - my $needle = shift;; - return undef unless ($needle); - return grep { $_->name eq $needle } @{ $self->filters }; -} - -sub find_modifier { - my $self = shift; - my $needle = shift;; - return undef unless ($needle); - return grep { $_->name eq $needle } @{ $self->modifiers }; -} - -sub new_modifier { - my $self = shift; - my $pkg = ref($self) || $self; - my $name = shift; - - my $node = do{$pkg.'::modifier'}->new( $name ); - $self->add_modifier( $node ); - - return $node; -} - -sub classed_node { - my $self = shift; - my $requested_class = shift; - - my $node; - for my $n (@{$self->{query}}) { - next unless (ref($n) && $n->isa( 'QueryParser::query_plan::node' )); - if ($n->requested_class eq $requested_class) { - $node = $n; - last; - } - } - - if (!$node) { - $node = $self->new_node; - $node->requested_class( $requested_class ); - } - - return $node; -} - -sub remove_last_node { - my $self = shift; - my $requested_class = shift; - - my $old = pop(@{$self->query_nodes}); - pop(@{$self->query_nodes}) if (@{$self->query_nodes}); - - return $old; -} - -sub query_nodes { - my $self = shift; - return $self->{query}; -} - -sub add_node { - my $self = shift; - my $node = shift; - - $self->{query} ||= []; - push(@{$self->{query}}, $self->joiner) if (@{$self->{query}}); - push(@{$self->{query}}, $node); - - return $self; -} - -sub top_plan { - my $self = shift; - - return $self->{level} ? 0 : 1; -} - -sub plan_level { - my $self = shift; - return $self->{level}; -} - -sub joiner { - my $self = shift; - my $joiner = shift; - - $self->{joiner} = $joiner if ($joiner); - return $self->{joiner}; -} - -sub modifiers { - my $self = shift; - $self->{modifiers} ||= []; - return $self->{modifiers}; -} - -sub add_modifier { - my $self = shift; - my $modifier = shift; - - $self->{modifiers} ||= []; - return $self if (grep {$$_ eq $$modifier} @{$self->{modifiers}}); - - push(@{$self->{modifiers}}, $modifier); - - return $self; -} - -sub facets { - my $self = shift; - $self->{facets} ||= []; - return $self->{facets}; -} - -sub add_facet { - my $self = shift; - my $facet = shift; - - $self->{facets} ||= []; - return $self if (grep {$_->name eq $facet->name} @{$self->{facets}}); - - push(@{$self->{facets}}, $facet); - - return $self; -} - -sub filters { - my $self = shift; - $self->{filters} ||= []; - return $self->{filters}; -} - -sub add_filter { - my $self = shift; - my $filter = shift; - - $self->{filters} ||= []; - return $self if (grep {$_->name eq $filter->name} @{$self->{filters}}); - - push(@{$self->{filters}}, $filter); - - return $self; -} - - -#------------------------------- -package QueryParser::query_plan::node; - -sub new { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my %args = @_; - - return bless \%args => $pkg; -} - -sub new_atom { - my $self = shift; - my $pkg = ref($self) || $self; - return do{$pkg.'::atom'}->new( @_ ); -} - -sub requested_class { # also split into classname and fields - my $self = shift; - my $class = shift; - - if ($class) { - my ($class_part, @field_parts) = split '\|', $class; - $class_part ||= $class; - - $self->{requested_class} = $class; - $self->{classname} = $class_part; - $self->{fields} = \@field_parts; - } - - return $self->{requested_class}; -} - -sub plan { - my $self = shift; - my $plan = shift; - - $self->{plan} = $plan if ($plan); - return $self->{plan}; -} - -sub classname { - my $self = shift; - my $class = shift; - - $self->{classname} = $class if ($class); - return $self->{classname}; -} - -sub fields { - my $self = shift; - my @fields = @_; - - $self->{fields} ||= []; - $self->{fields} = \@fields if (@fields); - return $self->{fields}; -} - -sub phrases { - my $self = shift; - my @phrases = @_; - - $self->{phrases} ||= []; - $self->{phrases} = \@phrases if (@phrases); - return $self->{phrases}; -} - -sub add_phrase { - my $self = shift; - my $phrase = shift; - - push(@{$self->phrases}, $phrase); - - return $self; -} - -sub query_atoms { - my $self = shift; - my @query_atoms = @_; - - $self->{query_atoms} ||= []; - $self->{query_atoms} = \@query_atoms if (@query_atoms); - return $self->{query_atoms}; -} - -sub add_fts_atom { - my $self = shift; - my $atom = shift; - - if (!ref($atom)) { - my $content = $atom; - my @parts = @_; - - $atom = $self->new_atom( content => $content, @parts ); - } - - push(@{$self->query_atoms}, $self->plan->joiner) if (@{$self->query_atoms}); - push(@{$self->query_atoms}, $atom); - - return $self; -} - -#------------------------------- -package QueryParser::query_plan::node::atom; - -sub new { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my %args = @_; - - return bless \%args => $pkg; -} - -sub node { - my $self = shift; - return undef unless (ref $self); - return $self->{node}; -} - -sub content { - my $self = shift; - return undef unless (ref $self); - return $self->{content}; -} - -sub prefix { - my $self = shift; - return undef unless (ref $self); - return $self->{prefix}; -} - -sub suffix { - my $self = shift; - return undef unless (ref $self); - return $self->{suffix}; -} - -#------------------------------- -package QueryParser::query_plan::filter; - -sub new { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my %args = @_; - - return bless \%args => $pkg; -} - -sub plan { - my $self = shift; - return $self->{plan}; -} - -sub name { - my $self = shift; - return $self->{name}; -} - -sub args { - my $self = shift; - return $self->{args}; -} - -#------------------------------- -package QueryParser::query_plan::facet; - -sub new { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my %args = @_; - - return bless \%args => $pkg; -} - -sub plan { - my $self = shift; - return $self->{plan}; -} - -sub name { - my $self = shift; - return $self->{name}; -} - -sub values { - my $self = shift; - return $self->{'values'}; -} - -#------------------------------- -package QueryParser::query_plan::modifier; - -sub new { - my $pkg = shift; - $pkg = ref($pkg) || $pkg; - my $modifier = shift; - - return bless \$modifier => $pkg; -} - -sub name { - my $self = shift; - return $$self; -} - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/SuperCat.pm b/Open-ILS/src/perlmods/OpenILS/Application/SuperCat.pm deleted file mode 100644 index eed53b1bc7..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/SuperCat.pm +++ /dev/null @@ -1,3398 +0,0 @@ -# We'll be working with XML, so... -use XML::LibXML; -use XML::LibXSLT; -use Unicode::Normalize; - -# ... and this has some handy common methods -use OpenILS::Application::AppUtils; - -my $parser = new XML::LibXML; -my $U = 'OpenILS::Application::AppUtils'; - - -package OpenILS::Application::SuperCat; - -use strict; -use warnings; -use OpenILS::Utils::Normalize qw( naco_normalize ); - -# All OpenSRF applications must be based on OpenSRF::Application or -# a subclass thereof. Makes sense, eh? -use OpenILS::Application; -use base qw/OpenILS::Application/; - -# This is the client class, used for connecting to open-ils.storage -use OpenSRF::AppSession; - -# This is an extension of Error.pm that supplies some error types to throw -use OpenSRF::EX qw(:try); - -# This is a helper class for querying the OpenSRF Settings application ... -use OpenSRF::Utils::SettingsClient; - -# ... and here we have the built in logging helper ... -use OpenSRF::Utils::Logger qw($logger); - -# ... and this is our OpenILS object (en|de)coder and psuedo-ORM package. -use OpenILS::Utils::Fieldmapper; - -our ( - $_parser, - $_xslt, - %record_xslt, - %metarecord_xslt, - %holdings_data_cache, -); - -sub child_init { - # we need an XML parser - $_parser = new XML::LibXML; - - # and an xslt parser - $_xslt = new XML::LibXSLT; - - # parse the MODS xslt ... - my $mods33_xslt = $_parser->parse_file( - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ). - "/MARC21slim2MODS33.xsl" - ); - # and stash a transformer - $record_xslt{mods33}{xslt} = $_xslt->parse_stylesheet( $mods33_xslt ); - $record_xslt{mods33}{namespace_uri} = 'http://www.loc.gov/mods/v3'; - $record_xslt{mods33}{docs} = 'http://www.loc.gov/mods/'; - $record_xslt{mods33}{schema_location} = 'http://www.loc.gov/standards/mods/v3/mods-3-3.xsd'; - - # parse the MODS xslt ... - my $mods32_xslt = $_parser->parse_file( - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ). - "/MARC21slim2MODS32.xsl" - ); - # and stash a transformer - $record_xslt{mods32}{xslt} = $_xslt->parse_stylesheet( $mods32_xslt ); - $record_xslt{mods32}{namespace_uri} = 'http://www.loc.gov/mods/v3'; - $record_xslt{mods32}{docs} = 'http://www.loc.gov/mods/'; - $record_xslt{mods32}{schema_location} = 'http://www.loc.gov/standards/mods/v3/mods-3-2.xsd'; - - # parse the MODS xslt ... - my $mods3_xslt = $_parser->parse_file( - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ). - "/MARC21slim2MODS3.xsl" - ); - # and stash a transformer - $record_xslt{mods3}{xslt} = $_xslt->parse_stylesheet( $mods3_xslt ); - $record_xslt{mods3}{namespace_uri} = 'http://www.loc.gov/mods/v3'; - $record_xslt{mods3}{docs} = 'http://www.loc.gov/mods/'; - $record_xslt{mods3}{schema_location} = 'http://www.loc.gov/standards/mods/v3/mods-3-1.xsd'; - - # parse the MODS xslt ... - my $mods_xslt = $_parser->parse_file( - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ). - "/MARC21slim2MODS.xsl" - ); - # and stash a transformer - $record_xslt{mods}{xslt} = $_xslt->parse_stylesheet( $mods_xslt ); - $record_xslt{mods}{namespace_uri} = 'http://www.loc.gov/mods/'; - $record_xslt{mods}{docs} = 'http://www.loc.gov/mods/'; - $record_xslt{mods}{schema_location} = 'http://www.loc.gov/standards/mods/mods.xsd'; - - # parse the ATOM entry xslt ... - my $atom_xslt = $_parser->parse_file( - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ). - "/MARC21slim2ATOM.xsl" - ); - # and stash a transformer - $record_xslt{atom}{xslt} = $_xslt->parse_stylesheet( $atom_xslt ); - $record_xslt{atom}{namespace_uri} = 'http://www.w3.org/2005/Atom'; - $record_xslt{atom}{docs} = 'http://www.ietf.org/rfc/rfc4287.txt'; - - # parse the RDFDC xslt ... - my $rdf_dc_xslt = $_parser->parse_file( - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ). - "/MARC21slim2RDFDC.xsl" - ); - # and stash a transformer - $record_xslt{rdf_dc}{xslt} = $_xslt->parse_stylesheet( $rdf_dc_xslt ); - $record_xslt{rdf_dc}{namespace_uri} = 'http://purl.org/dc/elements/1.1/'; - $record_xslt{rdf_dc}{schema_location} = 'http://purl.org/dc/elements/1.1/'; - - # parse the SRWDC xslt ... - my $srw_dc_xslt = $_parser->parse_file( - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ). - "/MARC21slim2SRWDC.xsl" - ); - # and stash a transformer - $record_xslt{srw_dc}{xslt} = $_xslt->parse_stylesheet( $srw_dc_xslt ); - $record_xslt{srw_dc}{namespace_uri} = 'info:srw/schema/1/dc-schema'; - $record_xslt{srw_dc}{schema_location} = 'http://www.loc.gov/z3950/agency/zing/srw/dc-schema.xsd'; - - # parse the OAIDC xslt ... - my $oai_dc_xslt = $_parser->parse_file( - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ). - "/MARC21slim2OAIDC.xsl" - ); - # and stash a transformer - $record_xslt{oai_dc}{xslt} = $_xslt->parse_stylesheet( $oai_dc_xslt ); - $record_xslt{oai_dc}{namespace_uri} = 'http://www.openarchives.org/OAI/2.0/oai_dc/'; - $record_xslt{oai_dc}{schema_location} = 'http://www.openarchives.org/OAI/2.0/oai_dc.xsd'; - - # parse the RSS xslt ... - my $rss_xslt = $_parser->parse_file( - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ). - "/MARC21slim2RSS2.xsl" - ); - # and stash a transformer - $record_xslt{rss2}{xslt} = $_xslt->parse_stylesheet( $rss_xslt ); - - # parse the FGDC xslt ... - my $fgdc_xslt = $_parser->parse_file( - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ). - "/MARC21slim2FGDC.xsl" - ); - # and stash a transformer - $record_xslt{fgdc}{xslt} = $_xslt->parse_stylesheet( $fgdc_xslt ); - $record_xslt{fgdc}{docs} = 'http://www.fgdc.gov/metadata/csdgm/index_html'; - $record_xslt{fgdc}{schema_location} = 'http://www.fgdc.gov/metadata/fgdc-std-001-1998.xsd'; - - register_record_transforms(); - - return 1; -} - -sub register_record_transforms { - for my $type ( keys %record_xslt ) { - __PACKAGE__->register_method( - method => 'retrieve_record_transform', - api_name => "open-ils.supercat.record.$type.retrieve", - api_level => 1, - argc => 1, - signature => - { desc => "Returns the \U$type\E representation ". - "of the requested bibliographic record", - params => - [ - { name => 'bibId', - desc => 'An OpenILS biblio::record_entry id', - type => 'number' }, - ], - 'return' => - { desc => "The bib record in \U$type\E", - type => 'string' } - } - ); - - __PACKAGE__->register_method( - method => 'retrieve_isbn_transform', - api_name => "open-ils.supercat.isbn.$type.retrieve", - api_level => 1, - argc => 1, - signature => - { desc => "Returns the \U$type\E representation ". - "of the requested bibliographic record", - params => - [ - { name => 'isbn', - desc => 'An ISBN', - type => 'string' }, - ], - 'return' => - { desc => "The bib record in \U$type\E", - type => 'string' } - } - ); - } -} - -sub tree_walker { - my $tree = shift; - my $field = shift; - my $filter = shift; - - return unless ($tree && ref($tree->$field)); - - my @things = $filter->($tree); - for my $v ( @{$tree->$field} ){ - push @things, $filter->($v); - push @things, tree_walker($v, $field, $filter); - } - return @things -} - -sub cn_browse { - my $self = shift; - my $client = shift; - - my $label = shift; - my $ou = shift; - my $page_size = shift || 9; - my $page = shift || 0; - my $statuses = shift || []; - my $copy_locations = shift || []; - - my ($before_limit,$after_limit) = (0,0); - my ($before_offset,$after_offset) = (0,0); - - if (!$page) { - $before_limit = $after_limit = int($page_size / 2); - $after_limit += 1 if ($page_size % 2); - } else { - $before_offset = $after_offset = int($page_size / 2); - $before_offset += 1 if ($page_size % 2); - $before_limit = $after_limit = $page_size; - } - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - - my $o_search = { shortname => $ou }; - if (!$ou || $ou eq '-') { - $o_search = { parent_ou => undef }; - } - - my $orgs = $_storage->request( - "open-ils.cstore.direct.actor.org_unit.search", - $o_search, - { flesh => 100, - flesh_fields => { aou => [qw/children/] } - } - )->gather(1); - - my @ou_ids = tree_walker($orgs, 'children', sub {shift->id}) if $orgs; - - $logger->debug("Searching for CNs at orgs [".join(',',@ou_ids)."], based on $ou"); - - my @list = (); - - my @cp_filter = (); - if (@$statuses || @$copy_locations) { - @cp_filter = ( - '-exists' => { - from => 'acp', - where => { - call_number => { '=' => { '+acn' => 'id' } }, - deleted => 'f', - ((@$statuses) ? ( status => $statuses) : ()), - ((@$copy_locations) ? ( location => $copy_locations) : ()) - } - } - ); - } - - if ($page <= 0) { - my $before = $_storage->request( - "open-ils.cstore.direct.asset.call_number.search.atomic", - { label => { "<" => { transform => "oils_text_as_bytea", value => ["oils_text_as_bytea", $label] } }, - owning_lib => \@ou_ids, - deleted => 'f', - @cp_filter - }, - { flesh => 1, - flesh_fields => { acn => [qw/record owning_lib/] }, - order_by => { acn => "oils_text_as_bytea(label_sortkey) desc, oils_text_as_bytea(label) desc, id desc, owning_lib desc" }, - limit => $before_limit, - offset => abs($page) * $page_size - $before_offset, - } - )->gather(1); - push @list, reverse(@$before); - } - - if ($page >= 0) { - my $after = $_storage->request( - "open-ils.cstore.direct.asset.call_number.search.atomic", - { label => { ">=" => { transform => "oils_text_as_bytea", value => ["oils_text_as_bytea", $label] } }, - owning_lib => \@ou_ids, - deleted => 'f', - @cp_filter - }, - { flesh => 1, - flesh_fields => { acn => [qw/record owning_lib/] }, - order_by => { acn => "oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib" }, - limit => $after_limit, - offset => abs($page) * $page_size - $after_offset, - } - )->gather(1); - push @list, @$after; - } - - return \@list; -} -__PACKAGE__->register_method( - method => 'cn_browse', - api_name => 'open-ils.supercat.call_number.browse', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns the XML representation of the requested bibliographic record's holdings - DESC - params => - [ - { name => 'label', - desc => 'The target call number lable', - type => 'string' }, - { name => 'org_unit', - desc => 'The org unit shortname (or "-" or undef for global) to browse', - type => 'string' }, - { name => 'page_size', - desc => 'Count of call numbers to retrieve, default is 9', - type => 'number' }, - { name => 'page', - desc => 'The page of call numbers to retrieve, calculated based on page_size. Can be positive, negative or 0.', - type => 'number' }, - { name => 'statuses', - desc => 'Array of statuses to filter copies by, optional and can be undef.', - type => 'array' }, - { name => 'locations', - desc => 'Array of copy locations to filter copies by, optional and can be undef.', - type => 'array' }, - ], - 'return' => - { desc => 'Call numbers with owning_lib and record fleshed', - type => 'array' } - } -); - -sub cn_startwith { - my $self = shift; - my $client = shift; - - my $label = shift; - my $ou = shift; - my $limit = shift || 10; - my $page = shift || 0; - my $statuses = shift || []; - my $copy_locations = shift || []; - - - my $offset = abs($page) * $limit; - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - - my $o_search = { shortname => $ou }; - if (!$ou || $ou eq '-') { - $o_search = { parent_ou => undef }; - } - - my $orgs = $_storage->request( - "open-ils.cstore.direct.actor.org_unit.search", - $o_search, - { flesh => 100, - flesh_fields => { aou => [qw/children/] } - } - )->gather(1); - - my @ou_ids = tree_walker($orgs, 'children', sub {shift->id}) if $orgs; - - $logger->debug("Searching for CNs at orgs [".join(',',@ou_ids)."], based on $ou"); - - my @list = (); - - my @cp_filter = (); - if (@$statuses || @$copy_locations) { - @cp_filter = ( - '-exists' => { - from => 'acp', - where => { - call_number => { '=' => { '+acn' => 'id' } }, - deleted => 'f', - ((@$statuses) ? ( status => $statuses) : ()), - ((@$copy_locations) ? ( location => $copy_locations) : ()) - } - } - ); - } - - if ($page < 0) { - my $before = $_storage->request( - "open-ils.cstore.direct.asset.call_number.search.atomic", - { label => { "<" => { transform => "oils_text_as_bytea", value => ["oils_text_as_bytea", $label] } }, - owning_lib => \@ou_ids, - deleted => 'f', - @cp_filter - }, - { flesh => 1, - flesh_fields => { acn => [qw/record owning_lib/] }, - order_by => { acn => "oils_text_as_bytea(label_sortkey) desc, oils_text_as_bytea(label) desc, id desc, owning_lib desc" }, - limit => $limit, - offset => $offset, - } - )->gather(1); - push @list, reverse(@$before); - } - - if ($page >= 0) { - my $after = $_storage->request( - "open-ils.cstore.direct.asset.call_number.search.atomic", - { label => { ">=" => { transform => "oils_text_as_bytea", value => ["oils_text_as_bytea", $label] } }, - owning_lib => \@ou_ids, - deleted => 'f', - @cp_filter - }, - { flesh => 1, - flesh_fields => { acn => [qw/record owning_lib/] }, - order_by => { acn => "oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib" }, - limit => $limit, - offset => $offset, - } - )->gather(1); - push @list, @$after; - } - - return \@list; -} -__PACKAGE__->register_method( - method => 'cn_startwith', - api_name => 'open-ils.supercat.call_number.startwith', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns the XML representation of the requested bibliographic record's holdings - DESC - params => - [ - { name => 'label', - desc => 'The target call number lable', - type => 'string' }, - { name => 'org_unit', - desc => 'The org unit shortname (or "-" or undef for global) to browse', - type => 'string' }, - { name => 'page_size', - desc => 'Count of call numbers to retrieve, default is 9', - type => 'number' }, - { name => 'page', - desc => 'The page of call numbers to retrieve, calculated based on page_size. Can be positive, negative or 0.', - type => 'number' }, - { name => 'statuses', - desc => 'Array of statuses to filter copies by, optional and can be undef.', - type => 'array' }, - { name => 'locations', - desc => 'Array of copy locations to filter copies by, optional and can be undef.', - type => 'array' }, - ], - 'return' => - { desc => 'Call numbers with owning_lib and record fleshed', - type => 'array' } - } -); - - -sub new_books_by_item { - my $self = shift; - my $client = shift; - - my $ou = shift; - my $page_size = shift || 10; - my $page = shift || 1; - my $statuses = shift || []; - my $copy_locations = shift || []; - - my $offset = $page_size * ($page - 1); - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - - my @ou_ids; - if ($ou && $ou ne '-') { - my $orgs = $_storage->request( - "open-ils.cstore.direct.actor.org_unit.search", - { shortname => $ou }, - { flesh => 100, - flesh_fields => { aou => [qw/children/] } - } - )->gather(1); - @ou_ids = tree_walker($orgs, 'children', sub {shift->id}) if $orgs; - } - - $logger->debug("Searching for records with new copies at orgs [".join(',',@ou_ids)."], based on $ou"); - my $cns = $_storage->request( - "open-ils.cstore.json_query.atomic", - { select => { acn => ['record'], - acp => [{ aggregate => 1 => transform => max => column => create_date => alias => 'create_date'}] - }, - from => { 'acn' => { 'acp' => { field => call_number => fkey => 'id' } } }, - where => - { '+acp' => - { deleted => 'f', - ((@ou_ids) ? ( circ_lib => \@ou_ids) : ()), - ((@$statuses) ? ( status => $statuses) : ()), - ((@$copy_locations) ? ( location => $copy_locations) : ()) - }, - '+acn' => { record => { '>' => 0 } }, - }, - order_by => { acp => { create_date => { transform => 'max', direction => 'desc' } } }, - limit => $page_size, - offset => $offset - } - )->gather(1); - - return [ map { $_->{record} } @$cns ]; -} -__PACKAGE__->register_method( - method => 'new_books_by_item', - api_name => 'open-ils.supercat.new_book_list', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns the XML representation of the requested bibliographic record's holdings - DESC - params => - [ - { name => 'org_unit', - desc => 'The org unit shortname (or "-" or undef for global) to list', - type => 'string' }, - { name => 'page_size', - desc => 'Count of records to retrieve, default is 10', - type => 'number' }, - { name => 'page', - desc => 'The page of records to retrieve, calculated based on page_size. Starts at 1.', - type => 'number' }, - { name => 'statuses', - desc => 'Array of statuses to filter copies by, optional and can be undef.', - type => 'array' }, - { name => 'locations', - desc => 'Array of copy locations to filter copies by, optional and can be undef.', - type => 'array' }, - ], - 'return' => - { desc => 'Record IDs', - type => 'array' } - } -); - - -sub general_browse { - my $self = shift; - my $client = shift; - return tag_sf_browse($self, $client, $self->{tag}, $self->{subfield}, @_); -} -__PACKAGE__->register_method( - method => 'general_browse', - api_name => 'open-ils.supercat.title.browse', - tag => 'tnf', subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested org-scoped record IDs held", - params => - [ { name => 'value', desc => 'The target title', type => 'string' }, - { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, - { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' }, - { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ], - 'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_browse', - api_name => 'open-ils.supercat.author.browse', - tag => [qw/100 110 111/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested org-scoped record IDs held", - params => - [ { name => 'value', desc => 'The target author', type => 'string' }, - { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, - { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' }, - { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ], - 'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_browse', - api_name => 'open-ils.supercat.subject.browse', - tag => [qw/600 610 611 630 648 650 651 653 655 656 662 690 691 696 697 698 699/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested org-scoped record IDs held", - params => - [ { name => 'value', desc => 'The target subject', type => 'string' }, - { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, - { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' }, - { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ], - 'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_browse', - api_name => 'open-ils.supercat.topic.browse', - tag => [qw/650 690/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested org-scoped record IDs held", - params => - [ { name => 'value', desc => 'The target topical subject', type => 'string' }, - { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, - { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' }, - { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ], - 'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_browse', - api_name => 'open-ils.supercat.series.browse', - tag => [qw/440 490 800 810 811 830/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested org-scoped record IDs held", - params => - [ { name => 'value', desc => 'The target series', type => 'string' }, - { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, - { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' }, - { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ], - 'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' } - } -); - - -sub tag_sf_browse { - my $self = shift; - my $client = shift; - - my $tag = shift; - my $subfield = shift; - my $value = shift; - my $ou = shift; - my $page_size = shift || 9; - my $page = shift || 0; - my $statuses = shift || []; - my $copy_locations = shift || []; - - my ($before_limit,$after_limit) = (0,0); - my ($before_offset,$after_offset) = (0,0); - - if (!$page) { - $before_limit = $after_limit = int($page_size / 2); - $after_limit += 1 if ($page_size % 2); - } else { - $before_offset = $after_offset = int($page_size / 2); - $before_offset += 1 if ($page_size % 2); - $before_limit = $after_limit = $page_size; - } - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - - my @ou_ids; - if ($ou && $ou ne '-') { - my $orgs = $_storage->request( - "open-ils.cstore.direct.actor.org_unit.search", - { shortname => $ou }, - { flesh => 100, - flesh_fields => { aou => [qw/children/] } - } - )->gather(1); - @ou_ids = tree_walker($orgs, 'children', sub {shift->id}) if $orgs; - } - - $logger->debug("Searching for records at orgs [".join(',',@ou_ids)."], based on $ou"); - - my @list = (); - - if ($page <= 0) { - my $before = $_storage->request( - "open-ils.cstore.json_query.atomic", - { select => { mfr => [qw/record value/] }, - from => 'mfr', - where => - { '+mfr' => - { tag => $tag, - subfield => $subfield, - value => { '<' => lc($value) } - }, - '-or' => [ - { '-exists' => - { select=> { acp => [ 'id' ] }, - from => { acn => { acp => { field => 'call_number', fkey => 'id' } } }, - where => - { '+acn' => { record => { '=' => { '+mfr' => 'record' } } }, - '+acp' => - { deleted => 'f', - ((@ou_ids) ? ( circ_lib => \@ou_ids) : ()), - ((@$statuses) ? ( status => $statuses) : ()), - ((@$copy_locations) ? ( location => $copy_locations) : ()) - } - }, - limit => 1 - } - }, - { '-exists' => - { select=> { auri => [ 'id' ] }, - from => { acn => { auricnm => { field => 'call_number', fkey => 'id', join => { auri => { field => 'id', fkey => 'uri' } } } } }, - where => - { '+acn' => { record => { '=' => { '+mfr' => 'record' } }, (@ou_ids) ? ( owning_lib => \@ou_ids) : () }, - '+auri' => { active => 't' } - }, - limit => 1 - } - } - ] - }, - order_by => { mfr => { value => 'desc' } }, - limit => $before_limit, - offset => abs($page) * $page_size - $before_offset, - } - )->gather(1); - push @list, map { $_->{record} } reverse(@$before); - } - - if ($page >= 0) { - my $after = $_storage->request( - "open-ils.cstore.json_query.atomic", - { select => { mfr => [qw/record value/] }, - from => 'mfr', - where => - { '+mfr' => - { tag => $tag, - subfield => $subfield, - value => { '>=' => lc($value) } - }, - '-or' => [ - { '-exists' => - { select=> { acp => [ 'id' ] }, - from => { acn => { acp => { field => 'call_number', fkey => 'id' } } }, - where => - { '+acn' => { record => { '=' => { '+mfr' => 'record' } } }, - '+acp' => - { deleted => 'f', - ((@ou_ids) ? ( circ_lib => \@ou_ids) : ()), - ((@$statuses) ? ( status => $statuses) : ()), - ((@$copy_locations) ? ( location => $copy_locations) : ()) - } - }, - limit => 1 - } - }, - { '-exists' => - { select=> { auri => [ 'id' ] }, - from => { acn => { auricnm => { field => 'call_number', fkey => 'id', join => { auri => { field => 'id', fkey => 'uri' } } } } }, - where => - { '+acn' => { record => { '=' => { '+mfr' => 'record' } }, (@ou_ids) ? ( owning_lib => \@ou_ids) : () }, - '+auri' => { active => 't' } - }, - limit => 1 - }, - } - ] - }, - order_by => { mfr => { value => 'asc' } }, - limit => $after_limit, - offset => abs($page) * $page_size - $after_offset, - } - )->gather(1); - push @list, map { $_->{record} } @$after; - } - - return \@list; -} -__PACKAGE__->register_method( - method => 'tag_sf_browse', - api_name => 'open-ils.supercat.tag.browse', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns a list of the requested org-scoped record IDs held - DESC - params => - [ - { name => 'tag', - desc => 'The target MARC tag', - type => 'string' }, - { name => 'subfield', - desc => 'The target MARC subfield', - type => 'string' }, - { name => 'value', - desc => 'The target string', - type => 'string' }, - { name => 'org_unit', - desc => 'The org unit shortname (or "-" or undef for global) to browse', - type => 'string' }, - { name => 'page_size', - desc => 'Count of call numbers to retrieve, default is 9', - type => 'number' }, - { name => 'page', - desc => 'The page of call numbers to retrieve, calculated based on page_size. Can be positive, negative or 0.', - type => 'number' }, - { name => 'statuses', - desc => 'Array of statuses to filter copies by, optional and can be undef.', - type => 'array' }, - { name => 'locations', - desc => 'Array of copy locations to filter copies by, optional and can be undef.', - type => 'array' }, - ], - 'return' => - { desc => 'Record IDs that have copies at the relevant org units', - type => 'array' } - } -); - -sub general_authority_browse { - my $self = shift; - my $client = shift; - return authority_tag_sf_browse($self, $client, $self->{tag}, $self->{subfield}, @_); -} -__PACKAGE__->register_method( - method => 'general_authority_browse', - api_name => 'open-ils.supercat.authority.title.browse', - tag => ['130'], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held", - params => - [ { name => 'value', desc => 'The target title', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_authority_browse', - api_name => 'open-ils.supercat.authority.author.browse', - tag => [qw/100 110 111/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held", - params => - [ { name => 'value', desc => 'The target author', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_authority_browse', - api_name => 'open-ils.supercat.authority.subject.browse', - tag => [qw/148 150 151 155/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held", - params => - [ { name => 'value', desc => 'The target subject', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_authority_browse', - api_name => 'open-ils.supercat.authority.topic.browse', - tag => ['150'], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held", - params => - [ { name => 'value', desc => 'The target topical subject', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_authority_browse', - api_name => 'open-ils.supercat.authority.title.refs.browse', - tag => ['130'], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references", - params => - [ { name => 'value', desc => 'The target title', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_authority_browse', - api_name => 'open-ils.supercat.authority.author.refs.browse', - tag => [qw/100 110 111/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references", - params => - [ { name => 'value', desc => 'The target author', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_authority_browse', - api_name => 'open-ils.supercat.authority.subject.refs.browse', - tag => [qw/148 150 151 155/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references", - params => - [ { name => 'value', desc => 'The target subject', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_authority_browse', - api_name => 'open-ils.supercat.authority.topic.refs.browse', - tag => ['150'], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references", - params => - [ { name => 'value', desc => 'The target topical subject', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); - -sub authority_tag_sf_browse { - my $self = shift; - my $client = shift; - - my $tag = shift; - my $subfield = shift; - my $value = shift; - my $page_size = shift || 9; - my $page = shift || 0; - - # Match authority.full_rec normalization - $value = naco_normalize($value, $subfield); - - my ($before_limit,$after_limit) = (0,0); - my ($before_offset,$after_offset) = (0,0); - - if (!$page) { - $before_limit = $after_limit = int($page_size / 2); - $after_limit += 1 if ($page_size % 2); - } else { - $before_offset = $after_offset = int($page_size / 2); - $before_offset += 1 if ($page_size % 2); - $before_limit = $after_limit = $page_size; - } - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - - # .refs variant includes 4xx and 5xx variants for see / see also - my @ref_tags = (); - foreach my $tagname (@$tag) { - push(@ref_tags, $tagname); - if ($self->api_name =~ /\.refs\./) { - push(@ref_tags, '4' . substr($tagname, 1, 2)); - push(@ref_tags, '5' . substr($tagname, 1, 2)); - } - } - my @list = (); - - if ($page <= 0) { - my $before = $_storage->request( - "open-ils.cstore.json_query.atomic", - { select => { afr => [qw/record value/] }, - from => { 'are', 'afr' }, - where => { - '+afr' => { tag => \@ref_tags, subfield => $subfield, value => { '<' => $value } }, - '+are' => { 'deleted' => 'f' } - }, - order_by => { afr => { value => 'desc' } }, - limit => $before_limit, - offset => abs($page) * $page_size - $before_offset, - } - )->gather(1); - push @list, map { $_->{record} } reverse(@$before); - } - - if ($page >= 0) { - my $after = $_storage->request( - "open-ils.cstore.json_query.atomic", - { select => { afr => [qw/record value/] }, - from => { 'are', 'afr' }, - where => { - '+afr' => { tag => \@ref_tags, subfield => $subfield, value => { '>=' => $value } }, - '+are' => { 'deleted' => 'f' } - }, - order_by => { afr => { value => 'asc' } }, - limit => $after_limit, - offset => abs($page) * $page_size - $after_offset, - } - )->gather(1); - push @list, map { $_->{record} } @$after; - } - - # If we're not pulling in see/see also references, just return the raw list - if ($self->api_name !~ /\.refs\./) { - return \@list; - } - - # Remove dupe record IDs that turn up due to 4xx and 5xx matches - my @retlist = (); - my %seen; - foreach my $record (@list) { - next if exists $seen{$record}; - push @retlist, int($record); - $seen{$record} = 1; - } - - return \@retlist; -} -__PACKAGE__->register_method( - method => 'authority_tag_sf_browse', - api_name => 'open-ils.supercat.authority.tag.browse', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns a list of the requested authority record IDs held - DESC - params => - [ - { name => 'tag', - desc => 'The target Authority MARC tag', - type => 'string' }, - { name => 'subfield', - desc => 'The target Authority MARC subfield', - type => 'string' }, - { name => 'value', - desc => 'The target string', - type => 'string' }, - { name => 'page_size', - desc => 'Count of call numbers to retrieve, default is 9', - type => 'number' }, - { name => 'page', - desc => 'The page of call numbers to retrieve, calculated based on page_size. Can be positive, negative or 0.', - type => 'number' }, - ], - 'return' => - { desc => 'Authority Record IDs that are near the target string', - type => 'array' } - } -); - -sub general_startwith { - my $self = shift; - my $client = shift; - return tag_sf_startwith($self, $client, $self->{tag}, $self->{subfield}, @_); -} -__PACKAGE__->register_method( - method => 'general_startwith', - api_name => 'open-ils.supercat.title.startwith', - tag => 'tnf', subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested org-scoped record IDs held", - params => - [ { name => 'value', desc => 'The target title', type => 'string' }, - { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, - { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' }, - { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ], - 'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_startwith', - api_name => 'open-ils.supercat.author.startwith', - tag => [qw/100 110 111/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested org-scoped record IDs held", - params => - [ { name => 'value', desc => 'The target author', type => 'string' }, - { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, - { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' }, - { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ], - 'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_startwith', - api_name => 'open-ils.supercat.subject.startwith', - tag => [qw/600 610 611 630 648 650 651 653 655 656 662 690 691 696 697 698 699/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested org-scoped record IDs held", - params => - [ { name => 'value', desc => 'The target subject', type => 'string' }, - { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, - { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' }, - { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ], - 'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_startwith', - api_name => 'open-ils.supercat.topic.startwith', - tag => [qw/650 690/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested org-scoped record IDs held", - params => - [ { name => 'value', desc => 'The target topical subject', type => 'string' }, - { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, - { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' }, - { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ], - 'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_startwith', - api_name => 'open-ils.supercat.series.startwith', - tag => [qw/440 490 800 810 811 830/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested org-scoped record IDs held", - params => - [ { name => 'value', desc => 'The target series', type => 'string' }, - { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, - { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' }, - { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ], - 'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' } - } -); - - -sub tag_sf_startwith { - my $self = shift; - my $client = shift; - - my $tag = shift; - my $subfield = shift; - my $value = shift; - my $ou = shift; - my $limit = shift || 10; - my $page = shift || 0; - my $statuses = shift || []; - my $copy_locations = shift || []; - - my $offset = $limit * abs($page); - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - - my @ou_ids; - if ($ou && $ou ne '-') { - my $orgs = $_storage->request( - "open-ils.cstore.direct.actor.org_unit.search", - { shortname => $ou }, - { flesh => 100, - flesh_fields => { aou => [qw/children/] } - } - )->gather(1); - @ou_ids = tree_walker($orgs, 'children', sub {shift->id}) if $orgs; - } - - $logger->debug("Searching for records at orgs [".join(',',@ou_ids)."], based on $ou"); - - my @list = (); - - if ($page < 0) { - my $before = $_storage->request( - "open-ils.cstore.json_query.atomic", - { select => { mfr => [qw/record value/] }, - from => 'mfr', - where => - { '+mfr' => - { tag => $tag, - subfield => $subfield, - value => { '<' => lc($value) } - }, - '-or' => [ - { '-exists' => - { select=> { acp => [ 'id' ] }, - from => { acn => { acp => { field => 'call_number', fkey => 'id' } } }, - where => - { '+acn' => { record => { '=' => { '+mfr' => 'record' } } }, - '+acp' => - { deleted => 'f', - ((@ou_ids) ? ( circ_lib => \@ou_ids) : ()), - ((@$statuses) ? ( status => $statuses) : ()), - ((@$copy_locations) ? ( location => $copy_locations) : ()) - } - }, - limit => 1 - } - }, - { '-exists' => - { select=> { auri => [ 'id' ] }, - from => { acn => { auricnm => { field => 'call_number', fkey => 'id', join => { auri => { field => 'id', fkey => 'uri' } } } } }, - where => - { '+acn' => { record => { '=' => { '+mfr' => 'record' } }, (@ou_ids) ? ( owning_lib => \@ou_ids) : () }, - '+auri' => { active => 't' } - }, - limit => 1 - } - } - ] - }, - order_by => { mfr => { value => 'desc' } }, - limit => $limit, - offset => $offset - } - )->gather(1); - push @list, map { $_->{record} } reverse(@$before); - } - - if ($page >= 0) { - my $after = $_storage->request( - "open-ils.cstore.json_query.atomic", - { select => { mfr => [qw/record value/] }, - from => 'mfr', - where => - { '+mfr' => - { tag => $tag, - subfield => $subfield, - value => { '>=' => lc($value) } - }, - '-or' => [ - { '-exists' => - { select=> { acp => [ 'id' ] }, - from => { acn => { acp => { field => 'call_number', fkey => 'id' } } }, - where => - { '+acn' => { record => { '=' => { '+mfr' => 'record' } } }, - '+acp' => - { deleted => 'f', - ((@ou_ids) ? ( circ_lib => \@ou_ids) : ()), - ((@$statuses) ? ( status => $statuses) : ()), - ((@$copy_locations) ? ( location => $copy_locations) : ()) - } - }, - limit => 1 - } - }, - { '-exists' => - { select=> { auri => [ 'id' ] }, - from => { acn => { auricnm => { field => 'call_number', fkey => 'id', join => { auri => { field => 'id', fkey => 'uri' } } } } }, - where => - { '+acn' => { record => { '=' => { '+mfr' => 'record' } }, (@ou_ids) ? ( owning_lib => \@ou_ids) : () }, - '+auri' => { active => 't' } - }, - limit => 1 - }, - } - ] - }, - order_by => { mfr => { value => 'asc' } }, - limit => $limit, - offset => $offset - } - )->gather(1); - push @list, map { $_->{record} } @$after; - } - - return \@list; -} -__PACKAGE__->register_method( - method => 'tag_sf_startwith', - api_name => 'open-ils.supercat.tag.startwith', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns a list of the requested org-scoped record IDs held - DESC - params => - [ - { name => 'tag', - desc => 'The target MARC tag', - type => 'string' }, - { name => 'subfield', - desc => 'The target MARC subfield', - type => 'string' }, - { name => 'value', - desc => 'The target string', - type => 'string' }, - { name => 'org_unit', - desc => 'The org unit shortname (or "-" or undef for global) to browse', - type => 'string' }, - { name => 'page_size', - desc => 'Count of call numbers to retrieve, default is 9', - type => 'number' }, - { name => 'page', - desc => 'The page of call numbers to retrieve, calculated based on page_size. Can be positive, negative or 0.', - type => 'number' }, - { name => 'statuses', - desc => 'Array of statuses to filter copies by, optional and can be undef.', - type => 'array' }, - { name => 'locations', - desc => 'Array of copy locations to filter copies by, optional and can be undef.', - type => 'array' }, - ], - 'return' => - { desc => 'Record IDs that have copies at the relevant org units', - type => 'array' } - } -); - -sub general_authority_startwith { - my $self = shift; - my $client = shift; - return authority_tag_sf_startwith($self, $client, $self->{tag}, $self->{subfield}, @_); -} -__PACKAGE__->register_method( - method => 'general_authority_startwith', - api_name => 'open-ils.supercat.authority.title.startwith', - tag => ['130'], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held", - params => - [ { name => 'value', desc => 'The target title', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_authority_startwith', - api_name => 'open-ils.supercat.authority.author.startwith', - tag => [qw/100 110 111/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held", - params => - [ { name => 'value', desc => 'The target author', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_authority_startwith', - api_name => 'open-ils.supercat.authority.subject.startwith', - tag => [qw/148 150 151 155/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held", - params => - [ { name => 'value', desc => 'The target subject', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_authority_startwith', - api_name => 'open-ils.supercat.authority.topic.startwith', - tag => ['150'], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held", - params => - [ { name => 'value', desc => 'The target topical subject', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_authority_startwith', - api_name => 'open-ils.supercat.authority.title.refs.startwith', - tag => ['130'], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references", - params => - [ { name => 'value', desc => 'The target title', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_authority_startwith', - api_name => 'open-ils.supercat.authority.author.refs.startwith', - tag => [qw/100 110 111/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references", - params => - [ { name => 'value', desc => 'The target author', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_authority_startwith', - api_name => 'open-ils.supercat.authority.subject.refs.startwith', - tag => [qw/148 150 151 155/], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references", - params => - [ { name => 'value', desc => 'The target subject', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'general_authority_startwith', - api_name => 'open-ils.supercat.authority.topic.refs.startwith', - tag => ['150'], subfield => 'a', - api_level => 1, - argc => 1, - signature => - { desc => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references", - params => - [ { name => 'value', desc => 'The target topical subject', type => 'string' }, - { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' }, - { name => 'page', desc => 'The page of records retrieved, calculated based on page_size. Can be positive, negative or 0.', type => 'number' }, ], - 'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' } - } -); - -sub authority_tag_sf_startwith { - my $self = shift; - my $client = shift; - - my $tag = shift; - my $subfield = shift; - - my $value = shift; - my $limit = shift || 10; - my $page = shift || 0; - - # Match authority.full_rec normalization - $value = naco_normalize($value, $subfield); - - my $ref_limit = $limit; - my $offset = $limit * abs($page); - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - - my @ref_tags = (); - # .refs variant includes 4xx and 5xx variants for see / see also - foreach my $tagname (@$tag) { - push(@ref_tags, $tagname); - if ($self->api_name =~ /\.refs\./) { - push(@ref_tags, '4' . substr($tagname, 1, 2)); - push(@ref_tags, '5' . substr($tagname, 1, 2)); - } - } - - my @list = (); - - if ($page < 0) { - # Don't skip the first actual page of results in descending order - $offset = $offset - $limit; - - my $before = $_storage->request( - "open-ils.cstore.json_query.atomic", - { select => { afr => [qw/record value/] }, - from => { 'afr', 'are' }, - where => { - '+afr' => { tag => \@ref_tags, subfield => $subfield, value => { '<' => $value } }, - '+are' => { deleted => 'f' } - }, - order_by => { afr => { value => 'desc' } }, - limit => $ref_limit, - offset => $offset, - } - )->gather(1); - push @list, map { $_->{record} } reverse(@$before); - } - - if ($page >= 0) { - my $after = $_storage->request( - "open-ils.cstore.json_query.atomic", - { select => { afr => [qw/record value/] }, - from => { 'afr', 'are' }, - where => { - '+afr' => { tag => \@ref_tags, subfield => $subfield, value => { '>=' => $value } }, - '+are' => { deleted => 'f' } - }, - order_by => { afr => { value => 'asc' } }, - limit => $ref_limit, - offset => $offset, - } - )->gather(1); - push @list, map { $_->{record} } @$after; - } - - # If we're not pulling in see/see also references, just return the raw list - if ($self->api_name !~ /\.refs\./) { - return \@list; - } - - # Remove dupe record IDs that turn up due to 4xx and 5xx matches - my @retlist = (); - my %seen; - foreach my $record (@list) { - next if exists $seen{$record}; - push @retlist, int($record); - $seen{$record} = 1; - } - - return \@retlist; -} -__PACKAGE__->register_method( - method => 'authority_tag_sf_startwith', - api_name => 'open-ils.supercat.authority.tag.startwith', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns a list of the requested authority record IDs held - DESC - params => - [ - { name => 'tag', - desc => 'The target Authority MARC tag', - type => 'string' }, - { name => 'subfield', - desc => 'The target Authority MARC subfield', - type => 'string' }, - { name => 'value', - desc => 'The target string', - type => 'string' }, - { name => 'page_size', - desc => 'Count of call numbers to retrieve, default is 9', - type => 'number' }, - { name => 'page', - desc => 'The page of call numbers to retrieve, calculated based on page_size. Can be positive, negative or 0.', - type => 'number' }, - ], - 'return' => - { desc => 'Authority Record IDs that are near the target string', - type => 'array' } - } -); - - -sub holding_data_formats { - return [{ - marcxml => { - namespace_uri => 'http://www.loc.gov/MARC21/slim', - docs => 'http://www.loc.gov/marcxml/', - schema_location => 'http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd', - } - }]; -} -__PACKAGE__->register_method( method => 'holding_data_formats', api_name => 'open-ils.supercat.acn.formats', api_level => 1 ); -__PACKAGE__->register_method( method => 'holding_data_formats', api_name => 'open-ils.supercat.acp.formats', api_level => 1 ); -__PACKAGE__->register_method( method => 'holding_data_formats', api_name => 'open-ils.supercat.auri.formats', api_level => 1 ); - - -__PACKAGE__->register_method( - method => 'retrieve_uri', - api_name => 'open-ils.supercat.auri.marcxml.retrieve', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns a fleshed call number object - DESC - params => - [ - { name => 'uri_id', - desc => 'An OpenILS asset::uri id', - type => 'number' }, - ], - 'return' => - { desc => 'fleshed uri', - type => 'object' } - } -); -sub retrieve_uri { - my $self = shift; - my $client = shift; - my $cpid = shift; - my $args = shift || {}; - - return OpenILS::Application::SuperCat::unAPI - ->new(OpenSRF::AppSession - ->create( 'open-ils.cstore' ) - ->request( - "open-ils.cstore.direct.asset.uri.retrieve", - $cpid, - { flesh => 10, - flesh_fields => { - auri => [qw/call_number_maps/], - auricnm => [qw/call_number/], - acn => [qw/owning_lib record/], - } - }) - ->gather(1)) - ->as_xml($args); -} - -__PACKAGE__->register_method( - method => 'retrieve_copy', - api_name => 'open-ils.supercat.acp.marcxml.retrieve', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns a fleshed call number object - DESC - params => - [ - { name => 'cn_id', - desc => 'An OpenILS asset::copy id', - type => 'number' }, - ], - 'return' => - { desc => 'fleshed copy', - type => 'object' } - } -); -sub retrieve_copy { - my $self = shift; - my $client = shift; - my $cpid = shift; - my $args = shift || {}; - - return OpenILS::Application::SuperCat::unAPI - ->new(OpenSRF::AppSession - ->create( 'open-ils.cstore' ) - ->request( - "open-ils.cstore.direct.asset.copy.retrieve", - $cpid, - { flesh => 2, - flesh_fields => { - acn => [qw/owning_lib record/], - acp => [qw/call_number location status circ_lib stat_cat_entries notes/], - } - }) - ->gather(1)) - ->as_xml($args); -} - -__PACKAGE__->register_method( - method => 'retrieve_callnumber', - api_name => 'open-ils.supercat.acn.marcxml.retrieve', - api_level => 1, - argc => 1, - stream => 1, - signature => - { desc => <<" DESC", -Returns a fleshed call number object - DESC - params => - [ - { name => 'cn_id', - desc => 'An OpenILS asset::call_number id', - type => 'number' }, - ], - 'return' => - { desc => 'call number with copies', - type => 'object' } - } -); -sub retrieve_callnumber { - my $self = shift; - my $client = shift; - my $cnid = shift; - my $args = shift || {}; - - return OpenILS::Application::SuperCat::unAPI - ->new(OpenSRF::AppSession - ->create( 'open-ils.cstore' ) - ->request( - "open-ils.cstore.direct.asset.call_number.retrieve", - $cnid, - { flesh => 5, - flesh_fields => { - acn => [qw/owning_lib record copies uri_maps/], - auricnm => [qw/uri/], - acp => [qw/location status circ_lib stat_cat_entries notes/], - } - }) - ->gather(1)) - ->as_xml($args); - -} - -__PACKAGE__->register_method( - method => 'basic_record_holdings', - api_name => 'open-ils.supercat.record.basic_holdings.retrieve', - api_level => 1, - argc => 1, - stream => 1, - signature => - { desc => <<" DESC", -Returns a basic hash representation of the requested bibliographic record's holdings - DESC - params => - [ - { name => 'bibId', - desc => 'An OpenILS biblio::record_entry id', - type => 'number' }, - ], - 'return' => - { desc => 'Hash of bib record holdings hierarchy (call numbers and copies)', - type => 'string' } - } -); -sub basic_record_holdings { - my $self = shift; - my $client = shift; - my $bib = shift; - my $ou = shift; - - # holdings hold an array of call numbers, which hold an array of copies - # holdings => [ label: { library, [ copies: { barcode, location, status, circ_lib } ] } ] - my %holdings; - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - - my $tree = $_storage->request( - "open-ils.cstore.direct.biblio.record_entry.retrieve", - $bib, - { flesh => 5, - flesh_fields => { - bre => [qw/call_numbers/], - acn => [qw/copies owning_lib/], - acp => [qw/location status circ_lib/], - } - } - )->gather(1); - - my $o_search = { shortname => uc($ou) }; - if (!$ou || $ou eq '-') { - $o_search = { parent_ou => undef }; - } - - my $orgs = $_storage->request( - "open-ils.cstore.direct.actor.org_unit.search", - $o_search, - { flesh => 100, - flesh_fields => { aou => [qw/children/] } - } - )->gather(1); - - my @ou_ids = tree_walker($orgs, 'children', sub {shift->id}) if $orgs; - - $logger->debug("Searching for holdings at orgs [".join(',',@ou_ids)."], based on $ou"); - - for my $cn (@{$tree->call_numbers}) { - next unless ( $cn->deleted eq 'f' || $cn->deleted == 0 ); - - my $found = 0; - for my $c (@{$cn->copies}) { - next unless grep {$c->circ_lib->id == $_} @ou_ids; - next unless ( $c->deleted eq 'f' || $c->deleted == 0 ); - $found = 1; - last; - } - next unless $found; - - $holdings{$cn->label}{'owning_lib'} = $cn->owning_lib->shortname; - - for my $cp (@{$cn->copies}) { - - next unless grep { $cp->circ_lib->id == $_ } @ou_ids; - next unless ( $cp->deleted eq 'f' || $cp->deleted == 0 ); - - push @{$holdings{$cn->label}{'copies'}}, { - barcode => $cp->barcode, - status => $cp->status->name, - location => $cp->location->name, - circlib => $cp->circ_lib->shortname - }; - - } - } - - return \%holdings; -} - -#__PACKAGE__->register_method( -# method => 'new_record_holdings', -# api_name => 'open-ils.supercat.record.holdings_xml.retrieve', -# api_level => 1, -# argc => 1, -# stream => 1, -# signature => -# { desc => <<" DESC", -#Returns the XML representation of the requested bibliographic record's holdings -# DESC -# params => -# [ -# { name => 'bibId', -# desc => 'An OpenILS biblio::record_entry id', -# type => 'number' }, -# ], -# 'return' => -# { desc => 'Stream of bib record holdings hierarchy in XML', -# type => 'string' } -# } -#); -# - -sub new_record_holdings { - my $self = shift; - my $client = shift; - my $bib = shift; - my $ou = shift; - my $depth = shift; - my $flesh = shift; - my $paging = shift; - - $paging = [-1,0] if (!$paging or !ref($paging) or @$paging == 0); - my $limit = $$paging[0]; - my $offset = $$paging[1] || 0; - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - my $_search = OpenSRF::AppSession->create( 'open-ils.search' ); - - my $o_search = { shortname => uc($ou) }; - if (!$ou || $ou eq '-') { - $o_search = { parent_ou => undef }; - } - - my $one_org = $_storage->request( - "open-ils.cstore.direct.actor.org_unit.search", - $o_search - )->gather(1); - - my $count_req = $_search->request('open-ils.search.biblio.record.copy_count' => $one_org->id => $bib); - my $staff_count_req = $_search->request('open-ils.search.biblio.record.copy_count.staff' => $one_org->id => $bib); - - my $orgs = $_storage->request( - 'open-ils.cstore.json_query.atomic', - { from => [ 'actor.org_unit_descendants', defined($depth) ? ( $one_org->id, $depth ) : ( $one_org->id ) ] } - )->gather(1); - - - my @ou_ids = map { $_->{id} } @$orgs; - - $logger->info("Searching for holdings at orgs [".join(',',@ou_ids)."], based on $ou"); - - my %subselect = ( '-or' => [ - { owning_lib => \@ou_ids }, - { '-exists' => - { from => 'acp', - where => { - call_number => { '=' => {'+acn'=>'id'} }, - deleted => 'f', - circ_lib => \@ou_ids - } - } - } - ]); - - if ($flesh and $flesh eq 'uris') { - %subselect = ( - owning_lib => \@ou_ids, - '-exists' => { - from => { auricnm => 'auri' }, - where => { - call_number => { '=' => {'+acn'=>'id'} }, - '+auri' => { active => 't' } - } - } - ); - } - - - my $cns = $_storage->request( - "open-ils.cstore.direct.asset.call_number.search.atomic", - { record => $bib, - deleted => 'f', - %subselect - }, - { flesh => 5, - flesh_fields => { - acn => [qw/copies owning_lib uri_maps/], - auricnm => [qw/uri/], - acp => [qw/circ_lib location status stat_cat_entries notes/], - asce => [qw/stat_cat/], - }, - ( $limit > -1 ? ( limit => $limit ) : () ), - ( $offset ? ( offset => $offset ) : () ), - order_by => { acn => { label_sortkey => {} } } - } - )->gather(1); - - my ($year,$month,$day) = reverse( (localtime)[3,4,5] ); - $year += 1900; - $month += 1; - - $client->respond("\n"); - - my $copy_counts = $count_req->gather(1); - my $staff_copy_counts = $staff_count_req->gather(1); - - for my $c (@$copy_counts) { - $$c{transcendant} ||= 0; - my $out = "respond("$out/>\n") - } - - for my $c (@$staff_copy_counts) { - $$c{transcendant} ||= 0; - my $out = "respond("$out/>\n") - } - - $client->respond("\n"); - - for my $cn (@$cns) { - next unless (@{$cn->copies} > 0 or (ref($cn->uri_maps) and @{$cn->uri_maps})); - - # We don't want O:A:S:unAPI::acn to return the record, we've got that already - # In the context of BibTemplate, copies aren't necessary because we pull those - # in a separate call - $client->respond( - OpenILS::Application::SuperCat::unAPI::acn - ->new( $cn ) - ->as_xml( {no_record => 1, no_copies => ($flesh ? 0 : 1)} ) - ); - } - - $client->respond("\n"); - - $logger->info("Searching for serial holdings at orgs [".join(',',@ou_ids)."], based on $ou"); - - %subselect = ( '-or' => [ - { owning_lib => \@ou_ids }, - { '-exists' => - { from => 'sdist', - where => { holding_lib => \@ou_ids } - } - } - ]); - - my $ssubs = $_storage->request( - "open-ils.cstore.direct.serial.subscription.search.atomic", - { record_entry => $bib, - %subselect - }, - { flesh => 7, - flesh_fields => { - ssub => [qw/distributions issuances scaps owning_lib/], - sdist => [qw/basic_summary supplement_summary index_summary streams holding_lib/], - sstr => [qw/items/], - sitem => [qw/notes unit/], - sunit => [qw/notes location status circ_lib stat_cat_entries call_number/], - acn => [qw/owning_lib/], - }, - ( $limit > -1 ? ( limit => $limit ) : () ), - ( $offset ? ( offset => $offset ) : () ), - order_by => { - ssub => { - start_date => {}, - owning_lib => {}, - id => {} - }, - sdist => { - label => {}, - owning_lib => {}, - }, - sunit => { - date_expected => {}, - } - } - } - )->gather(1); - - - for my $ssub (@$ssubs) { - next unless (@{$ssub->distributions} or @{$ssub->issuances} or @{$ssub->scaps}); - - # We don't want O:A:S:unAPI::ssub to return the record, we've got that already - # In the context of BibTemplate, copies aren't necessary because we pull those - # in a separate call - $client->respond( - OpenILS::Application::SuperCat::unAPI::ssub - ->new( $ssub ) - ->as_xml( {no_record => 1, no_items => ($flesh ? 0 : 1)} ) - ); - } - - - return "\n"; -} -__PACKAGE__->register_method( - method => 'new_record_holdings', - api_name => 'open-ils.supercat.record.holdings_xml.retrieve', - api_level => 1, - argc => 1, - stream => 1, - signature => - { desc => <<" DESC", -Returns the XML representation of the requested bibliographic record's holdings - DESC - params => - [ - { name => 'bibId', - desc => 'An OpenILS biblio::record_entry ID', - type => 'number' }, - { name => 'orgUnit', - desc => 'An OpenILS actor::org_unit short name that limits the scope of returned holdings', - type => 'text' }, - { name => 'depth', - desc => 'An OpenILS actor::org_unit_type depththat limits the scope of returned holdings', - type => 'number' }, - { name => 'hideCopies', - desc => 'Flag that prevents the inclusion of copies in the returned holdings', - type => 'boolean' }, - { name => 'paging', - desc => 'Arry of limit and offset for holdings paging', - type => 'array' }, - ], - 'return' => - { desc => 'Stream of bib record holdings hierarchy in XML', - type => 'string' } - } -); - -sub isbn_holdings { - my $self = shift; - my $client = shift; - my $isbn = shift; - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - - my $recs = $_storage->request( - 'open-ils.cstore.direct.metabib.full_rec.search.atomic', - { tag => { like => '02%'}, value => {like => "$isbn\%"}} - )->gather(1); - - return undef unless (@$recs); - - return ($self->method_lookup( 'open-ils.supercat.record.holdings_xml.retrieve')->run( $recs->[0]->record ))[0]; -} -__PACKAGE__->register_method( - method => 'isbn_holdings', - api_name => 'open-ils.supercat.isbn.holdings_xml.retrieve', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns the XML representation of the requested bibliographic record's holdings - DESC - params => - [ - { name => 'isbn', - desc => 'An isbn', - type => 'string' }, - ], - 'return' => - { desc => 'The bib record holdings hierarchy in XML', - type => 'string' } - } -); - -sub escape { - my $self = shift; - my $text = shift; - return '' unless $text; - $text =~ s/&/&/gsom; - $text =~ s//>/gsom; - $text =~ s/"/"/gsom; - $text =~ s/'/'/gsom; - return $text; -} - -sub recent_changes { - my $self = shift; - my $client = shift; - my $when = shift || '1-01-01'; - my $limit = shift; - - my $type = 'biblio'; - my $hint = 'bre'; - - if ($self->api_name =~ /authority/o) { - $type = 'authority'; - $hint = 'are'; - } - - my $axis = 'create_date'; - $axis = 'edit_date' if ($self->api_name =~ /edit/o); - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - - return $_storage->request( - "open-ils.cstore.direct.$type.record_entry.id_list.atomic", - { $axis => { ">" => $when }, id => { '>' => 0 }, deleted => 'f', active => 't' }, - { order_by => { $hint => "$axis desc" }, limit => $limit } - )->gather(1); -} - -for my $t ( qw/biblio authority/ ) { - for my $a ( qw/import edit/ ) { - - __PACKAGE__->register_method( - method => 'recent_changes', - api_name => "open-ils.supercat.$t.record.$a.recent", - api_level => 1, - argc => 0, - signature => - { desc => "Returns a list of recently ${a}ed $t records", - params => - [ - { name => 'when', - desc => "Date to start looking for ${a}ed records", - default => '1-01-01', - type => 'string' }, - - { name => 'limit', - desc => "Maximum count to retrieve", - type => 'number' }, - ], - 'return' => - { desc => "An id list of $t records", - type => 'array' } - }, - ); - } -} - - -sub retrieve_authority_marcxml { - my $self = shift; - my $client = shift; - my $rid = shift; - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - - my $record = $_storage->request( 'open-ils.cstore.direct.authority.record_entry.retrieve' => $rid )->gather(1); - return $U->entityize( $record->marc ) if ($record); - return undef; -} - -__PACKAGE__->register_method( - method => 'retrieve_authority_marcxml', - api_name => 'open-ils.supercat.authority.marcxml.retrieve', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns the MARCXML representation of the requested authority record - DESC - params => - [ - { name => 'authorityId', - desc => 'An OpenILS authority::record_entry id', - type => 'number' }, - ], - 'return' => - { desc => 'The authority record in MARCXML', - type => 'string' } - } -); - -sub retrieve_record_marcxml { - my $self = shift; - my $client = shift; - my $rid = shift; - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - - my $record = $_storage->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve' => $rid )->gather(1); - return $U->entityize( $record->marc ) if ($record); - return undef; -} - -__PACKAGE__->register_method( - method => 'retrieve_record_marcxml', - api_name => 'open-ils.supercat.record.marcxml.retrieve', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns the MARCXML representation of the requested bibliographic record - DESC - params => - [ - { name => 'bibId', - desc => 'An OpenILS biblio::record_entry id', - type => 'number' }, - ], - 'return' => - { desc => 'The bib record in MARCXML', - type => 'string' } - } -); - -sub retrieve_isbn_marcxml { - my $self = shift; - my $client = shift; - my $isbn = shift; - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - - my $recs = $_storage->request( - 'open-ils.cstore.direct.metabib.full_rec.search.atomic', - { tag => { like => '02%'}, value => {like => "$isbn\%"}} - )->gather(1); - - return undef unless (@$recs); - - my $record = $_storage->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve' => $recs->[0]->record )->gather(1); - return $U->entityize( $record->marc ) if ($record); - return undef; -} - -__PACKAGE__->register_method( - method => 'retrieve_isbn_marcxml', - api_name => 'open-ils.supercat.isbn.marcxml.retrieve', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns the MARCXML representation of the requested ISBN - DESC - params => - [ - { name => 'ISBN', - desc => 'An ... um ... ISBN', - type => 'string' }, - ], - 'return' => - { desc => 'The bib record in MARCXML', - type => 'string' } - } -); - -sub retrieve_record_transform { - my $self = shift; - my $client = shift; - my $rid = shift; - - (my $transform = $self->api_name) =~ s/^.+record\.([^\.]+)\.retrieve$/$1/o; - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - #$_storage->connect; - - my $record = $_storage->request( - 'open-ils.cstore.direct.biblio.record_entry.retrieve', - $rid - )->gather(1); - - return undef unless ($record); - - return $U->entityize($record_xslt{$transform}{xslt}->transform( $_parser->parse_string( $record->marc ) )->toString); -} - -sub retrieve_isbn_transform { - my $self = shift; - my $client = shift; - my $isbn = shift; - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - - my $recs = $_storage->request( - 'open-ils.cstore.direct.metabib.full_rec.search.atomic', - { tag => { like => '02%'}, value => {like => "$isbn\%"}} - )->gather(1); - - return undef unless (@$recs); - - (my $transform = $self->api_name) =~ s/^.+isbn\.([^\.]+)\.retrieve$/$1/o; - - my $record = $_storage->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve' => $recs->[0]->record )->gather(1); - - return undef unless ($record); - - return $U->entityize($record_xslt{$transform}{xslt}->transform( $_parser->parse_string( $record->marc ) )->toString); -} - -sub retrieve_record_objects { - my $self = shift; - my $client = shift; - my $ids = shift; - - $ids = [$ids] unless (ref $ids); - $ids = [grep {$_} @$ids]; - - return [] unless (@$ids); - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - return $_storage->request('open-ils.cstore.direct.biblio.record_entry.search.atomic' => { id => [grep {$_} @$ids] })->gather(1); -} -__PACKAGE__->register_method( - method => 'retrieve_record_objects', - api_name => 'open-ils.supercat.record.object.retrieve', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns the Fieldmapper object representation of the requested bibliographic records - DESC - params => - [ - { name => 'bibIds', - desc => 'OpenILS biblio::record_entry ids', - type => 'array' }, - ], - 'return' => - { desc => 'The bib records', - type => 'array' } - } -); - - -sub retrieve_isbn_object { - my $self = shift; - my $client = shift; - my $isbn = shift; - - return undef unless ($isbn); - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - my $recs = $_storage->request( - 'open-ils.cstore.direct.metabib.full_rec.search.atomic', - { tag => { like => '02%'}, value => {like => "$isbn\%"}} - )->gather(1); - - return undef unless (@$recs); - - return $_storage->request( - 'open-ils.cstore.direct.biblio.record_entry.search.atomic', - { id => $recs->[0]->record } - )->gather(1); -} -__PACKAGE__->register_method( - method => 'retrieve_isbn_object', - api_name => 'open-ils.supercat.isbn.object.retrieve', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns the Fieldmapper object representation of the requested bibliographic record - DESC - params => - [ - { name => 'isbn', - desc => 'an ISBN', - type => 'string' }, - ], - 'return' => - { desc => 'The bib record', - type => 'object' } - } -); - - - -sub retrieve_metarecord_mods { - my $self = shift; - my $client = shift; - my $rid = shift; - - my $_storage = OpenSRF::AppSession->connect( 'open-ils.cstore' ); - - # Get the metarecord in question - my $mr = - $_storage->request( - 'open-ils.cstore.direct.metabib.metarecord.retrieve' => $rid - )->gather(1); - - # Now get the map of all bib records for the metarecord - my $recs = - $_storage->request( - 'open-ils.cstore.direct.metabib.metarecord_source_map.search.atomic', - {metarecord => $rid} - )->gather(1); - - $logger->debug("Adding ".scalar(@$recs)." bib record to the MODS of the metarecord"); - - # and retrieve the lead (master) record as MODS - my ($master) = - $self ->method_lookup('open-ils.supercat.record.mods.retrieve') - ->run($mr->master_record); - my $master_mods = $_parser->parse_string($master)->documentElement; - $master_mods->setNamespace( "http://www.loc.gov/mods/", "mods" ); - $master_mods->setNamespace( "http://www.loc.gov/mods/", undef, 1 ); - - # ... and a MODS clone to populate, with guts removed. - my $mods = $_parser->parse_string($master)->documentElement; - $mods->setNamespace( "http://www.loc.gov/mods/", "mods" ); # modsCollection element - $mods->setNamespace('http://www.loc.gov/mods/', undef, 1); - ($mods) = $mods->findnodes('//mods:mods'); - #$mods->setNamespace( "http://www.loc.gov/mods/", "mods" ); # mods element - $mods->removeChildNodes; - $mods->setNamespace('http://www.loc.gov/mods/', undef, 1); - - # Add the metarecord ID as a (locally defined) info URI - my $recordInfo = $mods - ->ownerDocument - ->createElement("recordInfo"); - - my $recordIdentifier = $mods - ->ownerDocument - ->createElement("recordIdentifier"); - - my ($year,$month,$day) = reverse( (localtime)[3,4,5] ); - $year += 1900; - $month += 1; - - my $id = $mr->id; - $recordIdentifier->appendTextNode( - sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d:metabib-metarecord/$id", $month, $day) - ); - - $recordInfo->appendChild($recordIdentifier); - $mods->appendChild($recordInfo); - - # Grab the title, author and ISBN for the master record and populate the metarecord - my ($title) = $master_mods->findnodes( './mods:titleInfo[not(@type)]' ); - - if ($title) { - $title->setNamespace( "http://www.loc.gov/mods/", "mods" ); - $title->setNamespace( "http://www.loc.gov/mods/", undef, 1 ); - $title = $mods->ownerDocument->importNode($title); - $mods->appendChild($title); - } - - my ($author) = $master_mods->findnodes( './mods:name[mods:role/mods:text[text()="creator"]]' ); - if ($author) { - $author->setNamespace( "http://www.loc.gov/mods/", "mods" ); - $author->setNamespace( "http://www.loc.gov/mods/", undef, 1 ); - $author = $mods->ownerDocument->importNode($author); - $mods->appendChild($author); - } - - my ($isbn) = $master_mods->findnodes( './mods:identifier[@type="isbn"]' ); - if ($isbn) { - $isbn->setNamespace( "http://www.loc.gov/mods/", "mods" ); - $isbn->setNamespace( "http://www.loc.gov/mods/", undef, 1 ); - $isbn = $mods->ownerDocument->importNode($isbn); - $mods->appendChild($isbn); - } - - # ... and loop over the constituent records - for my $map ( @$recs ) { - - # get the MODS - my ($rec) = - $self ->method_lookup('open-ils.supercat.record.mods.retrieve') - ->run($map->source); - - my $part_mods = $_parser->parse_string($rec); - $part_mods->documentElement->setNamespace( "http://www.loc.gov/mods/", "mods" ); - $part_mods->documentElement->setNamespace( "http://www.loc.gov/mods/", undef, 1 ); - ($part_mods) = $part_mods->findnodes('//mods:mods'); - - for my $node ( ($part_mods->findnodes( './mods:subject' )) ) { - $node->setNamespace( "http://www.loc.gov/mods/", "mods" ); - $node->setNamespace( "http://www.loc.gov/mods/", undef, 1 ); - $node = $mods->ownerDocument->importNode($node); - $mods->appendChild( $node ); - } - - my $relatedItem = $mods - ->ownerDocument - ->createElement("relatedItem"); - - $relatedItem->setAttribute( type => 'constituent' ); - - my $identifier = $mods - ->ownerDocument - ->createElement("identifier"); - - $identifier->setAttribute( type => 'uri' ); - - my $subRecordInfo = $mods - ->ownerDocument - ->createElement("recordInfo"); - - my $subRecordIdentifier = $mods - ->ownerDocument - ->createElement("recordIdentifier"); - - my $subid = $map->source; - $subRecordIdentifier->appendTextNode( - sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d:biblio-record_entry/$subid", - $month, - $day - ) - ); - $subRecordInfo->appendChild($subRecordIdentifier); - - $relatedItem->appendChild( $subRecordInfo ); - - my ($tor) = $part_mods->findnodes( './mods:typeOfResource' ); - $tor->setNamespace( "http://www.loc.gov/mods/", "mods" ); - $tor->setNamespace( "http://www.loc.gov/mods/", undef, 1 ) if ($tor); - $tor = $mods->ownerDocument->importNode($tor) if ($tor); - $relatedItem->appendChild($tor) if ($tor); - - if ( my ($part_isbn) = $part_mods->findnodes( './mods:identifier[@type="isbn"]' ) ) { - $part_isbn->setNamespace( "http://www.loc.gov/mods/", "mods" ); - $part_isbn->setNamespace( "http://www.loc.gov/mods/", undef, 1 ); - $part_isbn = $mods->ownerDocument->importNode($part_isbn); - $relatedItem->appendChild( $part_isbn ); - - if (!$isbn) { - $isbn = $mods->appendChild( $part_isbn->cloneNode(1) ); - } - } - - $mods->appendChild( $relatedItem ); - - } - - $_storage->disconnect; - - return $U->entityize($mods->toString); - -} -__PACKAGE__->register_method( - method => 'retrieve_metarecord_mods', - api_name => 'open-ils.supercat.metarecord.mods.retrieve', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns the MODS representation of the requested metarecord - DESC - params => - [ - { name => 'metarecordId', - desc => 'An OpenILS metabib::metarecord id', - type => 'number' }, - ], - 'return' => - { desc => 'The metarecord in MODS', - type => 'string' } - } -); - -sub list_metarecord_formats { - my @list = ( - { mods => - { namespace_uri => 'http://www.loc.gov/mods/', - docs => 'http://www.loc.gov/mods/', - schema_location => 'http://www.loc.gov/standards/mods/mods.xsd', - } - } - ); - - for my $type ( keys %metarecord_xslt ) { - push @list, - { $type => - { namespace_uri => $metarecord_xslt{$type}{namespace_uri}, - docs => $metarecord_xslt{$type}{docs}, - schema_location => $metarecord_xslt{$type}{schema_location}, - } - }; - } - - return \@list; -} -__PACKAGE__->register_method( - method => 'list_metarecord_formats', - api_name => 'open-ils.supercat.metarecord.formats', - api_level => 1, - argc => 0, - signature => - { desc => <<" DESC", -Returns the list of valid metarecord formats that supercat understands. - DESC - 'return' => - { desc => 'The format list', - type => 'array' } - } -); - - -sub list_authority_formats { - my @list = ( - { marcxml => - { namespace_uri => 'http://www.loc.gov/MARC21/slim', - docs => 'http://www.loc.gov/marcxml/', - schema_location => 'http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd', - } - } - ); - -# for my $type ( keys %record_xslt ) { -# push @list, -# { $type => -# { namespace_uri => $record_xslt{$type}{namespace_uri}, -# docs => $record_xslt{$type}{docs}, -# schema_location => $record_xslt{$type}{schema_location}, -# } -# }; -# } -# - return \@list; -} -__PACKAGE__->register_method( - method => 'list_authority_formats', - api_name => 'open-ils.supercat.authority.formats', - api_level => 1, - argc => 0, - signature => - { desc => <<" DESC", -Returns the list of valid authority formats that supercat understands. - DESC - 'return' => - { desc => 'The format list', - type => 'array' } - } -); - -sub list_record_formats { - my @list = ( - { marcxml => - { namespace_uri => 'http://www.loc.gov/MARC21/slim', - docs => 'http://www.loc.gov/marcxml/', - schema_location => 'http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd', - } - } - ); - - for my $type ( keys %record_xslt ) { - push @list, - { $type => - { namespace_uri => $record_xslt{$type}{namespace_uri}, - docs => $record_xslt{$type}{docs}, - schema_location => $record_xslt{$type}{schema_location}, - } - }; - } - - return \@list; -} -__PACKAGE__->register_method( - method => 'list_record_formats', - api_name => 'open-ils.supercat.record.formats', - api_level => 1, - argc => 0, - signature => - { desc => <<" DESC", -Returns the list of valid record formats that supercat understands. - DESC - 'return' => - { desc => 'The format list', - type => 'array' } - } -); -__PACKAGE__->register_method( - method => 'list_record_formats', - api_name => 'open-ils.supercat.isbn.formats', - api_level => 1, - argc => 0, - signature => - { desc => <<" DESC", -Returns the list of valid record formats that supercat understands. - DESC - 'return' => - { desc => 'The format list', - type => 'array' } - } -); - - -sub oISBN { - my $self = shift; - my $client = shift; - my $isbn = shift; - - $isbn =~ s/-//gso; - - throw OpenSRF::EX::InvalidArg ('I need an ISBN please') - unless (length($isbn) >= 10); - - my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' ); - - # Create a storage session, since we'll be making muliple requests. - $_storage->connect; - - # Find the record that has that ISBN. - my $bibrec = $_storage->request( - 'open-ils.cstore.direct.metabib.full_rec.search.atomic', - { tag => '020', subfield => 'a', value => { like => lc($isbn).'%'} } - )->gather(1); - - # Go away if we don't have one. - return {} unless (@$bibrec); - - # Find the metarecord for that bib record. - my $mr = $_storage->request( - 'open-ils.cstore.direct.metabib.metarecord_source_map.search.atomic', - {source => $bibrec->[0]->record} - )->gather(1); - - # Find the other records for that metarecord. - my $records = $_storage->request( - 'open-ils.cstore.direct.metabib.metarecord_source_map.search.atomic', - {metarecord => $mr->[0]->metarecord} - )->gather(1); - - # Just to be safe. There's currently no unique constraint on sources... - my %unique_recs = map { ($_->source, 1) } @$records; - my @rec_list = sort keys %unique_recs; - - # And now fetch the ISBNs for thos records. - my $recs = []; - push @$recs, - $_storage->request( - 'open-ils.cstore.direct.metabib.full_rec.search', - { tag => '020', subfield => 'a', record => $_ } - )->gather(1) for (@rec_list); - - # We're done with the storage server session. - $_storage->disconnect; - - # Return the oISBN data structure. This will be XMLized at a higher layer. - return - { metarecord => $mr->[0]->metarecord, - record_list => { map { $_ ? ($_->record, $_->value) : () } @$recs } }; - -} -__PACKAGE__->register_method( - method => 'oISBN', - api_name => 'open-ils.supercat.oisbn', - api_level => 1, - argc => 1, - signature => - { desc => <<" DESC", -Returns the ISBN list for the metarecord of the requested isbn - DESC - params => - [ - { name => 'isbn', - desc => 'An ISBN. Duh.', - type => 'string' }, - ], - 'return' => - { desc => 'record to isbn map', - type => 'object' } - } -); - -package OpenILS::Application::SuperCat::unAPI; -use base qw/OpenILS::Application::SuperCat/; - -sub as_xml { - die "dummy superclass, use a real class"; -} - -sub new { - my $class = shift; - my $obj = shift; - return unless ($obj); - - $class = ref($class) || $class; - - if ($class eq __PACKAGE__) { - return unless (ref($obj)); - $class .= '::' . $obj->json_hint; - } - - return bless { obj => $obj } => $class; -} - -sub obj { - my $self = shift; - return $self->{obj}; -} - -package OpenILS::Application::SuperCat::unAPI::auri; -use base qw/OpenILS::Application::SuperCat::unAPI/; - -sub as_xml { - my $self = shift; - my $args = shift; - - my $xml = ' obj->id . '" '; - $xml .= 'use_restriction="' . $self->escape( $self->obj->use_restriction ) . '" '; - $xml .= 'label="' . $self->escape( $self->obj->label ) . '" '; - $xml .= 'href="' . $self->escape( $self->obj->href ) . '">'; - - if (!$args->{no_volumes}) { - if (ref($self->obj->call_number_maps) && @{ $self->obj->call_number_maps }) { - $xml .= " \n" . join( - '', - map { - OpenILS::Application::SuperCat::unAPI - ->new( $_->call_number ) - ->as_xml({ %$args, no_uris=>1, no_copies=>1 }) - } @{ $self->obj->call_number_maps } - ) . " \n"; - - } else { - $xml .= " \n"; - } - } - - $xml .= " \n"; - - return $xml; -} - -package OpenILS::Application::SuperCat::unAPI::acn; -use base qw/OpenILS::Application::SuperCat::unAPI/; - -sub as_xml { - my $self = shift; - my $args = shift; - - my $xml = ' obj->id . '" '; - $xml .= 'lib="' . $self->escape( $self->obj->owning_lib->shortname ) . '" '; - $xml .= 'opac_visible="' . $self->obj->owning_lib->opac_visible . '" '; - $xml .= 'deleted="' . $self->obj->deleted . '" '; - $xml .= 'label="' . $self->escape( $self->obj->label ) . '">'; - $xml .= "\n"; - - if (!$args->{no_copies}) { - if (ref($self->obj->copies) && @{ $self->obj->copies }) { - $xml .= " \n" . join( - '', - map { - OpenILS::Application::SuperCat::unAPI - ->new( $_ ) - ->as_xml({ %$args, no_volume=>1 }) - } @{ $self->obj->copies } - ) . " \n"; - - } else { - $xml .= " \n"; - } - } - - if (!$args->{no_uris}) { - if (ref($self->obj->uri_maps) && @{ $self->obj->uri_maps }) { - $xml .= " \n" . join( - '', - map { - OpenILS::Application::SuperCat::unAPI - ->new( $_->uri ) - ->as_xml({ %$args, no_volumes=>1 }) - } @{ $self->obj->uri_maps } - ) . " \n"; - - } else { - $xml .= " \n"; - } - } - - - $xml .= ' obj->owning_lib->id . '" '; - $xml .= 'shortname="'.$self->escape( $self->obj->owning_lib->shortname ) .'" '; - $xml .= 'name="'.$self->escape( $self->obj->owning_lib->name ) .'"/>'; - $xml .= "\n"; - - unless ($args->{no_record}) { - my $rec_tag = "tag:open-ils.org:biblio-record_entry/".$self->obj->record->id.'/'.$self->escape( $self->obj->owning_lib->shortname ) ; - - my $r_doc = $parser->parse_string($self->obj->record->marc); - $r_doc->documentElement->setAttribute( id => $rec_tag ); - $xml .= $U->entityize($r_doc->documentElement->toString); - } - - $xml .= " \n"; - - return $xml; -} - -package OpenILS::Application::SuperCat::unAPI::ssub; -use base qw/OpenILS::Application::SuperCat::unAPI/; - -sub as_xml { - my $self = shift; - my $args = shift; - - my $xml = ' obj->id . '" '; - $xml .= 'start="' . $self->escape( $self->obj->start_date ) . '" '; - $xml .= 'end="' . $self->escape( $self->obj->end_date ) . '" '; - $xml .= 'expected_date_offset="' . $self->escape( $self->obj->expected_date_offset ) . '">'; - $xml .= "\n"; - - if (!$args->{no_distributions}) { - if (ref($self->obj->distributions) && @{ $self->obj->distributions }) { - $xml .= " \n" . join( - '', - map { - OpenILS::Application::SuperCat::unAPI - ->new( $_ ) - ->as_xml({ %$args, no_subscription=>1, no_issuance=>1 }) - } @{ $self->obj->distributions } - ) . " \n"; - - } else { - $xml .= " \n"; - } - } - - if (!$args->{no_captions_and_patterns}) { - if (ref($self->obj->scaps) && @{ $self->obj->scaps }) { - $xml .= " \n" . join( - '', - map { - OpenILS::Application::SuperCat::unAPI - ->new( $_ ) - ->as_xml({ %$args, no_subscription=>1 }) - } @{ $self->obj->scaps } - ) . " \n"; - - } else { - $xml .= " \n"; - } - } - - if (!$args->{no_issuances}) { - if (ref($self->obj->issuances) && @{ $self->obj->issuances }) { - $xml .= " \n" . join( - '', - map { - OpenILS::Application::SuperCat::unAPI - ->new( $_ ) - ->as_xml({ %$args, no_subscription=>1, no_items=>1 }) - } @{ $self->obj->issuances } - ) . " \n"; - - } else { - $xml .= " \n"; - } - } - - - $xml .= ' obj->owning_lib->id . '" '; - $xml .= 'shortname="'.$self->escape( $self->obj->owning_lib->shortname ) .'" '; - $xml .= 'name="'.$self->escape( $self->obj->owning_lib->name ) .'"/>'; - $xml .= "\n"; - - unless ($args->{no_record}) { - my $rec_tag = "tag:open-ils.org:biblio-record_entry/".$self->obj->record->id.'/'.$self->escape( $self->obj->owning_lib->shortname ) ; - - my $r_doc = $parser->parse_string($self->obj->record_entry->marc); - $r_doc->documentElement->setAttribute( id => $rec_tag ); - $xml .= $U->entityize($r_doc->documentElement->toString); - } - - $xml .= " \n"; - - return $xml; -} - -package OpenILS::Application::SuperCat::unAPI::ssum_base; -use base qw/OpenILS::Application::SuperCat::unAPI/; - -sub as_xml { - my $self = shift; - my $args = shift; - - (my $type = ref($self)) =~ s/^.+([^:]+)$/$1/; - - my $xml = " obj->id . '" '; - $xml .= 'generated_coverage="' . $self->escape( $self->obj->generated_coverage ) . '" '; - $xml .= 'show_generated="' . $self->escape( $self->obj->show_generated ) . '" '; - $xml .= 'textual_holdings="' . $self->escape( $self->obj->textual_holdings ) . '">'; - $xml .= "\n"; - - $xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->distribution )->as_xml({ %$args, no_summaries=>1 }) if (!$args->{no_distribution}); - - $xml .= " \n"; - - return $xml; -} - - -package OpenILS::Application::SuperCat::unAPI::sssum; -use base qw/OpenILS::Application::SuperCat::unAPI::ssum_base/; - -package OpenILS::Application::SuperCat::unAPI::sbsum; -use base qw/OpenILS::Application::SuperCat::unAPI::ssum_base/; - -package OpenILS::Application::SuperCat::unAPI::sisum; -use base qw/OpenILS::Application::SuperCat::unAPI::ssum_base/; - -package OpenILS::Application::SuperCat::unAPI::sdist; -use base qw/OpenILS::Application::SuperCat::unAPI/; - -sub as_xml { - my $self = shift; - my $args = shift; - - my $xml = ' obj->id . '" '; - $xml .= 'label="' . $self->escape( $self->obj->label ) . '" '; - $xml .= 'unit_label_prefix="' . $self->escape( $self->obj->unit_label_prefix ) . '" '; - $xml .= 'unit_label_suffix="' . $self->escape( $self->obj->unit_label_suffix ) . '">'; - $xml .= "\n"; - - if (!$args->{no_distributions}) { - if (ref($self->obj->streams) && @{ $self->obj->streams }) { - $xml .= " \n" . join( - '', - map { - OpenILS::Application::SuperCat::unAPI - ->new( $_ ) - ->as_xml({ %$args, no_distribution=>1 }) - } @{ $self->obj->streams } - ) . " \n"; - - } else { - $xml .= " \n"; - } - } - - if (!$args->{no_summaries}) { - $xml .= " \n"; - $xml .= join ('', - map { - defined $_ ? - OpenILS::Application::SuperCat::unAPI - ->new( $_ ) - ->as_xml({ %$args, no_distribution=>1 }) : "" - } ($self->obj->basic_summary, $self->obj->supplement_summary, $self->obj->index_summary) - ); - - $xml .= " \n"; - } - - - $xml .= ' obj->holding_lib->id . '" '; - $xml .= 'shortname="'.$self->escape( $self->obj->holding_lib->shortname ) .'" '; - $xml .= 'name="'.$self->escape( $self->obj->holding_lib->name ) .'"/>'; - $xml .= "\n"; - - $xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->subscription )->as_xml({ %$args, no_distributions=>1 }) if (!$args->{no_subscription}); - - if (!$args->{no_record} && $self->obj->record_entry) { - my $rec_tag = "tag:open-ils.org:serial-record_entry/".$self->obj->record_entry->id ; - - my $r_doc = $parser->parse_string($self->obj->record_entry->marc); - $r_doc->documentElement->setAttribute( id => $rec_tag ); - $xml .= $U->entityize($r_doc->documentElement->toString); - } - - $xml .= " \n"; - - return $xml; -} - -package OpenILS::Application::SuperCat::unAPI::sstr; -use base qw/OpenILS::Application::SuperCat::unAPI/; - -sub as_xml { - my $self = shift; - my $args = shift; - - my $xml = ' obj->id . '" '; - $xml .= 'routing_label="' . $self->escape( $self->obj->routing_label ) . '">'; - $xml .= "\n"; - - if (!$args->{no_items}) { - if (ref($self->obj->items) && @{ $self->obj->items }) { - $xml .= " \n" . join( - '', - map { - OpenILS::Application::SuperCat::unAPI - ->new( $_ ) - ->as_xml({ %$args, no_stream=>1 }) - } @{ $self->obj->items } - ) . " \n"; - - } else { - $xml .= " \n"; - } - } - - #XXX routing_list_user's? - - $xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->distribution )->as_xml({ %$args, no_streams=>1 }) if (!$args->{no_distribution}); - - $xml .= " \n"; - - return $xml; -} - -package OpenILS::Application::SuperCat::unAPI::sitem; -use base qw/OpenILS::Application::SuperCat::unAPI/; - -sub as_xml { - my $self = shift; - my $args = shift; - - my $xml = ' obj->id . '" '; - $xml .= 'date_expected="' . $self->escape( $self->obj->date_expected ) . '"'; - $xml .= ' date_received="' . $self->escape( $self->obj->date_received ) .'"'if ($self->obj->date_received); - - if ($args->{no_issuance}) { - my $siss = ref($self->obj->issuance) ? $self->obj->issuance->id : $self->obj->issuance; - $xml .= ' issuance="tag:open-ils.org:serial-issuance/' . $siss . '"'; - } - - $xml .= ">\n"; - - if (ref($self->obj->notes) && $self->obj->notes) { - $xml .= " \n"; - for my $note ( @{$self->obj->notes} ) { - next unless ( $note->pub eq 't' ); - $xml .= sprintf(' %s',$note->create_date, $self->escape($note->title), $self->escape($note->value)); - $xml .= "\n"; - } - $xml .= " \n"; - } else { - $xml .= " \n"; - } - - $xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->issuance )->as_xml({ %$args, no_items=>1 }) if (!$args->{no_issuance}); - $xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->stream )->as_xml({ %$args, no_items=>1 }) if (!$args->{no_stream}); - $xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->unit )->as_xml({ %$args, no_items=>1, no_volumes=>1 }) if ($self->obj->unit && !$args->{no_unit}); - $xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->uri )->as_xml({ %$args, no_items=>1, no_volumes=>1 }) if ($self->obj->uri && !$args->{no_uri}); - - $xml .= " \n"; - - return $xml; -} - -package OpenILS::Application::SuperCat::unAPI::sunit; -use base qw/OpenILS::Application::SuperCat::unAPI/; - -sub as_xml { - my $self = shift; - my $args = shift; - - my $xml = ' obj->status->id . '">' . $self->escape( $self->obj->status->name ) . "\n"; - $xml .= ' ' . $self->escape( $self->obj->location->name ) . "\n"; - $xml .= ' ' . $self->escape( $self->obj->circ_lib->name ) . "\n"; - - $xml .= ' obj->circ_lib->id . '" '; - $xml .= 'shortname="'.$self->escape( $self->obj->circ_lib->shortname ) .'" '; - $xml .= 'name="'.$self->escape( $self->obj->circ_lib->name ) .'"/>'; - $xml .= "\n"; - - $xml .= " \n"; - if (ref($self->obj->notes) && $self->obj->notes) { - for my $note ( @{$self->obj->notes} ) { - next unless ( $note->pub eq 't' ); - $xml .= sprintf(' %s',$note->create_date, $self->escape($note->title), $self->escape($note->value)); - $xml .= "\n"; - } - } - - $xml .= " \n"; - $xml .= " \n"; - - if (ref($self->obj->stat_cat_entries) && $self->obj->stat_cat_entries) { - for my $sce ( @{$self->obj->stat_cat_entries} ) { - next unless ( $sce->stat_cat->opac_visible eq 't' ); - $xml .= sprintf(' %s',$self->escape($sce->stat_cat->name) ,$self->escape($sce->value)); - $xml .= "\n"; - } - } - $xml .= " \n"; - - unless ($args->{no_volume}) { - if (ref($self->obj->call_number)) { - $xml .= OpenILS::Application::SuperCat::unAPI - ->new( $self->obj->call_number ) - ->as_xml({ %$args, no_copies=>1 }); - } else { - $xml .= " \n"; - } - } - - $xml .= " \n"; - - return $xml; -} - -package OpenILS::Application::SuperCat::unAPI::scap; -use base qw/OpenILS::Application::SuperCat::unAPI/; - -sub as_xml { - my $self = shift; - my $args = shift; - - my $xml = ' new( $self->obj->subscription )->as_xml({ %$args, no_captions_and_patterns=>1 }) if (!$args->{no_subscription}); - $xml .= " \n"; - - return $xml; -} - -package OpenILS::Application::SuperCat::unAPI::siss; -use base qw/OpenILS::Application::SuperCat::unAPI/; - -sub as_xml { - my $self = shift; - my $args = shift; - - my $xml = ' {no_items}) { - if (ref($self->obj->items) && @{ $self->obj->items }) { - $xml .= " \n" . join( - '', - map { - OpenILS::Application::SuperCat::unAPI - ->new( $_ ) - ->as_xml({ %$args, no_stream=>1 }) - } @{ $self->obj->items } - ) . " \n"; - - } else { - $xml .= " \n"; - } - } - - $xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->subscription )->as_xml({ %$args, no_issuances=>1 }) if (!$args->{no_subscription}); - $xml .= " \n"; - - return $xml; -} - -package OpenILS::Application::SuperCat::unAPI::acp; -use base qw/OpenILS::Application::SuperCat::unAPI/; - -sub as_xml { - my $self = shift; - my $args = shift; - - my $xml = ' obj->status->id . '">' . $self->escape( $self->obj->status->name ) . "\n"; - $xml .= ' ' . $self->escape( $self->obj->location->name ) . "\n"; - $xml .= ' ' . $self->escape( $self->obj->circ_lib->name ) . "\n"; - - $xml .= ' obj->circ_lib->id . '" '; - $xml .= 'shortname="'.$self->escape( $self->obj->circ_lib->shortname ) .'" '; - $xml .= 'name="'.$self->escape( $self->obj->circ_lib->name ) .'" opac_visible="'.$self->obj->circ_lib->opac_visible.'"/>'; - $xml .= "\n"; - - $xml .= " \n"; - if (ref($self->obj->notes) && $self->obj->notes) { - for my $note ( @{$self->obj->notes} ) { - next unless ( $note->pub eq 't' ); - $xml .= sprintf(' %s',$note->create_date, $self->escape($note->title), $self->escape($note->value)); - $xml .= "\n"; - } - } - - $xml .= " \n"; - $xml .= " \n"; - - if (ref($self->obj->stat_cat_entries) && $self->obj->stat_cat_entries) { - for my $sce ( @{$self->obj->stat_cat_entries} ) { - next unless ( $sce->stat_cat->opac_visible eq 't' ); - $xml .= sprintf(' %s',$self->escape($sce->stat_cat->name) ,$self->escape($sce->value)); - $xml .= "\n"; - } - } - $xml .= " \n"; - - unless ($args->{no_volume}) { - if (ref($self->obj->call_number)) { - $xml .= OpenILS::Application::SuperCat::unAPI - ->new( $self->obj->call_number ) - ->as_xml({ %$args, no_copies=>1 }); - } else { - $xml .= " \n"; - } - } - - $xml .= " \n"; - - return $xml; -} - - -1; -# vim: et:ts=4:sw=4 diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger.pm deleted file mode 100644 index ae83a7755a..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger.pm +++ /dev/null @@ -1,842 +0,0 @@ -package OpenILS::Application::Trigger; -use strict; use warnings; -use OpenILS::Application; -use base qw/OpenILS::Application/; - -use OpenSRF::EX qw/:try/; -use OpenSRF::Utils::JSON; - -use OpenSRF::AppSession; -use OpenSRF::MultiSession; -use OpenSRF::Utils::SettingsClient; -use OpenSRF::Utils::Logger qw/$logger/; -use OpenSRF::Utils qw/:datetime/; - -use DateTime; -use DateTime::Format::ISO8601; - -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Application::Trigger::Event; -use OpenILS::Application::Trigger::EventGroup; - - -my $log = 'OpenSRF::Utils::Logger'; -my $parallel_collect; -my $parallel_react; - -sub initialize { - - my $conf = OpenSRF::Utils::SettingsClient->new; - $parallel_collect = $conf->config_value( apps => 'open-ils.trigger' => app_settings => parallel => 'collect') || 1; - $parallel_react = $conf->config_value( apps => 'open-ils.trigger' => app_settings => parallel => 'react') || 1; - -} -sub child_init {} - -sub create_active_events_for_object { - my $self = shift; - my $client = shift; - my $key = shift; - my $target = shift; - my $location = shift; - my $granularity = shift; - my $user_data = shift; - - my $ident = $target->Identity; - my $ident_value = $target->$ident(); - - my $editor = new_editor(xact=>1); - - my $hooks = $editor->search_action_trigger_hook( - { key => $key, - core_type => $target->json_hint - } - ); - - unless(@$hooks) { - $editor->rollback; - return undef; - } - - my %hook_hash = map { ($_->key, $_) } @$hooks; - - my $orgs = $editor->json_query({ from => [ 'actor.org_unit_ancestors' => $location ] }); - my $defs = $editor->search_action_trigger_event_definition( - { hook => [ keys %hook_hash ], - owner => [ map { $_->{id} } @$orgs ], - active => 't' - } - ); - - for my $def ( @$defs ) { - next if ($granularity && $def->granularity ne $granularity ); - - if ($def->usr_field && $def->opt_in_setting) { - my $ufield = $def->usr_field; - my $uid = $target->$ufield; - $uid = $uid->id if (ref $uid); # fleshed user object, unflesh it - - my $opt_in_setting = $editor->search_actor_user_setting( - { usr => $uid, - name => $def->opt_in_setting, - value => 'true' - } - ); - - next unless (@$opt_in_setting); - } - - my $date = DateTime->now; - - if ($hook_hash{$def->hook}->passive eq 'f') { - - if (my $dfield = $def->delay_field) { - if ($target->$dfield()) { - $date = DateTime::Format::ISO8601->new->parse_datetime( cleanse_ISO8601($target->$dfield) ); - } else { - next; - } - } - - $date->add( seconds => interval_to_seconds($def->delay) ); - } - - my $event = Fieldmapper::action_trigger::event->new(); - $event->target( $ident_value ); - $event->event_def( $def->id ); - $event->run_time( $date->strftime( '%F %T%z' ) ); - $event->user_data( OpenSRF::Utils::JSON->perl2JSON($user_data) ) if (defined($user_data)); - - $editor->create_action_trigger_event( $event ); - - $client->respond( $event->id ); - } - - $editor->commit; - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.trigger.event.autocreate', - method => 'create_active_events_for_object', - api_level=> 1, - stream => 1, - argc => 3 -); - -sub create_event_for_object_and_def { - my $self = shift; - my $client = shift; - my $definitions = shift; - my $target = shift; - my $location = shift; - my $user_data = shift; - - my $ident = $target->Identity; - my $ident_value = $target->$ident(); - - my @active = ($self->api_name =~ /inactive/o) ? () : ( active => 't' ); - - my $editor = new_editor(xact=>1); - - my $orgs = $editor->json_query({ from => [ 'actor.org_unit_ancestors' => $location ] }); - my $defs = $editor->search_action_trigger_event_definition( - { id => $definitions, - owner => [ map { $_->{id} } @$orgs ], - @active - } - ); - - my $hooks = $editor->search_action_trigger_hook( - { key => [ map { $_->hook } @$defs ], - core_type => $target->json_hint - } - ); - - my %hook_hash = map { ($_->key, $_) } @$hooks; - - for my $def ( @$defs ) { - - if ($def->usr_field && $def->opt_in_setting) { - my $ufield = $def->usr_field; - my $uid = $target->$ufield; - $uid = $uid->id if (ref $uid); # fleshed user object, unflesh it - - my $opt_in_setting = $editor->search_actor_user_setting( - { usr => $uid, - name => $def->opt_in_setting, - value => 'true' - } - ); - - next unless (@$opt_in_setting); - } - - my $date = DateTime->now; - - if ($hook_hash{$def->hook}->passive eq 'f') { - - if (my $dfield = $def->delay_field) { - if ($target->$dfield()) { - $date = DateTime::Format::ISO8601->new->parse_datetime( cleanse_ISO8601($target->$dfield) ); - } else { - next; - } - } - - $date->add( seconds => interval_to_seconds($def->delay) ); - } - - my $event = Fieldmapper::action_trigger::event->new(); - $event->target( $ident_value ); - $event->event_def( $def->id ); - $event->run_time( $date->strftime( '%F %T%z' ) ); - $event->user_data( OpenSRF::Utils::JSON->perl2JSON($user_data) ) if (defined($user_data)); - - $editor->create_action_trigger_event( $event ); - - $client->respond( $event->id ); - } - - $editor->commit; - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.trigger.event.autocreate.by_definition', - method => 'create_event_for_object_and_def', - api_level=> 1, - stream => 1, - argc => 3 -); -__PACKAGE__->register_method( - api_name => 'open-ils.trigger.event.autocreate.by_definition.include_inactive', - method => 'create_event_for_object_and_def', - api_level=> 1, - stream => 1, - argc => 3 -); - - -# Retrieves events by object, or object type + filter -# $object : a target object or object type (class hint) -# -# $filter : an optional hash of filters ... top level keys: -# event -# filters on the atev objects, such as states or null-ness of timing -# fields. contains the effective default of: -# { state => 'pending' } -# an example, which overrides the default, and will find -# stale 'found' events: -# { state => 'found', update_time => { '<' => 'yesterday' } } -# -# event_def -# filters on the atevdef object. contains the effective default of: -# { active => 't' } -# -# hook -# filters on the hook object. no defaults, but there is a pinned, -# unchangeable filter based on the passed hint or object type (see -# $object above). an example for finding passive events: -# { passive => 't' } -# -# target -# filters against the target field on the event. this can contain -# either an array of target ids (if you passed an object type, and -# not an object) or can contain a json_query that will return exactly -# a list of target-type ids. If you pass an object, the pkey value of -# that object will be used as a filter in addition to the filter passed -# in here. example filter for circs of user 1234 that are open: -# { select => { circ => ['id'] }, -# from => 'circ', -# where => { -# usr => 1234, -# checkin_time => undef, -# '-or' => [ -# { stop_fines => undef }, -# { stop_fines => { 'not in' => ['LOST','LONGOVERDUE','CLAIMSRETURNED'] } } -# ] -# } - -sub events_by_target { - my $self = shift; - my $client = shift; - my $object = shift; - my $filter = shift || {}; - my $flesh_fields = shift || {}; - my $flesh_depth = shift || 1; - - my $obj_class = ref($object) || _fm_class_by_hint($object); - my $obj_hint = ref($object) ? _fm_hint_by_class(ref($object)) : $object; - - my $object_ident_field = $obj_class->Identity; - - my $query = { - select => { atev => ["id"] }, - from => { - atev => { - atevdef => { - field => "id", - fkey => "event_def", - join => { - ath => { field => "key", fkey => "hook" } - } - } - } - }, - where => { - "+ath" => { core_type => $obj_hint }, - "+atevdef" => { active => 't' }, - "+atev" => { state => 'pending' } - }, - order_by => { "atev" => [ 'run_time', 'add_time' ] } - }; - - $query->{limit} = $filter->{limit} if defined $filter->{limit}; - $query->{offset} = $filter->{offset} if defined $filter->{offset}; - $query->{order_by} = $filter->{order_by} if defined $filter->{order_by}; - - - # allow multiple 'target' filters - $query->{where}->{'+atev'}->{'-and'} = []; - - # if we got a real object, filter on its pkey value - if (ref($object)) { # pass an object, require that target - push @{ $query->{where}->{'+atev'}->{'-and'} }, - { target => $object->$object_ident_field } - } - - # we have a fancy complex target filter or a list of target ids - if ($$filter{target}) { - push @{ $query->{where}->{'+atev'}->{'-and'} }, - { target => {in => $$filter{target} } }; - } - - # pass no target filter or object, you get no events - if (!@{ $query->{where}->{'+atev'}->{'-and'} }) { - return undef; - } - - # any hook filters, other than the required core_type filter - if ($$filter{hook}) { - $query->{where}->{'+ath'}->{$_} = $$filter{hook}{$_} - for (grep { $_ ne 'core_type' } keys %{$$filter{hook}}); - } - - # any event_def filters. defaults to { active => 't' } - if ($$filter{event_def}) { - $query->{where}->{'+atevdef'}->{$_} = $$filter{event_def}{$_} - for (keys %{$$filter{event_def}}); - } - - # any event filters. defaults to { state => 'pending' }. - # don't overwrite '-and' used for multiple target filters above - if ($$filter{event}) { - $query->{where}->{'+atev'}->{$_} = $$filter{event}{$_} - for (grep { $_ ne '-and' } keys %{$$filter{event}}); - } - - my $e = new_editor(xact=>1); - - my $events = $e->json_query($query); - - $flesh_fields->{atev} = ['event_def'] unless $flesh_fields->{atev}; - - for my $id (@$events) { - my $event = $e->retrieve_action_trigger_event([ - $id->{id}, - {flesh => $flesh_depth, flesh_fields => $flesh_fields} - ]); - - (my $meth = $obj_class) =~ s/^Fieldmapper:://o; - $meth =~ s/::/_/go; - $meth = 'retrieve_'.$meth; - - $event->target($e->$meth($event->target)); - $client->respond($event); - } - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.trigger.events_by_target', - method => 'events_by_target', - api_level=> 1, - stream => 1, - argc => 2 -); - -sub _fm_hint_by_class { - my $class = shift; - return Fieldmapper->publish_fieldmapper->{$class}->{hint}; -} - -sub _fm_class_by_hint { - my $hint = shift; - - my ($class) = grep { - Fieldmapper->publish_fieldmapper->{$_}->{hint} eq $hint - } keys %{ Fieldmapper->publish_fieldmapper }; - - return $class; -} - -sub create_batch_events { - my $self = shift; - my $client = shift; - my $key = shift; - my $location_field = shift; # where to look for event_def.owner filtering ... circ_lib, for instance, where hook.core_type = circ - my $filter = shift || {}; - my $granularity = shift; - my $user_data = shift; - - my $active = ($self->api_name =~ /active/o) ? 1 : 0; - if ($active && !keys(%$filter)) { - $log->info("Active batch event creation requires a target filter but none was supplied to create_batch_events"); - return undef; - } - - return undef unless ($key && $location_field); - - my $editor = new_editor(xact=>1); - my $hooks = $editor->search_action_trigger_hook( - { passive => $active ? 'f' : 't', key => $key } - ); - - my %hook_hash = map { ($_->key, $_) } @$hooks; - - my $defs = $editor->search_action_trigger_event_definition( - { hook => [ keys %hook_hash ], active => 't' }, - ); - - my $orig_filter_and = []; - if ($$filter{'-and'}) { - for my $f ( @{ $$filter{'-and'} } ) { - push @$orig_filter_and, $f; - } - } - - for my $def ( @$defs ) { - next if ($granularity && $def->granularity ne $granularity ); - - my $date = DateTime->now->subtract( seconds => interval_to_seconds($def->delay) ); - - # we may need to do some work to backport this to 1.2 - $filter->{ $location_field } = { 'in' => - { - select => { aou => [{ column => 'id', transform => 'actor.org_unit_descendants', result_field => 'id' }] }, - from => 'aou', - where => { id => $def->owner } - } - }; - - my $run_time = 'now'; - if ($active) { - $run_time = - DateTime - ->now - ->add( seconds => interval_to_seconds($def->delay) ) - ->strftime( '%F %T%z' ); - } else { - if ($def->max_delay) { - my @times = sort {$a <=> $b} interval_to_seconds($def->delay), interval_to_seconds($def->max_delay); - $filter->{ $def->delay_field } = { - 'between' => [ - DateTime->now->subtract( seconds => $times[1] )->strftime( '%F %T%z' ), - DateTime->now->subtract( seconds => $times[0] )->strftime( '%F %T%z' ) - ] - }; - } else { - $filter->{ $def->delay_field } = { - '<=' => DateTime->now->subtract( seconds => interval_to_seconds($def->delay) )->strftime( '%F %T%z' ) - }; - } - } - - my $class = _fm_class_by_hint($hook_hash{$def->hook}->core_type); - - # filter where this target has an event (and it's pending, for active hooks) - $$filter{'-and'} = []; - for my $f ( @$orig_filter_and ) { - push @{ $$filter{'-and'} }, $f; - } - - my $join = { 'join' => { - atev => { - field => 'target', - fkey => $class->Identity, - type => 'left', - filter => { event_def => $def->id } - } - }}; - - push @{ $filter->{'-and'} }, { '+atev' => { id => undef } }; - - if ($def->usr_field && $def->opt_in_setting) { - push @{ $filter->{'-and'} }, { - '-exists' => { - from => 'aus', - where => { - name => $def->opt_in_setting, - usr => { '=' => { '+' . $hook_hash{$def->hook}->core_type => $def->usr_field } }, - value=> 'true' - } - } - }; - } - - $class =~ s/^Fieldmapper:://o; - $class =~ s/::/_/go; - my $method = 'search_'. $class; - - # for cleaner logging - my $def_id = $def->id; - my $hook = $def->hook; - - $logger->info("trigger: create_batch_events() collecting object IDs for def=$def_id / hook=$hook"); - - my $object_ids = $editor->$method( [$filter, $join], {idlist => 1, timeout => 10800} ); - - if($object_ids) { - $logger->info("trigger: create_batch_events() fetched ".scalar(@$object_ids)." object IDs for def=$def_id / hook=$hook"); - } else { - $logger->warn("trigger: create_batch_events() timeout occurred collecting object IDs for def=$def_id / hook=$hook"); - } - - for my $o_id (@$object_ids) { - - my $event = Fieldmapper::action_trigger::event->new(); - $event->target( $o_id ); - $event->event_def( $def->id ); - $event->run_time( $run_time ); - $event->user_data( OpenSRF::Utils::JSON->perl2JSON($user_data) ) if (defined($user_data)); - - $editor->create_action_trigger_event( $event ); - - $client->respond( $event->id ); - } - - $logger->info("trigger: create_batch_events() successfully created events for def=$def_id / hook=$hook"); - } - - $logger->info("trigger: create_batch_events() done creating events"); - - $editor->commit; - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.trigger.passive.event.autocreate.batch', - method => 'create_batch_events', - api_level=> 1, - stream => 1, - argc => 2 -); - -__PACKAGE__->register_method( - api_name => 'open-ils.trigger.active.event.autocreate.batch', - method => 'create_batch_events', - api_level=> 1, - stream => 1, - argc => 2 -); - -sub fire_single_event { - my $self = shift; - my $client = shift; - my $event_id = shift; - - my $e = OpenILS::Application::Trigger::Event->new($event_id); - - if ($e->validate->valid) { - $logger->info("trigger: Event is valid, reacting..."); - $e->react->cleanup; - } - - $e->editor->disconnect; - OpenILS::Application::Trigger::Event->ClearObjectCache(); - - return { - valid => $e->valid, - reacted => $e->reacted, - cleanedup => $e->cleanedup, - event => $e->event - }; -} -__PACKAGE__->register_method( - api_name => 'open-ils.trigger.event.fire', - method => 'fire_single_event', - api_level=> 1, - argc => 1 -); - -sub fire_event_group { - my $self = shift; - my $client = shift; - my $events = shift; - - my $e = OpenILS::Application::Trigger::EventGroup->new(@$events); - - if ($e->validate->valid) { - $logger->info("trigger: Event group is valid, reacting..."); - $e->react->cleanup; - } - - $e->editor->disconnect; - OpenILS::Application::Trigger::Event->ClearObjectCache(); - - return { - valid => $e->valid, - reacted => $e->reacted, - cleanedup => $e->cleanedup, - events => [map { $_->event } @{$e->events}] - }; -} -__PACKAGE__->register_method( - api_name => 'open-ils.trigger.event_group.fire', - method => 'fire_event_group', - api_level=> 1, - argc => 1 -); - -sub pending_events { - my $self = shift; - my $client = shift; - my $granularity = shift; - my $granflag = shift; - - my $query = [{ state => 'pending', run_time => {'<' => 'now'} }, { order_by => { atev => [ qw/run_time add_time/] }, 'join' => 'atevdef' }]; - - if (defined $granularity) { - if ($granflag) { - $query->[0]->{'+atevdef'} = {granularity => $granularity}; - } else { - $query->[0]->{'+atevdef'} = {'-or' => [ {granularity => $granularity}, {granularity => undef} ] }; - } - } else { - $query->[0]->{'+atevdef'} = {granularity => undef}; - } - - return new_editor(xact=>1)->search_action_trigger_event( - $query, { idlist=> 1, timeout => 7200, substream => 1 } - ); -} -__PACKAGE__->register_method( - api_name => 'open-ils.trigger.event.find_pending', - method => 'pending_events', - api_level=> 1 -); - -sub gather_events { - my $self = shift; - my $client = shift; - my $e_ids = shift; - - $e_ids = [$e_ids] if (!ref($e_ids)); - - my @events; - for my $e_id (@$e_ids) { - my $e; - try { - $e = OpenILS::Application::Trigger::Event->new($e_id); - } catch Error with { - $logger->error("trigger: Event creation failed with ".shift()); - }; - - next if !$e or $e->event->state eq 'invalid'; - - try { - $e->build_environment; - } catch Error with { - $logger->error("trigger: Event environment building failed with ".shift()); - }; - - $e->editor->disconnect; - $e->environment->{EventProcessor} = undef; # remove circular ref for json encoding - $client->respond($e); - } - - OpenILS::Application::Trigger::Event->ClearObjectCache(); - - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.trigger.event.gather', - method => 'gather_events', - api_level=> 1 -); - -sub grouped_events { - my $self = shift; - my $client = shift; - my $granularity = shift; - my $granflag = shift; - - my ($events) = $self->method_lookup('open-ils.trigger.event.find_pending')->run($granularity, $granflag); - - my %groups = ( '*' => [] ); - - if($events) { - $logger->info("trigger: grouped_events found ".scalar(@$events)." pending events to process"); - } else { - $logger->warn("trigger: grouped_events timed out loading pending events"); - return \%groups; - } - - my @fleshed_events; - - if ($parallel_collect == 1 or @$events == 1) { # use method lookup - @fleshed_events = $self->method_lookup('open-ils.trigger.event.gather')->run($events); - } else { - my $self_multi = OpenSRF::MultiSession->new( - app => 'open-ils.trigger', - cap => $parallel_collect, - success_handler => sub { - my $self = shift; - my $req = shift; - - push @fleshed_events, - map { OpenILS::Application::Trigger::Event->new($_) } - map { $_->content } - @{ $req->{response} }; - }, - ); - - $self_multi->request( 'open-ils.trigger.event.gather' => $_ ) for ( @$events ); - $client->status( new OpenSRF::DomainObject::oilsContinueStatus ); - - $self_multi->session_wait(1); - $client->status( new OpenSRF::DomainObject::oilsContinueStatus ); - } - - for my $e (@fleshed_events) { - if (my $group = $e->event->event_def->group_field) { - - # split the grouping link steps - my @steps = split /\./, $group; - my $group_field = pop(@steps); # we didn't flesh to this, it's a field not an object - - my $node; - eval { - $node = $e->target; - $node = $node->$_() for ( @steps ); - }; - - unless($node) { # should not get here, but to be safe.. - $e->update_state('invalid'); - next; - } - - # get the grouping value for the grouping object on this event - my $ident_value = $node->$group_field(); - if(ref $ident_value) { - my $ident_field = $ident_value->Identity; - $ident_value = $ident_value->$ident_field() - } - - # push this event onto the event+grouping_value stack - $groups{$e->event->event_def->id}{$ident_value} ||= []; - push @{ $groups{$e->event->event_def->id}{$ident_value} }, $e; - } else { - # it's a non-grouped event - push @{ $groups{'*'} }, $e; - } - } - - - return \%groups; -} -__PACKAGE__->register_method( - api_name => 'open-ils.trigger.event.find_pending_by_group', - method => 'grouped_events', - api_level=> 1 -); - -sub run_all_events { - my $self = shift; - my $client = shift; - my $granularity = shift; - my $granflag = shift; - - my ($groups) = $self->method_lookup('open-ils.trigger.event.find_pending_by_group')->run($granularity, $granflag); - $client->respond({"status" => "found"}) if (keys(%$groups) > 1 || @{$$groups{'*'}}); - - my $self_multi; - if ($parallel_react > 1 and (keys(%$groups) > 1 || @{$$groups{'*'}} > 1)) { - $self_multi = OpenSRF::MultiSession->new( - app => 'open-ils.trigger', - cap => $parallel_react, - session_hash_function => sub { - my $args = shift; - return $args->{target_id}; - }, - success_handler => sub { - my $me = shift; - my $req = shift; - $client->respond( $req->{response}->[0]->content ); - } - ); - } - - for my $def ( keys %$groups ) { - if ($def eq '*') { - $logger->info("trigger: run_all_events firing un-grouped events"); - for my $event ( @{ $$groups{'*'} } ) { - try { - if ($self_multi) { - $event->environment->{EventProcessor} = undef; # remove circular ref for json encoding - $self_multi->request({target_id => $event->id}, 'open-ils.trigger.event.fire', $event); - } else { - $client->respond( - $self - ->method_lookup('open-ils.trigger.event.fire') - ->run($event) - ); - } - } catch Error with { - $logger->error("trigger: event firing failed with ".shift()); - }; - } - $logger->info("trigger: run_all_events completed queuing un-grouped events"); - $client->status( new OpenSRF::DomainObject::oilsContinueStatus ); - - } else { - my $defgroup = $$groups{$def}; - $logger->info("trigger: run_all_events firing events for grouped event def=$def"); - for my $ident ( keys %$defgroup ) { - $logger->info("trigger: run_all_events firing group for grouped event def=$def and grp ident $ident"); - try { - if ($self_multi) { - $_->environment->{EventProcessor} = undef for @{$$defgroup{$ident}}; # remove circular ref for json encoding - $self_multi->request({target_id => $ident}, 'open-ils.trigger.event_group.fire', $$defgroup{$ident}); - } else { - $client->respond( - $self - ->method_lookup('open-ils.trigger.event_group.fire') - ->run($$defgroup{$ident}) - ); - } - $client->status( new OpenSRF::DomainObject::oilsContinueStatus ); - } catch Error with { - $logger->error("trigger: event firing failed with ".shift()); - }; - } - $logger->info("trigger: run_all_events completed queuing events for grouped event def=$def"); - } - } - - $self_multi->session_wait(1) if ($self_multi); - $logger->info("trigger: run_all_events completed firing events"); - - $client->respond_complete(); - return undef; -} -__PACKAGE__->register_method( - api_name => 'open-ils.trigger.event.run_all_pending', - method => 'run_all_events', - api_level=> 1 -); - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Cleanup.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Cleanup.pm deleted file mode 100644 index 495a60a0f8..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Cleanup.pm +++ /dev/null @@ -1,29 +0,0 @@ -package OpenILS::Application::Trigger::Cleanup; -use strict; use warnings; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenSRF::Utils::Logger qw/:logger/; - -sub fourty_two { return 42 } -sub NOOP_True { return 1 } -sub NOOP_False { return 0 } - -sub DeleteTempBiblioBucket { - my($self, $env) = @_; - my $e = new_editor(xact => 1); - my $buckets = $env->{target}; - - for my $bucket (@$buckets) { - - foreach my $item (@{ $bucket->items }) { - $e->delete_container_biblio_record_entry_bucket_item($item); - } - - $e->delete_container_biblio_record_entry_bucket($bucket); - } - - $e->commit or $e->die_event; - - return 1; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Collector.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Collector.pm deleted file mode 100644 index db650ede98..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Collector.pm +++ /dev/null @@ -1,4 +0,0 @@ -package OpenILS::Application::Trigger::Collector; -use strict; use warnings; -sub fourty_two { return 42 } -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Event.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Event.pm deleted file mode 100644 index de11a15eac..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Event.pm +++ /dev/null @@ -1,606 +0,0 @@ -package OpenILS::Application::Trigger::Event; -use strict; use warnings; -use OpenSRF::EX qw/:try/; -use OpenSRF::Utils::JSON; -use OpenSRF::Utils::Logger qw/$logger/; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Application::Trigger::ModRunner; -use Safe; - -my $log = 'OpenSRF::Utils::Logger'; - -sub new { - my $class = shift; - my $id = shift; - my $editor = shift; - $class = ref($class) || $class; - - my $standalone = $editor ? 0 : 1; - $editor ||= new_editor(); - - if (ref($id) && ref($id) eq $class) { - $id->environment->{EventProcessor} = $id - if ($id->environment->{complete}); # in case it came over an opensrf tube - $id->editor( $editor ); - $id->standalone( $standalone ); - return $id; - } - - my $self = bless { id => $id, editor => $editor, standalone => $standalone } => $class; - - return $self->init() -} - -sub init { - my $self = shift; - my $id = shift; - - return $self if ($self->event); - - $self->id( $id ); - $self->environment( {} ); - - if (!$self->id) { - $log->error("No Event ID provided"); - die "No Event ID provided"; - } - - return $self if (!$self->id); - - if ($self->standalone) { - $self->editor->xact_begin || return undef; - } - - $self->event( - $self->editor->retrieve_action_trigger_event([ - $self->id, { - flesh => 2, - flesh_fields => { - atev => [ qw/event_def/ ], - atevdef => [ qw/hook env params/ ] - } - } - ]) - ); - - if ($self->standalone) { - $self->editor->xact_rollback || return undef; - } - - $self->user_data(OpenSRF::Utils::JSON->JSON2perl( $self->event->user_data )) - if (defined( $self->event->user_data )); - - if ($self->event->state eq 'valid') { - $self->valid(1); - } elsif ($self->event->state eq 'invalid') { - $self->valid(0); - } elsif ($self->event->state eq 'reacting') { - $self->valid(1); - } elsif ($self->event->state eq 'reacted') { - $self->valid(1); - $self->reacted(1); - } elsif ($self->event->state eq 'cleaning') { - $self->valid(1); - $self->reacted(1); - } elsif ($self->event->state eq 'complete') { - $self->valid(1); - $self->reacted(1); - $self->cleanedup(1); - } elsif ($self->event->state eq 'error') { - $self->valid(0); - $self->reacted(0); - $self->cleanedup(0); - } - - - $self->update_state('found') || die 'Unable to update event state'; - - my $class = $self->_fm_class_by_hint( $self->event->event_def->hook->core_type ); - - my $meth = "retrieve_" . $class; - $meth =~ s/Fieldmapper:://; - $meth =~ s/::/_/; - - if ($self->standalone) { - $self->editor->xact_begin || return undef; - } - - $self->target( $self->editor->$meth( $self->event->target ) ); - - if ($self->standalone) { - $self->editor->xact_rollback || return undef; - } - - unless($self->target) { - $self->update_state('invalid'); - $self->valid(0); - } - - return $self; -} - -sub cleanup { - my $self = shift; - my $env = shift || $self->environment; - - return $self if (defined $self->cleanedup); - - if (defined $self->reacted) { - $self->update_state( 'cleaning') || die 'Unable to update event state'; - try { - my $cleanup = $self->reacted ? $self->event->event_def->cleanup_success : $self->event->event_def->cleanup_failure; - if($cleanup) { - $self->cleanedup( - OpenILS::Application::Trigger::ModRunner::Cleanup - ->new( $cleanup, $env) - ->run - ->final_result - ); - } else { - $self->cleanedup(1); - } - } otherwise { - $log->error("Event cleanup failed with ". shift() ); - $self->update_state( 'error' ) || die 'Unable to update event state'; - }; - - if ($self->cleanedup) { - $self->update_state( 'complete' ) || die 'Unable to update event state'; - } else { - $self->update_state( 'error' ) || die 'Unable to update event state'; - } - - } else { - $self->{cleanedup} = undef; - } - return $self; -} - -sub react { - my $self = shift; - my $env = shift || $self->environment; - - return $self if (defined $self->reacted); - - if ($self->valid) { - if ($self->event->event_def->group_field) { # can't react individually to a grouped definition - $self->{reacted} = undef; - } else { - $self->update_state( 'reacting') || die 'Unable to update event state'; - try { - $self->reacted( - OpenILS::Application::Trigger::ModRunner::Reactor - ->new( $self->event->event_def->reactor, $env ) - ->run - ->final_result - ); - } otherwise { - $log->error("Event reacting failed with ". shift() ); - $self->update_state( 'error' ) || die 'Unable to update event state'; - }; - - if (defined $self->reacted) { - $self->update_state( 'reacted' ) || die 'Unable to update event state'; - } else { - $self->update_state( 'error' ) || die 'Unable to update event state'; - } - } - } else { - $self->{reacted} = undef; - } - return $self; -} - -sub validate { - my $self = shift; - - return $self if (defined $self->valid); - - if ($self->build_environment->environment->{complete}) { - $self->update_state( 'validating') || die 'Unable to update event state'; - try { - $self->valid( - OpenILS::Application::Trigger::ModRunner::Validator - ->new( $self->event->event_def->validator, $self->environment ) - ->run - ->final_result - ); - } otherwise { - $log->error("Event validation failed with ". shift() ); - $self->update_state( 'error' ) || die 'Unable to update event state'; - }; - - if (defined $self->valid) { - if ($self->valid) { - $self->update_state( 'valid' ) || die 'Unable to update event state'; - } else { - $self->update_state( 'invalid' ) || die 'Unable to update event state'; - } - } else { - $self->update_state( 'error' ) || die 'Unable to update event state'; - } - } else { - $self->{valid} = undef - } - - return $self; -} - -sub cleanedup { - my $self = shift; - return undef unless (ref $self); - - my $c = shift; - $self->{cleanedup} = $c if (defined $c); - return $self->{cleanedup}; -} - -sub user_data { - my $self = shift; - return undef unless (ref $self); - - my $r = shift; - $self->{user_data} = $r if (defined $r); - return $self->{user_data}; -} - -sub reacted { - my $self = shift; - return undef unless (ref $self); - - my $r = shift; - $self->{reacted} = $r if (defined $r); - return $self->{reacted}; -} - -sub valid { - my $self = shift; - return undef unless (ref $self); - - my $v = shift; - $self->{valid} = $v if (defined $v); - return $self->{valid}; -} - -sub event { - my $self = shift; - return undef unless (ref $self); - - my $e = shift; - $self->{event} = $e if (defined $e); - return $self->{event}; -} - -sub id { - my $self = shift; - return undef unless (ref $self); - - my $i = shift; - $self->{id} = $i if (defined $i); - return $self->{id}; -} - -sub environment { - my $self = shift; - return undef unless (ref $self); - - my $e = shift; - $self->{environment} = $e if (defined $e); - return $self->{environment}; -} - -sub editor { - my $self = shift; - return undef unless (ref $self); - - my $e = shift; - $self->{editor} = $e if (defined $e); - return $self->{editor}; -} - -sub unfind { - my $self = shift; - return undef unless (ref $self); - - die 'Cannot unfind a reacted event' if (defined $self->reacted); - - $self->update_state( 'pending' ) || die 'Unable to update event state'; - $self->{id} = undef; - $self->{event} = undef; - $self->{environment} = undef; - return $self; -} - -sub target { - my $self = shift; - return undef unless (ref $self); - - my $t = shift; - $self->{target} = $t if (defined $t); - return $self->{target}; -} - -sub standalone { - my $self = shift; - return undef unless (ref $self); - - my $t = shift; - $self->{standalone} = $t if (defined $t); - return $self->{standalone}; -} - -sub update_state { - my $self = shift; - return undef unless ($self && ref $self); - - my $state = shift; - return undef unless ($state); - - my $fields = shift; - - if ($self->standalone) { - $self->editor->xact_begin || return undef; - } - - my $e = $self->editor->retrieve_action_trigger_event( $self->id ); - if (!$e) { - $log->error( "Could not retrieve object ".$self->id." for update" ) if (!$e); - return undef; - } - - if ($fields && ref($fields)) { - $e->$_($$fields{$_}) for (keys %$fields); - } - - $log->info( "Retrieved object ".$self->id." for update" ); - $e->start_time( 'now' ) unless $e->start_time; - $e->update_time( 'now' ); - $e->update_process( $$ ); - $e->state( $state ); - - $e->clear_start_time() if ($e->state eq 'pending'); - $e->complete_time( 'now' ) if ($e->state eq 'complete'); - - my $ok = $self->editor->update_action_trigger_event( $e ); - if (!$ok) { - $self->editor->xact_rollback if ($self->standalone); - $log->error( "Update of event ".$self->id." failed" ); - return undef; - } else { - $e = $self->editor->data; - $e = $self->editor->retrieve_action_trigger_event( $e ) if (!ref($e)); - if (!$e) { - $log->error( "Update of event ".$self->id." did not return an object" ); - return undef; - } - $log->info( "Update of event ".$e->id." suceeded" ); - $ok = $self->editor->xact_commit if ($self->standalone); - } - - if ($ok) { - $self->event->start_time( $e->start_time ); - $self->event->update_time( $e->update_time ); - $self->event->update_process( $e->update_process ); - $self->event->state( $e->state ); - } - - return $ok || undef; -} - -my $current_environment; - -sub build_environment { - my $self = shift; - return $self if ($self->environment->{complete}); - - $self->update_state( 'collecting') || die 'Unable to update event state'; - - try { - - my $compartment = new Safe; - $compartment->permit(':default','require','dofile','caller'); - $compartment->share('$current_environment'); - - $self->environment->{EventProcessor} = $self; - $self->environment->{target} = $self->target; - $self->environment->{event} = $self->event; - $self->environment->{template} = $self->event->event_def->template; - $self->environment->{user_data} = $self->user_data; - - $current_environment = $self->environment; - - $self->environment->{params}{ $_->param } = $compartment->reval($_->value) for ( @{$self->event->event_def->params} ); - - for my $e ( @{$self->event->event_def->env} ) { - my (@label, @path); - @path = split(/\./, $e->path) if ($e->path); - @label = split(/\./, $e->label) if ($e->label); - - $self->_object_by_path( $self->target, $e->collector, \@label, \@path ); - } - - if ($self->event->event_def->group_field) { - my @group_path = split(/\./, $self->event->event_def->group_field); - pop(@group_path); # the last part is a field, should not get fleshed - my $group_object = $self->_object_by_path( $self->target, undef, [], \@group_path ) if (@group_path); - } - - $self->environment->{complete} = 1; - } otherwise { - $log->error( shift() ); - $self->update_state( 'error' ) || die 'Unable to update event state'; - }; - - if ($self->environment->{complete}) { - $self->update_state( 'collected' ) || die 'Unable to update event state'; - } else { - $self->update_state( 'error' ) || die 'Unable to update event state'; - } - - return $self; -} - -sub _fm_class_by_hint { - my $self = shift; - my $hint = shift; - - my ($class) = grep { - Fieldmapper->publish_fieldmapper->{$_}->{hint} eq $hint - } keys %{ Fieldmapper->publish_fieldmapper }; - - return $class; -} - -my %_object_by_path_cache = (); -sub ClearObjectCache { - for my $did ( keys %_object_by_path_cache ) { - my $phash = $_object_by_path_cache{$did}; - for my $path ( keys %$phash ) { - my $shash = $$phash{$path}; - for my $step ( keys %$shash ) { - my $fhash = $$shash{$step}; - for my $ffield ( keys %$fhash ) { - my $lhash = $$fhash{$ffield}; - for my $lfield ( keys %$lhash ) { - delete $$lhash{$lfield}; - } - delete $$fhash{$ffield}; - } - delete $$shash{$step}; - } - delete $$phash{$path}; - } - delete $_object_by_path_cache{$did}; - } -} - -sub _object_by_path { - my $self = shift; - my $context = shift; - my $collector = shift; - my $label = shift; - my $path = shift; - my $ed = shift; - my $red = shift; - - my $outer = 0; - if (!$ed) { - $ed = new_editor(xact=>1); - $outer = 1; - } - - my $step = shift(@$path); - - my $fhint = Fieldmapper->publish_fieldmapper->{$context->class_name}{links}{$step}{class}; - my $fclass = $self->_fm_class_by_hint( $fhint ); - - OpenSRF::EX::ERROR->throw( - "$step is not a field on ".$context->class_name." Please repair the environment.") - unless $fhint; - - my $ffield = Fieldmapper->publish_fieldmapper->{$context->class_name}{links}{$step}{key}; - my $rtype = Fieldmapper->publish_fieldmapper->{$context->class_name}{links}{$step}{reltype}; - - my $meth = 'retrieve_'; - my $multi = 0; - my $lfield = $step; - if ($rtype ne 'has_a') { - $meth = 'search_'; - $multi = 1; - $lfield = $context->Identity; - } - - $meth .= $fclass; - $meth =~ s/Fieldmapper:://; - $meth =~ s/::/_/g; - - my $obj = $context->$step(); - - $logger->debug( - sprintf "_object_by_path(): meth=%s, obj=%s, multi=%s, step=%s, lfield=%s", - map {defined($_)? $_ : ''} ($meth, $obj, $multi, $step, $lfield) - ); - - if (!ref $obj) { - - my $lval = $context->$lfield(); - - if(defined $lval) { - - my $def_id = $self->event->event_def->id; - my $str_path = join('.', @$path); - - $obj = $_object_by_path_cache{$def_id}{$str_path}{$step}{$ffield}{$lval} || - ( - (grep /cstore/, @{ - Fieldmapper->publish_fieldmapper->{$fclass}{controller} - }) ? $ed : ($red ||= new_rstore_editor(xact=>1)) - )->$meth( ($multi) ? { $ffield => $lval } : $lval); - - $_object_by_path_cache{$def_id}{$str_path}{$step}{$ffield}{$lval} ||= $obj; - } - } - - if (@$path) { - - my $obj_list = []; - if (!$multi) { - $obj_list = [$obj] if ($obj); - } else { - $obj_list = $obj; - } - - for (@$obj_list) { - my @path_clone = @$path; - $self->_object_by_path( $_, $collector, $label, \@path_clone, $ed, $red ); - } - - $obj = $$obj_list[0] if (!$multi || $rtype eq 'might_have'); - $context->$step( $obj ) if ($obj && (!$label || !@$label)); - - } else { - - if ($collector) { - my $obj_list = [$obj] if ($obj && !$multi); - $obj_list = $obj if ($multi); - - my @new_obj_list; - for my $o ( @$obj_list ) { - push @new_obj_list, - OpenILS::Application::Trigger::ModRunner::Collector - ->new( $collector, $o ) - ->run - ->final_result - } - - if (!$multi) { - $obj = $new_obj_list[0]; - } else { - $obj = \@new_obj_list; - } - } - - if ($label && @$label) { - my $node = $self->environment; - my $i = 0; my $max = scalar(@$label); - for (; $i < $max; $i++) { - my $part = $$label[$i]; - $$node{$part} ||= {}; - $node = $$node{$part}; - } - $$node{$$label[-1]} = $obj; - } else { - $obj = $$obj[0] if $rtype eq 'might_have'; - $context->$step( $obj ) if ($obj); - } - } - - if ($outer) { - $ed->rollback; - $red->rollback if $red; - } - return $obj; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/EventGroup.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/EventGroup.pm deleted file mode 100644 index 2a3c6c632c..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/EventGroup.pm +++ /dev/null @@ -1,270 +0,0 @@ -package OpenILS::Application::Trigger::EventGroup; -use strict; use warnings; -use OpenILS::Application::Trigger::Event; -use base 'OpenILS::Application::Trigger::Event'; -use OpenSRF::EX qw/:try/; - -use OpenSRF::Utils::Logger qw/$logger/; - -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Application::Trigger::ModRunner; - -my $log = 'OpenSRF::Utils::Logger'; - -sub new { - my $class = shift; - my @ids = @_; - $class = ref($class) || $class; - - my $editor = new_editor(xact=>1); - - my $self = bless { - environment => {}, - events => [ - map { - ref($_) ? - do { $_->standalone(0); $_->editor($editor); $_ } : - OpenILS::Application::Trigger::Event->new($_, $editor) - } @ids - ], - ids => [ map { ref($_) ? $_->id : $_ } @ids ], - editor => $editor - } => $class; - - - $self->editor->xact_commit; # flush out those updates - $self->editor->xact_begin; - - return $self; -} - -sub react { - my $self = shift; - - return $self if (defined $self->reacted); - - if ($self->valid) { - $self->update_state( 'reacting') || die 'Unable to update event group state'; - $self->build_environment; - - try { - $self->reacted( - OpenILS::Application::Trigger::ModRunner::Reactor - ->new( $self->event->event_def->reactor, $self->environment ) - ->run - ->final_result - ); - } otherwise { - $log->error("Event reacting failed with ". shift() ); - $self->update_state( 'error' ) || die 'Unable to update event group state'; - }; - - if (defined $self->reacted) { - $self->update_state( 'reacted' ) || die 'Unable to update event group state'; - } else { - $self->update_state( 'error' ) || die 'Unable to update event group state'; - } - } else { - $self->{reacted} = undef; - } - return $self; -} - -sub validate { - my $self = shift; - - return $self if (defined $self->valid); - - $self->update_state( 'validating') || die 'Unable to update event group state'; - $self->editor->xact_begin; - - my @valid_events; - try { - for my $event ( @{ $self->events } ) { - $event->validate; - push @valid_events, $event if ($event->valid); - } - $self->valid(1) if (@valid_events); - $self->{events} = \@valid_events; - $self->{ids} = [ map { $_->id } @valid_events ]; - $self->editor->xact_commit; - } otherwise { - $log->error("Event group validation failed with ". shift() ); - $self->editor->xact_rollback; - $self->update_state( 'error' ) || die 'Unable to update event group state'; - }; - - return $self; -} - -sub cleanedup { - my $self = shift; - return undef unless (ref $self); - - my $c = shift; - $self->{cleanedup} = $c if (defined $c); - return $self->{cleanedup}; -} - -sub reacted { - my $self = shift; - return undef unless (ref $self); - - my $r = shift; - $self->{reacted} = $r if (defined $r); - return $self->{reacted}; -} - -sub valid { - my $self = shift; - return undef unless (ref $self); - - my $v = shift; - $self->{valid} = $v if (defined $v); - return $self->{valid}; -} - -sub event { - my $self = shift; - return undef unless (ref $self); - - return $self->{events}[0]->event; -} - -sub events { - my $self = shift; - return undef unless (ref $self); - - return $self->{events}; -} - -sub ids { - my $self = shift; - return undef unless (ref $self); - - return $self->{ids}; -} - -sub environment { - my $self = shift; - return undef unless (ref $self); - - my $e = shift; - $self->{environment} = $e if (defined $e); - return $self->{environment}; -} - -sub editor { - my $self = shift; - return undef unless (ref $self); - - my $e = shift; - $self->{editor} = $e if (defined $e); - return $self->{editor}; -} - -sub unfind { - my $self = shift; - return undef unless (ref $self); - - die 'Cannot unfind a reacted event group' if (defined $self->reacted); - - $self->update_state( 'pending' ) || die 'Unable to update event group state'; - $self->{events} = undef; - return $self; -} - -sub update_state { - my $self = shift; - return undef unless ($self && ref $self); - - my $state = shift; - return undef unless ($state); - - my $fields = shift; - - $self->editor->xact_begin || return undef; - - my @oks; - my $ok; - my $last_updated; - for my $event ( @{ $self->events } ) { - my $e = $self->editor->retrieve_action_trigger_event( $event->id ); - $e->start_time( 'now' ) unless $e->start_time; - $e->update_time( 'now' ); - $e->update_process( $$ ); - $e->state( $state ); - - $e->clear_start_time() if ($e->state eq 'pending'); - - if ($fields && ref($fields)) { - $e->$_($$fields{$_}) for (keys %$fields); - } - - my $ok = $self->editor->update_action_trigger_event( $e ); - if ($ok) { - push @oks, $ok; - $last_updated = $e->id; - } - } - - if (scalar(@oks) < scalar(@{ $self->ids })) { - $self->editor->xact_rollback; - return undef; - } - - my $updated = $self->editor->retrieve_action_trigger_event($last_updated); - $ok = $self->editor->xact_commit; - - if ($ok) { - for my $event ( @{ $self->events } ) { - my $e = $event->event; - $e->start_time( $updated->start_time ); - $e->update_time( $updated->update_time ); - $e->update_process( $updated->update_process ); - $e->state( $updated->state ); - } - } - - return $ok || undef; -} - -sub findEvent { - my $self = shift; - my $member = shift; - - $member = $member->id if (ref($member)); - - my @list = grep { $member == $_->id } @{ $self->events }; - - return shift(@list); -} - -sub build_environment { - my $self = shift; - my $env = $self->environment; - - $$env{EventProcessor} = $self; - $$env{target} = []; - $$env{event} = []; - $$env{user_data} = []; - for my $e ( @{ $self->events } ) { - for my $env_part ( keys %{ $e->environment } ) { - next if ($env_part eq 'EventProcessor'); - if ($env_part eq 'target') { - push @{ $$env{target} }, $e->environment->{target}; - } elsif ($env_part eq 'event') { - push @{ $$env{event} }, $e->environment->{event}; - } elsif ($env_part eq 'user_data') { - push @{ $$env{user_data} }, $e->environment->{user_data}; - } else { - $$env{$env_part} = $e->environment->{$env_part}; - } - } - } - - return $self; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/ModRunner.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/ModRunner.pm deleted file mode 100644 index 747da7abc1..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/ModRunner.pm +++ /dev/null @@ -1,239 +0,0 @@ -package OpenILS::Application::Trigger::ModLoader; -use strict; use warnings; -use UNIVERSAL::require; - -sub prefix { return 'OpenILS::Application::Trigger' } - -sub new { - my $class = shift; - $class = ref($class) || $class; - - my $mod = shift; - return undef unless ($mod); - - my $self = bless { - module => ref $mod ? $mod->module() : $mod, - handler => 'handler' - } => $class; - - return $self->load; -} - -sub loaded { - my $self = shift; - return undef unless (ref $self); - - my $l = shift; - $self->{loaded} = $l if (defined $l); - return $self->{loaded}; -} - -sub handler { - my $self = shift; - return undef unless (ref $self); - - my $h = shift; - $self->{handler} = $h if $h; - return $self->{handler}; -} - -sub module { - my $self = shift; - return undef unless (ref $self); - - my $m = shift; - $self->{module} = $m if $m; - return $self->{module}; -} - -sub load { - my $self = shift; - return undef unless (ref $self); - - my $m = shift || $self->module; - my $h = shift || $self->handler; - return 1 unless $m; - - my $loaded = $m->use; - - if (!$loaded) { - my $builtin_m = $self->prefix . "::$m"; - $loaded = $builtin_m->use; - - if (!$loaded) { - if ($m =~ /::/o) { - ($h = $m) =~ s/^.+::([^:]+)$/$1/o; - $m =~ s/^(.+)::[^:]+$/$1/o; - - $loaded = $m->use; - - if (!$loaded) { - $h = $self->handler; - $builtin_m = $self->prefix . "::$m"; - $loaded = $m->use; - - $m = $builtin_m if ($loaded); - } - } else { - $loaded = $m->use; - - # The following is an escape hatch for builtin dummy handlers - if (!$loaded) { - $loaded = $self->prefix->use; - if ($loaded && $self->prefix->can( $self->module ) ) { - $m = $self->prefix; - $h = $self->module; - } - } - } - } else { - $m = $builtin_m; - } - } - - if ($loaded) { - $self->module( $m ); - $self->handler( $h ); - } - - $self->loaded($loaded); - return $self; -} - -package OpenILS::Application::Trigger::ModRunner; -use base 'OpenILS::Application::Trigger::ModLoader'; - -sub new { - my $class = shift; - $class = ref($class) || $class; - - my $m = shift; - my $e = shift || {}; - - my $self = $class->SUPER::new( $m ); - return undef unless ($self && $self->loaded); - - $self->environment( $e ); - return $self; -} - -sub pass { - my $old = shift; - return undef unless (ref $old); - - my $class = ref($old); - my $m = shift; - - my $self = $class->SUPER::new( $m ); - return undef unless ($self && $self->loaded); - - $self->environment( $old->environment ); - return $self; -} - -sub environment { - my $self = shift; - return undef unless (ref $self); - - my $e = shift; - $self->{environment} = $e if (defined $e); - return $self->{environment}; -} - -sub final_result { - my $self = shift; - return undef unless (ref $self); - - my $r = shift; - $self->{final_result} = $r if (defined $r); - return $self->{final_result}; -} - -sub run { - my $self = shift; - return undef unless (ref $self && $self->loaded); - - $self->environment( shift ); - - my $m = $self->module; - my $h = $self->handler; - my $e = $self->environment; - $self->final_result( $m->$h( $e ) ); - - return $self; -}; - -package OpenILS::Application::Trigger::ModRunner::Collector; -use base 'OpenILS::Application::Trigger::ModRunner'; -sub prefix { return 'OpenILS::Application::Trigger::Collector' } - -package OpenILS::Application::Trigger::ModRunner::Validator; -use base 'OpenILS::Application::Trigger::ModRunner'; -sub prefix { return 'OpenILS::Application::Trigger::Validator' } - -package OpenILS::Application::Trigger::ModRunner::Reactor; -use base 'OpenILS::Application::Trigger::ModRunner'; -sub prefix { return 'OpenILS::Application::Trigger::Reactor' } - -package OpenILS::Application::Trigger::ModRunner::Cleanup; -use base 'OpenILS::Application::Trigger::ModRunner'; -sub prefix { return 'OpenILS::Application::Trigger::Cleanup' } - -package OpenILS::Application::Trigger::ModStackRunner; -use base 'OpenILS::Application::Trigger::ModRunner'; - -sub new { - my $class = shift; - $class = ref($class) || $class; - - my $m = shift; - $m = [$m] unless (ref($m) =~ /ARRAY/o); - - my $e = shift || {}; - - my $self = bless { - runners => [] - } => $class; - - for my $mod ( @$m ) { - my $r = $self->SUPER::new( $m ); - return undef unless ($r && $r->loaded); - push @{$self->{runners}}, $r; - } - - $self->loaded(1); - - return $self; -} - -sub pass { - my $old = shift; - return undef unless (ref $old); - - my $class = ref($old); - my $m = shift; - - my $self = $class->new( $m ); - return undef unless ($self && $self->loaded); - - $self->environment( $old->environment ); - return $self; -} - -sub run { - my $self = shift; - return undef unless (ref $self && $self->loaded); - - $self->environment( shift ); - my $e = $self->environment; - - for my $r (@{$self->{runners}}) { - my $m = $r->module; - my $h = $r->handler; - $r->final_result( $m->$h( $e ) ); - } - - return $self; -}; - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor.pm deleted file mode 100644 index 4be542b0d6..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor.pm +++ /dev/null @@ -1,183 +0,0 @@ -package OpenILS::Application::Trigger::Reactor; -use strict; use warnings; -use Template; -use DateTime; -use DateTime::Format::ISO8601; -use Unicode::Normalize; -use OpenSRF::Utils qw/:datetime/; -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Application::AppUtils; -use OpenILS::Utils::CStoreEditor qw/:funcs/; -my $U = 'OpenILS::Application::AppUtils'; - -sub fourty_two { return 42 } -sub NOOP_True { return 1 } -sub NOOP_False { return 0 } - - - -# helper functions inserted into the TT environment -my $_TT_helpers = { - - # turns a date into something TT can understand - format_date => sub { - my $date = shift; - $date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($date)); - return sprintf( - "%0.2d:%0.2d:%0.2d %0.2d-%0.2d-%0.4d", - $date->hour, - $date->minute, - $date->second, - $date->day, - $date->month, - $date->year - ); - }, - - # escapes a string for inclusion in an XML document. escapes &, <, and > characters - escape_xml => sub { - my $str = shift; - $str =~ s/&/&/sog; - $str =~ s//>/sog; - return $str; - }, - - escape_json => sub { - my $str = shift; - $str =~ s/([\x{0080}-\x{fffd}])/sprintf('\u%0.4x',ord($1))/sgoe; - return $str; - }, - - # strip non-ASCII characters after splitting base characters and diacritics - # least common denominator for EDIFACT messages using the UNOB character set - force_jedi_unob => sub { - my $str = shift; - $str = NFD($str); - $str =~ s/[\x{0080}-\x{fffd}]//g; - return $str; - }, - - # returns the calculated user locale - get_user_locale => sub { - my $user_id = shift; - return $U->get_user_locale($user_id); - }, - - # returns the calculated copy price - get_copy_price => sub { - my $copy_id = shift; - return $U->get_copy_price(new_editor(xact=>1), $copy_id); - }, - - # given a copy, returns the title and author in a hash - get_copy_bib_basics => sub { - my $copy_id = shift; - my $copy = new_editor(xact=>1)->retrieve_asset_copy([ - $copy_id, - { - flesh => 2, - flesh_fields => { - acp => ['call_number'], - acn => ['record'] - } - } - ]); - if($copy->call_number->id == -1) { - return { - title => $copy->dummy_title, - author => $copy->dummy_author, - }; - } else { - my $mvr = $U->record_to_mvr($copy->call_number->record); - return { - title => $mvr->title, - author => $mvr->author - }; - } - }, - - # returns the org unit setting value - get_org_setting => sub { - my($org_id, $setting) = @_; - return $U->ou_ancestor_setting_value($org_id, $setting); - }, - - # This basically greps/maps out ths isbn string values, but also promotes the first isbn-13 to the - # front of the line (so that the EDI translator takes it as primary) if there is one. - get_li_isbns => sub { - my $attrs = shift; - my @isbns; - my $primary; - foreach (@$attrs) { - $_->attr_name eq 'isbn' or next; - my $val = $_->attr_value; - if (! $primary and length($val) == 13) { - $primary = $val; - } else { - push @isbns, $val; - } - } - $primary and unshift @isbns, $primary; - $logger->debug("get_li_isbns returning isbns: " . join(', ', @isbns)); - return @isbns; - }, - - # helpers.get_li_attr('isbn_13', li.attributes) - # returns matching line item attribute, or undef - get_li_attr => sub { - my $name = shift or return; # the first arg is always the name - my ($type, $attr) = (scalar(@_) == 1) ? (undef, $_[0]) : @_; - # if the next is the last, it's the attributes, otherwise type - # use Data::Dumper; $logger->warn("get_li_attr: " . Dumper($attr)); - ($name and @$attr) or return; - my $length; - $name =~ s/^(\D+)_(\d+)$/$1/ and $length = $2; - foreach (@$attr) { - $_->attr_name eq $name or next; - next if $length and $length != length($_->attr_value); - return $_->attr_value if (! $type) or $type eq $_->attr_type; - } - return; - }, -}; - - -# processes templates. Returns template output on success, undef on error -sub run_TT { - my $self = shift; - my $env = shift; - my $nostore = shift; - return undef unless $env->{template}; - - my $error; - my $output = ''; - my $tt = Template->new; - # my $tt = Template->new(ENCODING => 'utf8'); # ?? - $env->{helpers} = $_TT_helpers; - - unless( $tt->process(\$env->{template}, $env, \$output) ) { - $output = undef; - ($error = $tt->error) =~ s/\n/ /og; - $logger->error("Error processing Trigger template: $error"); - } - - if ( $error or (!$nostore && $output) ) { - my $t_o = Fieldmapper::action_trigger::event_output->new; - $t_o->data( ($error) ? $error : $output ); - $t_o->is_error( ($error) ? 't' : 'f' ); - $logger->info("trigger: writing " . length($t_o->data) . " bytes to template output"); - - $env->{EventProcessor}->editor->xact_begin; - $t_o = $env->{EventProcessor}->editor->create_action_trigger_event_output( $t_o ); - - my $state = (ref $$env{event} eq 'ARRAY') ? $$env{event}->[0]->state : $env->{event}->state; - my $key = ($error) ? 'error_output' : 'template_output'; - $env->{EventProcessor}->update_state( $state, { $key => $t_o->id } ); - } - - return $output; -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/ApplyCircFee.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/ApplyCircFee.pm deleted file mode 100644 index 1574b2bdee..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/ApplyCircFee.pm +++ /dev/null @@ -1,56 +0,0 @@ -package OpenILS::Application::Trigger::Reactor::ApplyCircFee; -use base 'OpenILS::Application::Trigger::Reactor'; -use strict; use warnings; -use Error qw/:try/; -use OpenILS::Const qw/:const/; -use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::Logger qw/:logger/; -use OpenILS::Utils::CStoreEditor q/:funcs/; - - -sub ABOUT { - return < 1); - my $btype = $e->retrieve_config_billing_type(OILS_BILLING_TYPE_NOTIFICATION_FEE); - - my $circ = $$env{target}; - my $amount = $$env{params}{amount} || $btype->default_price; - - unless($amount) { - $logger->error("ApplyCircFee needs a fee amount"); - $e->rollback; - return 0; - } - - my $bill = Fieldmapper::money::billing->new; - $bill->xact($circ->id); - $bill->amount($amount); - $bill->btype(OILS_BILLING_TYPE_NOTIFICATION_FEE); - $bill->billing_type($btype->name); - $bill->note($self->run_TT($env)); - - unless( $e->create_money_billing($bill) ) { - $e->rollback; - return 0; - } - - $e->commit; - return 1; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/ApplyPatronPenalty.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/ApplyPatronPenalty.pm deleted file mode 100644 index 33e624e595..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/ApplyPatronPenalty.pm +++ /dev/null @@ -1,74 +0,0 @@ -package OpenILS::Application::Trigger::Reactor::ApplyPatronPenalty; -use base 'OpenILS::Application::Trigger::Reactor'; -use strict; use warnings; -use Error qw/:try/; -use OpenILS::Const qw/:const/; -use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::Logger qw/$logger/; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Application::AppUtils; -my $U = "OpenILS::Application::AppUtils"; - - -sub ABOUT { - return <error("ApplyPatronPenalty: missing parameters"); - return 0; - } - - my $e = new_editor(xact => 1); - - my $ptype = $e->search_config_standing_penalty({name => $pname})->[0]; - - unless($ptype) { - $logger->error("ApplyPatronPenalty: invalid penalty name '$pname'"); - $e->rollback; - return 0; - } - - $context_org = (defined $ptype->org_depth) ? - $U->org_unit_ancestor_at_depth($context_org->id, $ptype->org_depth) : - $context_org->id; - - # apply the penalty - my $penalty = Fieldmapper::actor::usr_standing_penalty->new; - $penalty->usr($user->id); - $penalty->org_unit($context_org); - $penalty->standing_penalty($ptype->id); - $penalty->note($self->run_TT($env)); - - unless($e->create_actor_user_standing_penalty($penalty)) { - $e->rollback; - return 0; - } - - $e->commit; - return 1; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/AstCall.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/AstCall.pm deleted file mode 100644 index e664da6320..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/AstCall.pm +++ /dev/null @@ -1,360 +0,0 @@ -package OpenILS::Application::Trigger::Reactor::AstCall; -use base 'OpenILS::Application::Trigger::Reactor'; -use OpenSRF::Utils::Logger qw($logger); -# use OpenILS::Application::AppUtils; -use OpenILS::Utils::CStoreEditor qw/:funcs/; - -use strict; use warnings; -use Error qw/:try/; -use Data::Dumper; - -use OpenSRF::Utils::SettingsClient; -use RPC::XML::Client; -$Data::Dumper::Indent = 0; - -my $U = 'OpenILS::Application::AppUtils'; - -my $e = new_editor(xact => 1); - -# $last_channel_used is: -# ~ index (not literal value) of last channel used in a callfile -# ~ index is of position in @channels (zero-based) -# ~ cached at package level -# ~ typically for Zap (PSTN), not VOIP - -our @channels; -our $last_channel_used = 0; -our $telephony; - -sub ABOUT { - return <info(__PACKAGE__ . ": get_conf()"); - $telephony and return $telephony; - my $config = OpenSRF::Utils::SettingsClient->new; - # config object cached by package - $telephony = $config->config_value('notifications', 'telephony'); - return $telephony; -} - -sub get_channels { - @channels and return @channels; - my $config = get_conf(); # populated $telephony object - @channels = @{ $config->{channels} }; - return @channels; -} - -sub next_channel { - # Increments $last_channel_used, or resets it to zero, as necessary. - # Returns appropriate value from channels array. - my @chans = get_channels(); - unless(@chans) { - $logger->error(__PACKAGE__ . ": Cannot build call using " . - (shift ||'driver') . - ", no notifications.telephony.channels found in config!"); - return; - } - if (++$last_channel_used > $#chans) { - $last_channel_used = 0; - } - return $chans[$last_channel_used]; # say, 'Zap/1' or 'Zap/12' -} - -sub channel { - my $tech = get_conf()->{driver} || 'SIP'; - if ($tech !~ /^SIP/) { - return next_channel($tech); - } - return $tech; # say, 'SIP' or 'SIP/ubab33' -} - -sub get_extra_lines { - my $lines = get_conf()->{callfile_lines} or return ''; - my @fixed; - foreach (split "\n", $lines) { - s/^\s*//g; # strip leading spaces - /\S/ or next; # skip empty lines - push @fixed, $_; - } - (scalar @fixed) or return ''; - return join("\n", @fixed) . "\n"; -} - -sub host_string { - my $conf = get_conf(); - my $host = $conf->{host}; - unless ($host) { - $logger->error(__PACKAGE__ . ": No telephony/host in config."); - return; - } - - # prepend http:// if no protocol specified - $host =~ /^\S+:\/\// or $host = 'http://' . $host; - # append port number if specified - $conf->{port} and $host .= ":" . $conf->{port}; - - return $host; -} -sub rpc_client { - # TODO: caching? (would take testing to ensure memory and - # connections are clean/stable) - my $host = (@_ ? shift : host_string()) or return; - return new RPC::XML::Client($host); -} - -sub handler { - my ($self, $env) = @_; - - $logger->info(__PACKAGE__ . ": entered handler"); - - # assignment, not comparison - unless ($env->{channel_prefix} = channel()) { - $logger->error(__PACKAGE__ . ": Cannot find tech/resource in config"); - return 0; - } - - $env->{extra_lines} = get_extra_lines() || ''; - my $tmpl_output = $self->run_TT($env); - if (not $tmpl_output) { - $logger->error(__PACKAGE__ . ": no template input"); - return 0; - } - - my @eventids = map {$_->id} @{$env->{event}}; - @eventids or push @eventids, ''; - - my $eo = Fieldmapper::action_trigger::event_output->new; - - # XXX we have to actually create this in the DB now if we expect to use the - # ID later - $eo->data(""); - $eo = $e->create_action_trigger_event_output($eo) or return $e->die_event; - if ($env->{"extra_lines"}) { - $tmpl_output .= ";; added by handler:\n"; - $tmpl_output .= $env->{"extra_lines"}; - } - - # or would we prefer distinct lines instead of comma-separated? - $tmpl_output .= "; event_ids = " . join(",",@eventids) . "\n"; - $tmpl_output .= "; event_output = " . $eo->id . "\n"; - - #my $filename_fragment = $userid . '_' . $eventids[0] . 'uniq' . time; - # not $noticetype, - # the event_output.id tells us all we need to know - # XXX why is id in here twice? - my $filename_fragment = $eo->id . '_' . $eo->id; - - # TODO: add scheduling intelligence and use it here... or not if - # relying only on crontab - my $client = rpc_client(); - my $resp = $client->send_request( - 'inject', $tmpl_output, $filename_fragment, 0 - ); # FIXME: 0 could be seconds-from-epoch UTC if deferred call needed - - $logger->debug( - ref $resp ? ("Response: " . Dumper($resp->value)) : "Error: $resp" - ); - - if ($resp->{code} and $resp->{code}->value == 200) { - $eo->is_error('f'); - $eo->data('filename: ' . $resp->{spooled_filename}->value); - # could look for the file that replaced it - } else { - $eo->is_error('t'); - my $msg = $resp->{faultcode} ? $resp->{faultcode}->value : - $resp->{ code} ? $resp->{ code}->value : - " -- UNKNOWN response '$resp'"; - $msg .= " for $filename_fragment"; - $eo->data("Error " . $msg); - $logger->error(__PACKAGE__ . ": Mediator Error " . $msg); - } - - # Now point all our events' async_output to the newly made row -# $eo = $env->{EventProcessor}->editor-> -# create_action_trigger_event_output( $eo ); - $e->update_action_trigger_event_output($eo) or return $e->die_event; - foreach (@eventids) { - my $event = $e->retrieve_action_trigger_event($_); - $event->async_output($eo->id); - $e->update_action_trigger_event($event); - } - $e->commit; # defer till after loop? - - # TODO: a sub for saving async_output might belong in Trigger.pm - 1; -} - -sub _files { - my $response = shift or return; - return map {$response->{$_}} sort grep {/^file_\d*/} keys %$response; -} - -=head1 EXAMPLE CALFILES - -Note: all lines start flush left (no leading whitespace) - -=head2 Example callfile (successful) - - Channel: SIP/ubab33/17707775555 - Context: overdue-test - MaxRetries: 1 - RetryTime: 60 - WaitTime: 30 - Extension: 10 - Archive: 1 - Set: items=1 - Set: titlestring=chez nos gens;; added by OpenILS::Application::Trigger::Reactor::AstCall handler: - ; event_ids = 123,145 - ; event_output = 14;; added by inject() in the mediator - Set: callfilename=EG_1258060382_6.call - - StartRetry: 2139 1 (1258060442) - Status: Completed - Channel: SIP/ubab33/17707775555 - -=head2 Example callfile (FAILED) - - CallerID: "Jack Jackson" <17707775555> - Context: overdue-test - MaxRetries: 1 - RetryTime: 60 - WaitTime: 30 - Extension: 10 - Archive: 1 - Set: items=1 - Set: titlestring=Land Before Time;; added by OpenILS::Application::Trigger::Reactor::AstCall handler: - Set: LOOP=1 - Set: callfilename=EG_joe_20091109145355.call - - StartRetry: 2139 1 (1257907526) - ; FAILED: 0 - - EndRetry: 2139 1 (1257907496) - - StartRetry: 2139 2 (1257907617) - ; FAILED: 0 - Status: Expired - -=head2 Possible data structure: - - $feedback = { - status => val, - attempts => [ $attempt1, $attempt2 ... $attemptN ], - anything_else => scalar, - } - ... - $attempt = { - time => secs from epoch (UTC) for the BEGINNING of the call, - duration => secs, - failed => code, - } - -=cut - -sub feedback_hash { - # parses the done callfile comments from Mediator - # return ref to hash - my $content = shift or return; - my %hash = (); - # my @attempts = (); - my @lines = split "\n", $content; - foreach (shift @lines) { - s/^\s*(Set:\s*)?//i; # strip leading whitespace, and possible "Set:" - if (/^StartRetry: \d+ (\d+) \((\d+)\)/) { - # go parse an attempt; - # go record an attempt; - } - if (/^(Status):\s*(\S+)/i or /^;+\s*(FAILED):\s*(\S*)/i) { - $hash{lc $1} = $2; - next; - } - - /^;+\s*(\S+)\s*[=:]\s*([^;]*)$/ and $hash{lc $1} = $2; - } - if (exists $hash{failed}) { - $hash{failcode} = $hash{failed}; - # b/c "0" is a common failcode and we want a more binary indicator - $hash{failed} = 1; - } - return \%hash; -} - -sub cleanup { - my $self = shift or return; - my $files = join(',',@_) or return; - my $client = rpc_client(); - return $client->send_request('cleanup', $files); - # TODO: more error checking -} - -sub retrieve { - my $self = shift or return; - my $client = rpc_client(); - my $resp = $client->send_request('retrieve'); - unless ($resp and ref $resp) { - $logger->error( - __PACKAGE__ . ": Mediator Error: " . - ($resp ? 'Bad' : 'No') . " response to retrieve request" - ); - return; - } - - # my $count = $resp{match_count}; # how many files we should have - # my @rm_list = (); - my @files = _files($resp); - foreach (@files) { - my $content = $resp->{$_}->content; - my $filename = $resp->{$_}->filename; - unless ($content) { - $logger->error(__PACKAGE__ . - ": Mediator sent incomplete/unintelligible message for " . - "filename " . ($filename || 'UNKNOWN')); - next; - } - my $feedback = feedback_hash($content); - my $output = $e->retrieve_action_trigger_event_output( - $feedback->{event_output} - ); - if ($content == $output->data) { - $logger->error( - __PACKAGE__ . ": Mediator sent duplicate file " - . $resp->{$_}->filename . " for event_output " . - $feedback->{event_output} - ); - } else { - $output->data($content); - } - $e->commit; # defer until after loop? probably not - my $clean = $client->send_request('cleanup', $filename); - # TODO: deletion by (comma-separated) filenames in chunks - # instead of individually? - # push @rm_list, $_; $client->send_request('cleanup', join(',',@rm_list)); - unless ($clean and ref $clean) { - $logger->error( - __PACKAGE__ . ": Mediator Error: " . - ($clean ? 'Bad' : 'No') . - " response to cleanup $filename request"); - next; - } - unless ($clean->{code}->value == 200 and $clean->{delete_count}) { - $logger->error(__PACKAGE__ . ": cleanup $filename returned " . ( - $resp->{faultcode} ? $resp->{faultcode}->value : - $resp->{ code} ? $resp->{ code}->value : - " -- UNKNOWN response '$resp'" - ) . " with delete_count " . - (defined $clean->{delete_count} ? $clean->{delete_count} : 'UNDEF')); - } - } - return @files; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/GeneratePurchaseOrderJEDI.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/GeneratePurchaseOrderJEDI.pm deleted file mode 100644 index f7e9fc5433..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/GeneratePurchaseOrderJEDI.pm +++ /dev/null @@ -1,22 +0,0 @@ -package OpenILS::Application::Trigger::Reactor::GeneratePurchaseOrderJEDI; -use base 'OpenILS::Application::Trigger::Reactor'; -use strict; use warnings; -use OpenSRF::Utils::Logger qw/:logger/; - -sub ABOUT { - return <run_TT($env); - return 0; -} - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/MarkItemLost.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/MarkItemLost.pm deleted file mode 100644 index eaba44be53..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/MarkItemLost.pm +++ /dev/null @@ -1,47 +0,0 @@ -package OpenILS::Application::Trigger::Reactor::MarkItemLost; -use base 'OpenILS::Application::Trigger::Reactor'; -use strict; use warnings; -use Error qw/:try/; -use Data::Dumper; -use OpenSRF::Utils::Logger qw/:logger/; -use OpenILS::Utils::CStoreEditor q/:funcs/; -use OpenILS::Application::Cat::AssetCommon; -$Data::Dumper::Indent = 0; - - -sub ABOUT { - return < 1); - $e->requestor($e->retrieve_actor_user($$env{params}{editor})); - - my $circ = $$env{target}; - my $evt = OpenILS::Application::Cat::AssetCommon->set_item_lost($e, $circ->target_copy); - if($evt) { - $logger->error("trigger: MarkItemLost failed with event ".$evt->{textcode}); - return 0; - } - - $e->commit; - - my $ses = OpenSRF::AppSession->create('open-ils.trigger'); - $ses->request('open-ils.trigger.event.autocreate', 'lost.auto', $circ, $circ->circ_lib); - - return 1; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/ProcessTemplate.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/ProcessTemplate.pm deleted file mode 100644 index 34a6b31fc6..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/ProcessTemplate.pm +++ /dev/null @@ -1,23 +0,0 @@ -package OpenILS::Application::Trigger::Reactor::ProcessTemplate; -use base 'OpenILS::Application::Trigger::Reactor'; -use strict; use warnings; -use OpenSRF::Utils::Logger qw/:logger/; - -sub ABOUT { - return <run_TT($env); - return 0; -} - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/SendEmail.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/SendEmail.pm deleted file mode 100644 index 64826fda07..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/SendEmail.pm +++ /dev/null @@ -1,73 +0,0 @@ -package OpenILS::Application::Trigger::Reactor::SendEmail; -use strict; use warnings; -use Error qw/:try/; -use Data::Dumper; -use Email::Send; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Application::Trigger::Reactor; -use OpenSRF::Utils::Logger qw/:logger/; -use utf8; -$Data::Dumper::Indent = 0; - -use base 'OpenILS::Application::Trigger::Reactor'; - -my $log = 'OpenSRF::Utils::Logger'; - -sub ABOUT { - return <new; - my $smtp = $conf->config_value('email_notify', 'smtp_server'); - $$env{default_sender} = $conf->config_value('email_notify', 'sender_address'); - - my $text = $self->run_TT($env); - return 0 if (!$text); - - my $sender = Email::Send->new({mailer => 'SMTP'}); - $sender->mailer_args([Host => $smtp]); - - my $stat; - my $err; - - utf8::encode($text); # prevent "Wide character" errors in Email::Send - - try { - $stat = $sender->send($text); - } catch Error with { - $err = $stat = shift; - $logger->error("SendEmail Reactor: Email failed with error: $err"); - }; - - if( !$err and $stat and $stat->type eq 'success' ) { - $logger->info("SendEmail Reactor: successfully sent email"); - return 1; - } else { - $logger->warn("SendEmail Reactor: unable to send email: ".Dumper($stat)); - $text =~ s/\n//og; - $logger->warn("SendEmail Reactor: failed email template: $text"); - return 0; - } - -} - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/SendFile.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/SendFile.pm deleted file mode 100644 index e3e6a9bf25..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/SendFile.pm +++ /dev/null @@ -1,48 +0,0 @@ -package OpenILS::Application::Trigger::Reactor::SendFile; -use OpenILS::Application::Trigger::Reactor; -use base 'OpenILS::Application::Trigger::Reactor'; - -# use OpenSRF::Utils::SettingsClient; -use OpenILS::Utils::RemoteAccount; - -use strict; -use warnings; - -sub ABOUT { - return <{params}; - - $params->{content} = $self->run_TT($env) or return; - my $connection = OpenILS::Utils::RemoteAccount->new(%$params) or return; - return $connection->put; -} - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/StaticEmail.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/StaticEmail.pm deleted file mode 100644 index 289a4441da..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/StaticEmail.pm +++ /dev/null @@ -1,82 +0,0 @@ -package OpenILS::Application::Trigger::Reactor::StaticEmail; -use strict; use warnings; -use Error qw/:try/; -use Data::Dumper; -use Email::Send; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Application::Trigger::Reactor; -use OpenSRF::Utils::Logger qw/:logger/; - -use base 'OpenILS::Application::Trigger::Reactor'; - -my $log = 'OpenSRF::Utils::Logger'; - -my $default_template = <new; - my $smtp = $conf->config_value('email_notify', 'smtp_server'); - $$env{params}{sender} ||= $conf->config_value('email_notify', 'sender_address'); - $$env{params}{subject} ||= 'Test subject -- StaticEmail Reactor'; - $$env{params}{body} ||= 'Test body -- StaticEmail Reactor'; - $$env{template} ||= $default_template; - - $$env{params}{recipient} or return 0; - - my $text = $self->run_TT($env); - return 0 if (!$text); - - $logger->info("StaticEmail Reactor: sending email to ". - $$env{params}{recipient}." via SMTP server $smtp"); - - my $sender = Email::Send->new({mailer => 'SMTP'}); - $sender->mailer_args([Host => $smtp]); - - - my $stat; - my $err; - - try { - $stat = $sender->send($text); - } catch Error with { - $err = $stat = shift; - $logger->error("StaticEmail Reactor: Email failed with error: $err"); - }; - - if( !$err and $stat and $stat->type eq 'success' ) { - $logger->info("StaticEmail Reactor: successfully sent email"); - return 1; - } else { - $logger->warn("StaticEmail Reactor: unable to send email: ".Dumper($stat)); - return 0; - } - -} - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator.pm deleted file mode 100644 index 260af53def..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator.pm +++ /dev/null @@ -1,94 +0,0 @@ -package OpenILS::Application::Trigger::Validator; -use strict; use warnings; -use DateTime; -use DateTime::Format::ISO8601; -use OpenSRF::Utils qw/:datetime/; -use OpenSRF::Utils::Logger qw/:logger/; -use OpenILS::Const qw/:const/; -sub fourty_two { return 42 } -sub NOOP_True { return 1 } -sub NOOP_False { return 0 } - -sub CircIsOpen { - my $self = shift; - my $env = shift; - - return 0 if (defined($env->{target}->checkin_time)); - - if ($env->{params}->{min_target_age}) { - $env->{params}->{target_age_field} = 'xact_start'; - return 0 if (!$self->MinPassiveTargetAge($env)); - } - - return 1; -} - -sub MinPassiveTargetAge { - my $self = shift; - my $env = shift; - my $target = $env->{target}; - my $delay_field = $env->{params}->{target_age_field} || $env->{event}->event_def->delay_field; - - unless($env->{params}->{min_target_age}) { - $logger->warn("'min_target_age' parameter required for MinPassiveTargetAge validator"); - return 0; # no-op false - } - - unless($delay_field) { - $logger->warn("'target_age_field' parameter or delay_field required for MinPassiveTargetAge validator"); - return 0; # no-op false - } - - my $delay_field_ts = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($target->$delay_field())); - - # to get the minimum time that the target must have aged to, add the min age to the delay field - $delay_field_ts->add( seconds => interval_to_seconds( $env->{params}->{min_target_age} ) ); - - return 1 if $delay_field_ts <= DateTime->now; - return 0; -} - -sub CircIsOverdue { - my $self = shift; - my $env = shift; - my $circ = $env->{target}; - - return 0 if $circ->checkin_time; - return 0 if $circ->stop_fines and not $circ->stop_fines =~ /MAXFINES|LONGOVERDUE/; - - if ($env->{params}->{min_target_age}) { - $env->{params}->{target_age_field} = 'xact_start'; - return 0 if (!$self->MinPassiveTargetAge($env)); - } - - my $due_date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($circ->due_date)); - return 0 if $due_date > DateTime->now; - - return 1; -} - -sub HoldIsAvailable { - my $self = shift; - my $env = shift; - - my $hold = $env->{target}; - - return 1 if - !$hold->cancel_time and - $hold->capture_time and - $hold->current_copy and - $hold->current_copy->status == OILS_COPY_STATUS_ON_HOLDS_SHELF; - - return 0; -} - -sub HoldIsCancelled { - my $self = shift; - my $env = shift; - - my $hold = $env->{target}; - - return ($hold->cancel_time) ? 1 : 0; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator/Acq.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator/Acq.pm deleted file mode 100644 index 06622abce7..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator/Acq.pm +++ /dev/null @@ -1,13 +0,0 @@ -package OpenILS::Application::Trigger::Validator::Acq; -use strict; use warnings; -# use OpenSRF::Utils::Logger qw/:logger/; - -sub get_lineitem_from_req { - my($self, $env) = @_; - my $req = $env->{target}; - return (ref $env->{target}->lineitem) ? - $env->{target}->lineitem : - $self->editor->retrieve_acq_lineitem($$env->{target}->lineitem); -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator/Acq/PurchaseOrderEDIRequired.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator/Acq/PurchaseOrderEDIRequired.pm deleted file mode 100644 index 211d75fee0..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator/Acq/PurchaseOrderEDIRequired.pm +++ /dev/null @@ -1,28 +0,0 @@ -package OpenILS::Application::Trigger::Validator::Acq::PurchaseOrderEDIRequired; -use strict; use warnings; -# use OpenSRF::Utils::Logger qw/:logger/; -use OpenILS::Utils::CStoreEditor qw/ new_editor /; -use OpenILS::Application::AppUtils; -my $U = 'OpenILS::Application::AppUtils'; - -sub handler { - my $self = shift; - my $env = shift; - my $po = $env->{target}; - - my $provider = - ref($po->provider) ? - $po->provider : - new_editor->retrieve_acq_provider($po->provider); - - return 1 if - ($po->state eq 'on-order' or - $po->state eq 'retry' ) and - $provider and - $provider->edi_default and - $U->is_true($provider->active); - - return 0; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator/Acq/UserRequestCancelled.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator/Acq/UserRequestCancelled.pm deleted file mode 100644 index 6cbf13ef78..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator/Acq/UserRequestCancelled.pm +++ /dev/null @@ -1,12 +0,0 @@ -package OpenILS::Application::Trigger::Validator::Acq::UserRequestCancelled; -use strict; use warnings; -use OpenSRF::Utils::Logger qw/:logger/; -use OpenILS::Application::Trigger::Validator::Acq; - -sub handler { - my $self = shift; - my $env = shift; - return OpenILS::Application::Trigger::Validator::Acq::get_lineitem_from_req($self, $env)->state eq 'cancelled'; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator/Acq/UserRequestOrdered.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator/Acq/UserRequestOrdered.pm deleted file mode 100644 index a2552afc71..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator/Acq/UserRequestOrdered.pm +++ /dev/null @@ -1,12 +0,0 @@ -package OpenILS::Application::Trigger::Validator::Acq::UserRequestOrdered; -use strict; use warnings; -use OpenSRF::Utils::Logger qw/:logger/; -use OpenILS::Application::Trigger::Validator::Acq; - -sub handler { - my $self = shift; - my $env = shift; - return OpenILS::Application::Trigger::Validator::Acq::get_lineitem_from_req($self, $env)->state eq 'on-order'; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator/Acq/UserRequestReceived.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator/Acq/UserRequestReceived.pm deleted file mode 100644 index d43e094017..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Validator/Acq/UserRequestReceived.pm +++ /dev/null @@ -1,12 +0,0 @@ -package OpenILS::Application::Trigger::Validator::Acq::UserRequestReceived; -use strict; use warnings; -use OpenSRF::Utils::Logger qw/:logger/; -use OpenILS::Application::Trigger::Validator::Acq; - -sub handler { - my $self = shift; - my $env = shift; - return OpenILS::Application::Trigger::Validator::Acq::get_lineitem_from_req($self, $env)->state eq 'received'; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Vandelay.pm b/Open-ILS/src/perlmods/OpenILS/Application/Vandelay.pm deleted file mode 100644 index 1311800be0..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Application/Vandelay.pm +++ /dev/null @@ -1,1111 +0,0 @@ -package OpenILS::Application::Vandelay; -use strict; use warnings; -use OpenILS::Application; -use base qw/OpenILS::Application/; -use Unicode::Normalize; -use OpenSRF::EX qw/:try/; -use OpenSRF::AppSession; -use OpenSRF::Utils::SettingsClient; -use OpenSRF::Utils::Cache; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::CStoreEditor qw/:funcs/; -use MARC::Batch; -use MARC::Record; -use MARC::File::XML; -use OpenILS::Utils::Fieldmapper; -use Time::HiRes qw(time); -use OpenSRF::Utils::Logger qw/$logger/; -use MIME::Base64; -use OpenILS::Const qw/:const/; -use OpenILS::Application::AppUtils; -use OpenILS::Application::Cat::BibCommon; -use OpenILS::Application::Cat::AuthCommon; -use OpenILS::Application::Cat::AssetCommon; -my $U = 'OpenILS::Application::AppUtils'; - -# A list of LDR/06 values from http://loc.gov/marc -my %record_types = ( - a => 'bib', - c => 'bib', - d => 'bib', - e => 'bib', - f => 'bib', - g => 'bib', - i => 'bib', - j => 'bib', - k => 'bib', - m => 'bib', - o => 'bib', - p => 'bib', - r => 'bib', - t => 'bib', - u => 'holdings', - v => 'holdings', - x => 'holdings', - y => 'holdings', - z => 'auth', - ' ' => 'bib', -); - -sub initialize {} -sub child_init {} - -# -------------------------------------------------------------------------------- -# Biblio ingest - -sub create_bib_queue { - my $self = shift; - my $client = shift; - my $auth = shift; - my $name = shift; - my $owner = shift; - my $type = shift; - my $import_def = shift; - - my $e = new_editor(authtoken => $auth, xact => 1); - - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('CREATE_BIB_IMPORT_QUEUE'); - $owner ||= $e->requestor->id; - - if ($e->search_vandelay_bib_queue( {name => $name, owner => $owner, queue_type => $type})->[0]) { - $e->rollback; - return OpenILS::Event->new('BIB_QUEUE_EXISTS') - } - - my $queue = new Fieldmapper::vandelay::bib_queue(); - $queue->name( $name ); - $queue->owner( $owner ); - $queue->queue_type( $type ) if ($type); - $queue->item_attr_def( $import_def ) if ($import_def); - - my $new_q = $e->create_vandelay_bib_queue( $queue ); - return $e->die_event unless ($new_q); - $e->commit; - - return $new_q; -} -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.bib_queue.create", - method => "create_bib_queue", - api_level => 1, - argc => 4, -); - - -sub create_auth_queue { - my $self = shift; - my $client = shift; - my $auth = shift; - my $name = shift; - my $owner = shift; - my $type = shift; - - my $e = new_editor(authtoken => $auth, xact => 1); - - return $e->die_event unless $e->checkauth; - return $e->die_event unless $e->allowed('CREATE_AUTHORITY_IMPORT_QUEUE'); - $owner ||= $e->requestor->id; - - if ($e->search_vandelay_bib_queue({name => $name, owner => $owner, queue_type => $type})->[0]) { - $e->rollback; - return OpenILS::Event->new('AUTH_QUEUE_EXISTS') - } - - my $queue = new Fieldmapper::vandelay::authority_queue(); - $queue->name( $name ); - $queue->owner( $owner ); - $queue->queue_type( $type ) if ($type); - - my $new_q = $e->create_vandelay_authority_queue( $queue ); - $e->die_event unless ($new_q); - $e->commit; - - return $new_q; -} -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.authority_queue.create", - method => "create_auth_queue", - api_level => 1, - argc => 3, -); - -sub add_record_to_bib_queue { - my $self = shift; - my $client = shift; - my $auth = shift; - my $queue = shift; - my $marc = shift; - my $purpose = shift; - my $bib_source = shift; - - my $e = new_editor(authtoken => $auth, xact => 1); - - $queue = $e->retrieve_vandelay_bib_queue($queue); - - return $e->die_event unless $e->checkauth; - return $e->die_event unless - ($e->allowed('CREATE_BIB_IMPORT_QUEUE', undef, $queue) || - $e->allowed('CREATE_BIB_IMPORT_QUEUE')); - - my $new_rec = _add_bib_rec($e, $marc, $queue->id, $purpose, $bib_source); - - return $e->die_event unless ($new_rec); - $e->commit; - return $new_rec; -} -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.queued_bib_record.create", - method => "add_record_to_bib_queue", - api_level => 1, - argc => 3, -); - -sub _add_bib_rec { - my $e = shift; - my $marc = shift; - my $queue = shift; - my $purpose = shift; - my $bib_source = shift; - - my $rec = new Fieldmapper::vandelay::queued_bib_record(); - $rec->marc( $marc ); - $rec->queue( $queue ); - $rec->purpose( $purpose ) if ($purpose); - $rec->bib_source($bib_source); - - return $e->create_vandelay_queued_bib_record( $rec ); -} - -sub add_record_to_authority_queue { - my $self = shift; - my $client = shift; - my $auth = shift; - my $queue = shift; - my $marc = shift; - my $purpose = shift; - - my $e = new_editor(authtoken => $auth, xact => 1); - - $queue = $e->retrieve_vandelay_authority_queue($queue); - - return $e->die_event unless $e->checkauth; - return $e->die_event unless - ($e->allowed('CREATE_AUTHORITY_IMPORT_QUEUE', undef, $queue) || - $e->allowed('CREATE_AUTHORITY_IMPORT_QUEUE')); - - my $new_rec = _add_auth_rec($e, $marc, $queue->id, $purpose); - - return $e->die_event unless ($new_rec); - $e->commit; - return $new_rec; -} -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.queued_authority_record.create", - method => "add_record_to_authority_queue", - api_level => 1, - argc => 3, -); - -sub _add_auth_rec { - my $e = shift; - my $marc = shift; - my $queue = shift; - my $purpose = shift; - - my $rec = new Fieldmapper::vandelay::queued_authority_record(); - $rec->marc( $marc ); - $rec->queue( $queue ); - $rec->purpose( $purpose ) if ($purpose); - - return $e->create_vandelay_queued_authority_record( $rec ); -} - -sub process_spool { - my $self = shift; - my $client = shift; - my $auth = shift; - my $fingerprint = shift || ''; - my $queue_id = shift; - my $purpose = shift; - my $filename = shift; - my $bib_source = shift; - - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - - my $queue; - my $type = $self->{record_type}; - - if($type eq 'bib') { - $queue = $e->retrieve_vandelay_bib_queue($queue_id) or return $e->die_event; - } else { - $queue = $e->retrieve_vandelay_authority_queue($queue_id) or return $e->die_event; - } - - my $evt = check_queue_perms($e, $type, $queue); - return $evt if ($evt); - - my $cache = new OpenSRF::Utils::Cache(); - - if($fingerprint) { - my $data = $cache->get_cache('vandelay_import_spool_' . $fingerprint); - $purpose = $data->{purpose}; - $filename = $data->{path}; - $bib_source = $data->{bib_source}; - } - - unless(-r $filename) { - $logger->error("unable to read MARC file $filename"); - return -1; # make this an event XXX - } - - $logger->info("vandelay spooling $fingerprint purpose=$purpose file=$filename"); - - my $marctype = 'USMARC'; - - open F, $filename; - $marctype = 'XML' if (getc(F) =~ /^\D/o); - close F; - - my $batch = new MARC::Batch ($marctype, $filename); - $batch->strict_off; - - my $response_scale = 10; - my $count = 0; - my $r = -1; - while (try { $r = $batch->next } otherwise { $r = -1 }) { - if ($r == -1) { - $logger->warn("Processing of record $count in set $filename failed. Skipping this record"); - $count++; - } - - $logger->info("processing record $count"); - - try { - (my $xml = $r->as_xml_record()) =~ s/\n//sog; - $xml =~ s/^<\?xml.+\?\s*>//go; - $xml =~ s/>\s+entityize($xml); - $xml =~ s/[\x00-\x1f]//go; - - my $qrec; - # Check the leader to ensure we've got something resembling the expected - # Allow spaces to give records the benefit of the doubt - my $ldr_type = substr($r->leader(), 6, 1); - if ($type eq 'bib' && ($record_types{$ldr_type}) eq 'bib' || $ldr_type eq ' ') { - $qrec = _add_bib_rec( $e, $xml, $queue_id, $purpose, $bib_source ) or return $e->die_event; - } elsif ($type eq 'auth' && ($record_types{$ldr_type}) eq 'auth' || $ldr_type eq ' ') { - $qrec = _add_auth_rec( $e, $xml, $queue_id, $purpose ) or return $e->die_event; - } else { - # I don't know how to handle this type; rock on - $logger->error("In process_spool(), type was $type and leader type was $ldr_type ; not currently supported"); - next; - } - - if($self->api_name =~ /stream_results/ and $qrec) { - $client->respond($qrec->id) - } else { - $client->respond($count) if (++$count % $response_scale) == 0; - $response_scale *= 10 if ($count == ($response_scale * 10)); - } - } catch Error with { - my $error = shift; - $logger->warn("Encountered a bad record at Vandelay ingest: ".$error); - } - } - - $e->commit; - unlink($filename); - $cache->delete_cache('vandelay_import_spool_' . $fingerprint) if $fingerprint; - return $count; -} - -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.bib.process_spool", - method => "process_spool", - api_level => 1, - argc => 3, - max_chunk_size => 0, - record_type => 'bib' -); -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.auth.process_spool", - method => "process_spool", - api_level => 1, - argc => 3, - max_chunk_size => 0, - record_type => 'auth' -); - -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.bib.process_spool.stream_results", - method => "process_spool", - api_level => 1, - argc => 3, - stream => 1, - max_chunk_size => 0, - record_type => 'bib' -); -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.auth.process_spool.stream_results", - method => "process_spool", - api_level => 1, - argc => 3, - stream => 1, - max_chunk_size => 0, - record_type => 'auth' -); - -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.bib_queue.records.retrieve", - method => 'retrieve_queued_records', - api_level => 1, - argc => 2, - stream => 1, - record_type => 'bib' -); -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.auth_queue.records.retrieve", - method => 'retrieve_queued_records', - api_level => 1, - argc => 2, - stream => 1, - record_type => 'auth' -); - -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.bib_queue.records.matches.retrieve", - method => 'retrieve_queued_records', - api_level => 1, - argc => 2, - stream => 1, - record_type => 'bib', - signature => { - desc => q/Only retrieve queued bib records that have matches against existing records/ - } -); -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.auth_queue.records.matches.retrieve", - method => 'retrieve_queued_records', - api_level => 1, - argc => 2, - stream => 1, - record_type => 'auth', - signature => { - desc => q/Only retrieve queued authority records that have matches against existing records/ - } - -); - -sub retrieve_queued_records { - my($self, $conn, $auth, $queue_id, $options) = @_; - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - $options ||= {}; - my $limit = $$options{limit} || 20; - my $offset = $$options{offset} || 0; - - my $type = $self->{record_type}; - my $queue; - if($type eq 'bib') { - $queue = $e->retrieve_vandelay_bib_queue($queue_id) or return $e->die_event; - } else { - $queue = $e->retrieve_vandelay_authority_queue($queue_id) or return $e->die_event; - } - my $evt = check_queue_perms($e, $type, $queue); - return $evt if ($evt); - - my $class = ($type eq 'bib') ? 'vqbr' : 'vqar'; - my $search = ($type eq 'bib') ? - 'search_vandelay_queued_bib_record' : 'search_vandelay_queued_authority_record'; - my $retrieve = ($type eq 'bib') ? - 'retrieve_vandelay_queued_bib_record' : 'retrieve_vandelay_queued_authority_record'; - - my $filter = ($$options{non_imported}) ? {import_time => undef} : {}; - - my $record_ids; - if($self->api_name =~ /matches/) { - # fetch only matched records - $record_ids = queued_records_with_matches($e, $type, $queue_id, $limit, $offset, $filter); - } else { - # fetch all queue records - $record_ids = $e->$search([ - {queue => $queue_id, %$filter}, - {order_by => {$class => 'id'}, limit => $limit, offset => $offset} - ], - {idlist => 1} - ); - } - - - for my $rec_id (@$record_ids) { - my $params = { - flesh => 1, - flesh_fields => {$class => ['attributes', 'matches']}, - }; - my $rec = $e->$retrieve([$rec_id, $params]); - $rec->clear_marc if $$options{clear_marc}; - $conn->respond($rec); - } - $e->rollback; - return undef; -} - -sub check_queue_perms { - my($e, $type, $queue) = @_; - if ($type eq 'bib') { - return $e->die_event unless - ($e->allowed('CREATE_BIB_IMPORT_QUEUE', undef, $queue) || - $e->allowed('CREATE_BIB_IMPORT_QUEUE')); - } else { - return $e->die_event unless - ($e->allowed('CREATE_AUTHORITY_IMPORT_QUEUE', undef, $queue) || - $e->allowed('CREATE_AUTHORITY_IMPORT_QUEUE')); - } - - return undef; -} - -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.bib_record.list.import", - method => 'import_record_list', - api_level => 1, - argc => 2, - stream => 1, - record_type => 'bib' -); - -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.auth_record.list.import", - method => 'import_record_list', - api_level => 1, - argc => 2, - stream => 1, - record_type => 'auth' -); - -sub import_record_list { - my($self, $conn, $auth, $rec_ids, $args) = @_; - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - $args ||= {}; - my $err = import_record_list_impl($self, $conn, $rec_ids, $e->requestor, $args); - $e->rollback; - return $err if $err; - return {complete => 1}; -} - - -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.bib_queue.import", - method => 'import_queue', - api_level => 1, - argc => 2, - stream => 1, - max_chunk_size => 0, - record_type => 'bib' -); - -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.auth_queue.import", - method => 'import_queue', - api_level => 1, - argc => 2, - stream => 1, - max_chunk_size => 0, - record_type => 'auth' -); -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.bib_queue.nomatch.import", - method => 'import_queue', - api_level => 1, - argc => 2, - stream => 1, - signature => { - desc => q/Only import records that have no collisions/ - }, - max_chunk_size => 0, - record_type => 'bib' -); - -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.auth_queue.nomatch.import", - method => 'import_queue', - api_level => 1, - argc => 2, - stream => 1, - signature => { - desc => q/Only import records that have no collisions/ - }, - max_chunk_size => 0, - record_type => 'auth' -); -sub import_queue { - my($self, $conn, $auth, $q_id, $options) = @_; - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - $options ||= {}; - my $type = $self->{record_type}; - my $class = ($type eq 'bib') ? 'vqbr' : 'vqar'; - - my $query = {queue => $q_id, import_time => undef}; - - if($self->api_name =~ /nomatch/) { - my $matched_recs = queued_records_with_matches($e, $type, $q_id, undef, undef, {import_time => undef}); - $query->{id} = {'not in' => $matched_recs} if @$matched_recs; - } - - my $search = ($type eq 'bib') ? - 'search_vandelay_queued_bib_record' : 'search_vandelay_queued_authority_record'; - my $rec_ids = $e->$search($query, {idlist => 1}); - my $err = import_record_list_impl($self, $conn, $rec_ids, $e->requestor, $options); - try {$e->rollback} otherwise {}; # only using this to make the read authoritative -- don't die from it - return $err if $err; - return {complete => 1}; -} - -# returns a list of queued record IDs for a given queue that -# have at least one entry in the match table -sub queued_records_with_matches { - my($e, $type, $q_id, $limit, $offset, $filter) = @_; - - my $match_class = 'vbm'; - my $rec_class = 'vqbr'; - if($type eq 'auth') { - $match_class = 'vam'; - $rec_class = 'vqar'; - } - - $filter ||= {}; - $filter->{queue} = $q_id; - - my $query = { - distinct => 1, - select => {$match_class => ['queued_record']}, - from => { - $match_class => { - $rec_class => { - field => 'id', - fkey => 'queued_record', - filter => $filter, - } - } - } - }; - - if($limit or defined $offset) { - $limit ||= 20; - $offset ||= 0; - $query->{limit} = $limit; - $query->{offset} = $offset; - } - - my $data = $e->json_query($query); - return [ map {$_->{queued_record}} @$data ]; -} - -sub import_record_list_impl { - my($self, $conn, $rec_ids, $requestor, $args) = @_; - - my $overlay_map = $args->{overlay_map} || {}; - my $type = $self->{record_type}; - my $total = @$rec_ids; - my $count = 0; - my %queues; - - my $step = 1; - - my $auto_overlay_exact = $$args{auto_overlay_exact}; - my $auto_overlay_1match = $$args{auto_overlay_1match}; - my $merge_profile = $$args{merge_profile}; - my $bib_source = $$args{bib_source}; - my $report_all = $$args{report_all}; - - my $overlay_func = 'vandelay.overlay_bib_record'; - my $auto_overlay_func = 'vandelay.auto_overlay_bib_record'; - my $retrieve_func = 'retrieve_vandelay_queued_bib_record'; - my $update_func = 'update_vandelay_queued_bib_record'; - my $search_func = 'search_vandelay_queued_bib_record'; - my $retrieve_queue_func = 'retrieve_vandelay_bib_queue'; - my $update_queue_func = 'update_vandelay_bib_queue'; - my $rec_class = 'vqbr'; - - my %bib_sources; - my $editor = new_editor(); - my $sources = $editor->search_config_bib_source({id => {'!=' => undef}}); - - foreach my $src (@$sources) { - $bib_sources{$src->id} = $src->source; - } - - if($type eq 'auth') { - $overlay_func =~ s/bib/auth/o; - $auto_overlay_func = s/bib/auth/o; - $retrieve_func =~ s/bib/authority/o; - $retrieve_queue_func =~ s/bib/authority/o; - $update_queue_func =~ s/bib/authority/o; - $update_func =~ s/bib/authority/o; - $search_func =~ s/bib/authority/o; - $rec_class = 'vqar'; - } - - my @success_rec_ids; - for my $rec_id (@$rec_ids) { - - my $overlay_target = $overlay_map->{$rec_id}; - - my $error = 0; - my $e = new_editor(xact => 1); - $e->requestor($requestor); - - my $rec = $e->$retrieve_func([ - $rec_id, - { flesh => 1, - flesh_fields => { $rec_class => ['matches']}, - } - ]); - - unless($rec) { - $conn->respond({total => $total, progress => ++$count, imported => $rec_id, err_event => $e->event}); - $e->rollback; - next; - } - - if($rec->import_time) { - $e->rollback; - next; - } - - $queues{$rec->queue} = 1; - - my $record; - my $imported = 0; - - if(defined $overlay_target) { - # Caller chose an explicit overlay target - - my $res = $e->json_query( - { - from => [ - $overlay_func, - $rec->id, - $overlay_target, - $merge_profile - ] - } - ); - - if($res and ($res = $res->[0])) { - - if($res->{$overlay_func} eq 't') { - $logger->info("vl: $type direct overlay succeeded for queued rec " . - $rec->id . " and overlay target $overlay_target"); - $imported = 1; - } - - } else { - $error = 1; - $logger->error("vl: Error attempting overlay with func=$overlay_func, profile=$merge_profile, record=$rec_id"); - } - - } else { - - if($auto_overlay_1match) { - # caller says to overlay if there is exactly 1 match - - my %match_recs = map { $_->eg_record => 1 } @{$rec->matches}; - - if( scalar(keys %match_recs) == 1) { # all matches point to the same record - - my $res = $e->json_query( - { - from => [ - $overlay_func, - $rec->id, - $rec->matches->[0]->eg_record, - $merge_profile - ] - } - ); - - if($res and ($res = $res->[0])) { - - if($res->{$overlay_func} eq 't') { - $logger->info("vl: $type overlay-1match succeeded for queued rec " . $rec->id); - $imported = 1; - } - - } else { - $error = 1; - $logger->error("vl: Error attempting overlay with func=$overlay_func, profile=$merge_profile, record=$rec_id"); - } - } - } - - if(!$imported and !$error and $auto_overlay_exact and scalar(@{$rec->matches}) == 1 ) { - - # caller says to overlay if there is an /exact/ match - - my $res = $e->json_query( - { - from => [ - $auto_overlay_func, - $rec->id, - $merge_profile - ] - } - ); - - if($res and ($res = $res->[0])) { - - if($res->{$auto_overlay_func} eq 't') { - $logger->info("vl: $type auto-overlay succeeded for queued rec " . $rec->id); - $imported = 1; - } - - } else { - $error = 1; - $logger->error("vl: Error attempting overlay with func=$auto_overlay_func, profile=$merge_profile, record=$rec_id"); - } - } - - if(!$imported and !$error) { - - # No overlay / merge occurred. Do a traditional record import by creating a new record - - if($type eq 'bib') { - $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import($e, $rec->marc, $bib_sources{$rec->bib_source}); - } else { - - $record = OpenILS::Application::Cat::AuthCommon->import_authority_record($e, $rec->marc); #$source); - } - - if($U->event_code($record)) { - - $e->event($record); - $e->rollback; - - } else { - - $logger->info("vl: successfully imported new $type record"); - $rec->imported_as($record->id); - $rec->import_time('now'); - - $imported = 1 if $e->$update_func($rec); - } - } - } - - if($imported) { - push @success_rec_ids, $rec_id; - $e->commit; - } else { - # Send an update whenever there's an error - $conn->respond({total => $total, progress => ++$count, imported => $rec_id, err_event => $e->event}); - } - - if($report_all or (++$count % $step) == 0) { - $conn->respond({total => $total, progress => $count, imported => $rec_id}); - # report often at first, climb quickly, then hold steady - $step *= 2 unless $step == 256; - } - } - - # see if we need to mark any queues as complete - for my $q_id (keys %queues) { - - my $e = new_editor(xact => 1); - my $remaining = $e->$search_func( - [{queue => $q_id, import_time => undef}, {limit =>1}], {idlist => 1}); - - unless(@$remaining) { - my $queue = $e->$retrieve_queue_func($q_id); - - unless($U->is_true($queue->complete)) { - $queue->complete('t'); - $e->$update_queue_func($queue) or return $e->die_event; - $e->commit; - next; - } - } - $e->rollback; - } - - import_record_asset_list_impl($conn, \@success_rec_ids, $requestor); - - $conn->respond({total => $total, progress => $count}); - return undef; -} - - -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.bib_queue.owner.retrieve", - method => 'owner_queue_retrieve', - api_level => 1, - argc => 2, - stream => 1, - record_type => 'bib' -); -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.authority_queue.owner.retrieve", - method => 'owner_queue_retrieve', - api_level => 1, - argc => 2, - stream => 1, - record_type => 'auth' -); - -sub owner_queue_retrieve { - my($self, $conn, $auth, $owner_id, $filters) = @_; - my $e = new_editor(authtoken => $auth, xact => 1); - return $e->die_event unless $e->checkauth; - $owner_id = $e->requestor->id; # XXX add support for viewing other's queues? - my $queues; - $filters ||= {}; - my $search = {owner => $owner_id}; - $search->{$_} = $filters->{$_} for keys %$filters; - - if($self->{record_type} eq 'bib') { - $queues = $e->search_vandelay_bib_queue( - [$search, {order_by => {vbq => 'lower(name)'}}]); - } else { - $queues = $e->search_vandelay_authority_queue( - [$search, {order_by => {vaq => 'lower(name)'}}]); - } - $conn->respond($_) for @$queues; - $e->rollback; - return undef; -} - -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.bib_queue.delete", - method => "delete_queue", - api_level => 1, - argc => 2, - record_type => 'bib' -); -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.auth_queue.delete", - method => "delete_queue", - api_level => 1, - argc => 2, - record_type => 'auth' -); - -sub delete_queue { - my($self, $conn, $auth, $q_id) = @_; - my $e = new_editor(xact => 1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - if($self->{record_type} eq 'bib') { - return $e->die_event unless $e->allowed('CREATE_BIB_IMPORT_QUEUE'); - my $queue = $e->retrieve_vandelay_bib_queue($q_id) - or return $e->die_event; - $e->delete_vandelay_bib_queue($queue) - or return $e->die_event; - } else { - return $e->die_event unless $e->allowed('CREATE_AUTHORITY_IMPORT_QUEUE'); - my $queue = $e->retrieve_vandelay_authority_queue($q_id) - or return $e->die_event; - $e->delete_vandelay_authority_queue($queue) - or return $e->die_event; - } - $e->commit; - return 1; -} - - -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.queued_bib_record.html", - method => 'queued_record_html', - api_level => 1, - argc => 2, - stream => 1, - record_type => 'bib' -); -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.queued_authority_record.html", - method => 'queued_record_html', - api_level => 1, - argc => 2, - stream => 1, - record_type => 'auth' -); - -sub queued_record_html { - my($self, $conn, $auth, $rec_id) = @_; - my $e = new_editor(xact=>1,authtoken => $auth); - return $e->die_event unless $e->checkauth; - my $rec; - if($self->{record_type} eq 'bib') { - $rec = $e->retrieve_vandelay_queued_bib_record($rec_id) - or return $e->die_event; - } else { - $rec = $e->retrieve_vandelay_queued_authority_record($rec_id) - or return $e->die_event; - } - - $e->rollback; - return $U->simplereq( - 'open-ils.search', - 'open-ils.search.biblio.record.html', undef, 1, $rec->marc); -} - - -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.bib_queue.summary.retrieve", - method => 'retrieve_queue_summary', - api_level => 1, - argc => 2, - stream => 1, - record_type => 'bib' -); -__PACKAGE__->register_method( - api_name => "open-ils.vandelay.auth_queue.summary.retrieve", - method => 'retrieve_queue_summary', - api_level => 1, - argc => 2, - stream => 1, - record_type => 'auth' -); - -sub retrieve_queue_summary { - my($self, $conn, $auth, $queue_id) = @_; - my $e = new_editor(xact=>1, authtoken => $auth); - return $e->die_event unless $e->checkauth; - - my $queue; - my $type = $self->{record_type}; - if($type eq 'bib') { - $queue = $e->retrieve_vandelay_bib_queue($queue_id) - or return $e->die_event; - } else { - $queue = $e->retrieve_vandelay_authority_queue($queue_id) - or return $e->die_event; - } - - my $evt = check_queue_perms($e, $type, $queue); - return $evt if $evt; - - my $search = 'search_vandelay_queued_bib_record'; - $search =~ s/bib/authority/ if $type ne 'bib'; - - return { - queue => $queue, - total => scalar(@{$e->$search({queue => $queue_id}, {idlist=>1})}), - imported => scalar(@{$e->$search({queue => $queue_id, import_time => {'!=' => undef}}, {idlist=>1})}), - }; -} - -# -------------------------------------------------------------------------------- -# Given a list of queued record IDs, imports all items attached to those records -# -------------------------------------------------------------------------------- -sub import_record_asset_list_impl { - my($conn, $rec_ids, $requestor) = @_; - - my $total = @$rec_ids; - my $try_count = 0; - my $in_count = 0; - my $roe = new_editor(xact=> 1, requestor => $requestor); - - for my $rec_id (@$rec_ids) { - my $rec = $roe->retrieve_vandelay_queued_bib_record($rec_id); - next unless $rec and $rec->import_time; - my $item_ids = $roe->search_vandelay_import_item({record => $rec->id}, {idlist=>1}); - - for my $item_id (@$item_ids) { - my $e = new_editor(requestor => $requestor, xact => 1); - my $item = $e->retrieve_vandelay_import_item($item_id); - $try_count++; - - # -------------------------------------------------------------------------------- - # Find or create the volume - # -------------------------------------------------------------------------------- - my ($vol, $evt) = - OpenILS::Application::Cat::AssetCommon->find_or_create_volume( - $e, $item->call_number, $rec->imported_as, $item->owning_lib); - - if($evt) { - respond_with_status($conn, $total, $try_count, $in_count, $evt); - next; - } - - # -------------------------------------------------------------------------------- - # Create the new copy - # -------------------------------------------------------------------------------- - my $copy = Fieldmapper::asset::copy->new; - $copy->loan_duration(2); - $copy->fine_level(2); - $copy->barcode($item->barcode); - $copy->location($item->location); - $copy->circ_lib($item->circ_lib || $item->owning_lib); - $copy->status($item->status || OILS_COPY_STATUS_IN_PROCESS); - $copy->circulate($item->circulate); - $copy->deposit($item->deposit); - $copy->deposit_amount($item->deposit_amount); - $copy->ref($item->ref); - $copy->holdable($item->holdable); - $copy->price($item->price); - $copy->circ_as_type($item->circ_as_type); - $copy->alert_message($item->alert_message); - $copy->opac_visible($item->opac_visible); - $copy->circ_modifier($item->circ_modifier); - - # -------------------------------------------------------------------------------- - # see if a valid circ_modifier was provided - # -------------------------------------------------------------------------------- - #if($copy->circ_modifier and not $e->retrieve_config_circ_modifier($item->circ_modifier)) { - if($copy->circ_modifier and not $e->search_config_circ_modifier({code=>$item->circ_modifier})->[0]) { - respond_with_status($conn, $total, $try_count, $in_count, $e->die_event); - next; - } - - if($evt = OpenILS::Application::Cat::AssetCommon->create_copy($e, $vol, $copy)) { - try { $e->rollback } otherwise {}; # sometimes calls die_event, sometimes not - respond_with_status($conn, $total, $try_count, $in_count, $evt); - next; - } - - # -------------------------------------------------------------------------------- - # create copy notes - # -------------------------------------------------------------------------------- - $evt = OpenILS::Application::Cat::AssetCommon->create_copy_note( - $e, $copy, '', $item->pub_note, 1) if $item->pub_note; - - if($evt) { - respond_with_status($conn, $total, $try_count, $in_count, $evt); - next; - } - - $evt = OpenILS::Application::Cat::AssetCommon->create_copy_note( - $e, $copy, '', $item->priv_note, 1) if $item->priv_note; - - if($evt) { - respond_with_status($conn, $total, $try_count, $in_count, $evt); - next; - } - - # -------------------------------------------------------------------------------- - # Item import succeeded - # -------------------------------------------------------------------------------- - $e->commit; - respond_with_status($conn, $total, $try_count, ++$in_count, undef, imported_as => $copy->id); - } - } - $roe->rollback; - return undef; -} - - -sub respond_with_status { - my($conn, $total, $try_count, $success_count, $err, %args) = @_; - $conn->respond({ - total => $total, - progress => $try_count, - err_event => $err, - success_count => $success_count, %args }) if $err or ($try_count % 5 == 0); -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Const.pm b/Open-ILS/src/perlmods/OpenILS/Const.pm deleted file mode 100644 index 281f465bd0..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Const.pm +++ /dev/null @@ -1,131 +0,0 @@ -package OpenILS::Const; -use strict; use warnings; -use vars qw(@EXPORT_OK %EXPORT_TAGS); -use Exporter; -use base qw/Exporter/; - - -# --------------------------------------------------------------------- -# Shoves defined constants into the export array -# so they don't have to be listed twice in the code -# --------------------------------------------------------------------- -sub econst { - my($name, $value) = @_; - my $caller = caller; - no strict; - *{$name} = sub () { $value }; - push @{$caller.'::EXPORT_OK'}, $name; -} - -# --------------------------------------------------------------------- -# CONSTANTS -# --------------------------------------------------------------------- - - - -# --------------------------------------------------------------------- -# Copy Statuses -# --------------------------------------------------------------------- -econst OILS_COPY_STATUS_AVAILABLE => 0; -econst OILS_COPY_STATUS_CHECKED_OUT => 1; -econst OILS_COPY_STATUS_BINDERY => 2; -econst OILS_COPY_STATUS_LOST => 3; -econst OILS_COPY_STATUS_MISSING => 4; -econst OILS_COPY_STATUS_IN_PROCESS => 5; -econst OILS_COPY_STATUS_IN_TRANSIT => 6; -econst OILS_COPY_STATUS_RESHELVING => 7; -econst OILS_COPY_STATUS_ON_HOLDS_SHELF=> 8; -econst OILS_COPY_STATUS_ON_ORDER => 9; -econst OILS_COPY_STATUS_ILL => 10; -econst OILS_COPY_STATUS_CATALOGING => 11; -econst OILS_COPY_STATUS_RESERVES => 12; -econst OILS_COPY_STATUS_DISCARD => 13; -econst OILS_COPY_STATUS_DAMAGED => 14; -econst OILS_COPY_STATUS_ON_RESV_SHELF => 15; - - -# --------------------------------------------------------------------- -# Circ defaults for pre-cataloged copies -# --------------------------------------------------------------------- -econst OILS_PRECAT_COPY_FINE_LEVEL => 2; -econst OILS_PRECAT_COPY_LOAN_DURATION => 2; -econst OILS_PRECAT_CALL_NUMBER => -1; -econst OILS_PRECAT_RECORD => -1; - - -# --------------------------------------------------------------------- -# Circ constants -# --------------------------------------------------------------------- -econst OILS_CIRC_DURATION_SHORT => 1; -econst OILS_CIRC_DURATION_NORMAL => 2; -econst OILS_CIRC_DURATION_EXTENDED => 3; -econst OILS_REC_FINE_LEVEL_LOW => 1; -econst OILS_REC_FINE_LEVEL_NORMAL => 2; -econst OILS_REC_FINE_LEVEL_HIGH => 3; -econst OILS_STOP_FINES_CHECKIN => 'CHECKIN'; -econst OILS_STOP_FINES_RENEW => 'RENEW'; -econst OILS_STOP_FINES_LOST => 'LOST'; -econst OILS_STOP_FINES_CLAIMSRETURNED => 'CLAIMSRETURNED'; -econst OILS_STOP_FINES_LONGOVERDUE => 'LONGOVERDUE'; -econst OILS_STOP_FINES_MAX_FINES => 'MAXFINES'; -econst OILS_STOP_FINES_CLAIMS_NEVERCHECKEDOUT => 'CLAIMSNEVERCHECKEDOUT'; -econst OILS_UNLIMITED_CIRC_DURATION => 'unlimited'; - -# --------------------------------------------------------------------- -# Settings -# --------------------------------------------------------------------- -econst OILS_SETTING_LOST_PROCESSING_FEE => 'circ.lost_materials_processing_fee'; -econst OILS_SETTING_DEF_ITEM_PRICE => 'cat.default_item_price'; -econst OILS_SETTING_ORG_BOUNCED_EMAIL => 'org.bounced_emails'; -econst OILS_SETTING_CHARGE_LOST_ON_ZERO => 'circ.charge_lost_on_zero'; -econst OILS_SETTING_VOID_OVERDUE_ON_LOST => 'circ.void_overdue_on_lost'; -econst OILS_SETTING_HOLD_SOFT_STALL => 'circ.hold_stalling.soft'; -econst OILS_SETTING_HOLD_HARD_STALL => 'circ.hold_stalling.hard'; -econst OILS_SETTING_HOLD_SOFT_BOUNDARY => 'circ.hold_boundary.soft'; -econst OILS_SETTING_HOLD_HARD_BOUNDARY => 'circ.hold_boundary.hard'; -econst OILS_SETTING_HOLD_EXPIRE => 'circ.hold_expire_interval'; -econst OILS_SETTING_HOLD_ESIMATE_WAIT_INTERVAL => 'circ.holds.default_estimated_wait_interval'; -econst OILS_SETTING_VOID_LOST_ON_CHECKIN => 'circ.void_lost_on_checkin'; -econst OILS_SETTING_MAX_ACCEPT_RETURN_OF_LOST => 'circ.max_accept_return_of_lost'; -econst OILS_SETTING_VOID_LOST_PROCESS_FEE_ON_CHECKIN => 'circ.void_lost_proc_fee_on_checkin'; -econst OILS_SETTING_RESTORE_OVERDUE_ON_LOST_RETURN => 'circ.restore_overdue_on_lost_return'; -econst OILS_SETTING_LOST_IMMEDIATELY_AVAILABLE => 'circ.lost_immediately_available'; -econst OILS_SETTING_BLOCK_HOLD_FOR_EXPIRED_PATRON => 'circ.holds.expired_patron_block'; - - - - -econst OILS_HOLD_TYPE_COPY => 'C'; -econst OILS_HOLD_TYPE_FORCE => 'F'; -econst OILS_HOLD_TYPE_RECALL => 'R'; -econst OILS_HOLD_TYPE_ISSUANCE => 'I'; -econst OILS_HOLD_TYPE_VOLUME => 'V'; -econst OILS_HOLD_TYPE_TITLE => 'T'; -econst OILS_HOLD_TYPE_METARECORD => 'M'; - - -econst OILS_BILLING_TYPE_OVERDUE_MATERIALS => 'Overdue materials'; -econst OILS_BILLING_TYPE_COLLECTION_FEE => 'Long Overdue Collection Fee'; -econst OILS_BILLING_TYPE_DEPOSIT => 'System: Deposit'; -econst OILS_BILLING_TYPE_RENTAL => 'System: Rental'; -econst OILS_BILLING_NOTE_SYSTEM => 'SYSTEM GENERATED'; - -econst OILS_ACQ_DEBIT_TYPE_PURCHASE => 'purchase'; -econst OILS_ACQ_DEBIT_TYPE_TRANSFER => 'xfer'; - -# all penalties with ID < 100 are managed automatically -econst OILS_PENALTY_AUTO_ID => 100; -econst OILS_PENALTY_PATRON_EXCEEDS_FINES => 1; -econst OILS_PENALTY_PATRON_EXCEEDS_OVERDUE_COUNT => 2; -econst OILS_PENALTY_INVALID_PATRON_ADDRESS => 29; - - -econst OILS_BILLING_TYPE_NOTIFICATION_FEE => 9; - - - -# --------------------------------------------------------------------- -# finally, export all the constants -# --------------------------------------------------------------------- -%EXPORT_TAGS = ( const => [ @EXPORT_OK ] ); - diff --git a/Open-ILS/src/perlmods/OpenILS/Event.pm b/Open-ILS/src/perlmods/OpenILS/Event.pm deleted file mode 100644 index 805859d41a..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Event.pm +++ /dev/null @@ -1,91 +0,0 @@ -package OpenILS::Event; -# vim:noet:ts=4 -use strict; use warnings; -use XML::LibXML; -use OpenSRF::Utils::SettingsClient; -use OpenSRF::Utils::Logger; -my $logger = "OpenSRF::Utils::Logger"; - - -# Returns a new Event data hash (not a blessed object) -# The first param is the event name -# Following the first param is an optional hash of params: -# perm => the name of the permission error for permimssion errors -# permloc => the location of the permission error for permission errors -# payload => the payload to be returned on successfull events - - -my $events = undef; -my $descs = undef; - -sub new { - my( $class, $event, %params ) = @_; - _load_events() unless $events; - - throw OpenSRF::EX ("Bad event name: $event") unless $event; - my $e = $events->{$event}; - $e = '' unless defined $e; - - my( $m, $f, $l ) = caller(0); - my( $mm, $ff, $ll ) = caller(1); - my( $mmm, $fff, $lll ) = caller(2); - - $f ||= ""; - $l ||= ""; - $ff ||= ""; - $ll ||= ""; - $fff ||= ""; - $lll ||= ""; - - my $lang = 'en-US'; # assume english for now - - my $t = CORE::localtime(); - - return { - ilsevent => $e, - textcode => $event, - stacktrace => "$f:$l $ff:$ll $fff:$lll", - desc => $descs->{$lang}->{$e || ''} || '', - servertime => $t, - pid => $$, %params - }; -} - -sub _load_events { - my $settings_client = OpenSRF::Utils::SettingsClient->new(); - my $eventsxml = $settings_client->config_value( "ils_events" ); - - if(!$eventsxml) { - throw OpenSRF::EX ("No ils_events file found in settings config"); - } - - $logger->info("Loading events xml file $eventsxml"); - - my $doc = XML::LibXML->new->parse_file($eventsxml); - - my @nodes = $doc->documentElement->findnodes('//event'); - for my $node (@nodes) { - $events->{$node->getAttribute('textcode')} = - $node->getAttribute('code'); - } - - $descs = {}; - my @desc = $doc->documentElement->findnodes('//desc'); - for my $d (@desc) { - my $lang = $d->getAttributeNS('http://www.w3.org/XML/1998/namespace', 'lang'); - my $code = $d->parentNode->getAttribute('code'); - unless ($descs && $lang && exists $descs->{$lang}) { - $descs->{$lang} = {}; - if (!$descs) { - $logger->error("No error description nodes found in $eventsxml."); - } - if (!$lang) { - $logger->error("No xml:lang attribute found for node in $eventsxml."); - } - } - $descs->{$lang}->{$code} = $d->textContent; - } -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Perm.pm b/Open-ILS/src/perlmods/OpenILS/Perm.pm deleted file mode 100644 index 0bfbeb7a5c..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Perm.pm +++ /dev/null @@ -1,23 +0,0 @@ -package OpenILS::Perm; -use strict; use warnings; -use Template; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Utils::Fieldmapper; -use OpenSRF::EX qw(:try); -use OpenSRF::AppSession; -use OpenSRF::Utils::Logger; - -# ---------------------------------------------------------------------------------- -# These permission strings -# ---------------------------------------------------------------------------------- - -# returns a new fieldmapper::perm_ex -my $logger = 'OpenSRF::Utils::Logger'; - -sub new { - my($class, $type) = @_; - $logger->warn("Returning permission error: $type"); - return bless( { ilsevent => 5000, ilsperm => $type }, 'OpenILS::Perm'); -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Reporter/Proxy.pm b/Open-ILS/src/perlmods/OpenILS/Reporter/Proxy.pm deleted file mode 100644 index d70d359b31..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Reporter/Proxy.pm +++ /dev/null @@ -1,162 +0,0 @@ -package OpenILS::Reporter::Proxy; -use strict; use warnings; - -use Apache2::Log; -use Apache2::Const -compile => qw(REDIRECT FORBIDDEN OK NOT_FOUND DECLINED :log); -use APR::Const -compile => qw(:error SUCCESS); -use CGI; -use Data::Dumper; -use Digest::MD5 qw/md5_hex/; - -use OpenSRF::EX qw(:try); -use OpenSRF::System; - - -# set the bootstrap config and template include directory when -# this module is loaded -my $bootstrap; - -sub import { - my $self = shift; - $bootstrap = shift; -} - - -sub child_init { - OpenSRF::System->bootstrap_client( config_file => $bootstrap ); -} - -sub handler { - my $apache = shift; - my $cgi = new CGI; - my $auth_ses = $cgi->cookie('ses'); - my $ws_ou = $cgi->cookie('ws_ou') || 1; - - my $url = $cgi->url; - - # push everyone to the secure site - if ($url =~ /^http:/o) { - $url =~ s/^http:/https:/o; - print "Location: $url\n\n"; - return Apache2::Const::OK; - } - - if (!$auth_ses) { - my $u = $cgi->param('user'); - my $p = $cgi->param('passwd'); - - if (!$u) { - - print $cgi->header(-type=>'text/html', -expires=>'-1d'); - print <<" HTML"; - - - - Report Output Login - - -


-
-
- - - - - - - - - - - - -
Please log in to view reports
Username or barcode:
Password:
- -
-
- - - - HTML - return Apache2::Const::OK; - } - - $auth_ses = oils_login($u, $p); - if ($auth_ses) { - print $cgi->redirect( - -uri=>$url, - -cookie=>$cgi->cookie( - -name=>'ses', - -value=>$auth_ses, - -path=>'/',-expires=>'+1h' - ) - ); - return Apache2::Const::REDIRECT; - } - } - - my $user = verify_login($auth_ses); - return Apache2::Const::FORBIDDEN unless ($user); - - my $failures = OpenSRF::AppSession - ->create('open-ils.actor') - ->request('open-ils.actor.user.perm.check', $auth_ses, $user->id, $ws_ou, ['VIEW_REPORT_OUTPUT']) - ->gather(1); - - return Apache2::Const::FORBIDDEN if (@$failures > 0); - - # they're good, let 'em through - return Apache2::Const::DECLINED if (-e $apache->filename); - - # oops, file not found - return Apache2::Const::NOT_FOUND; -} - -# returns the user object if the session is valid, 0 otherwise -sub verify_login { - my $auth_token = shift; - return undef unless $auth_token; - - my $user = OpenSRF::AppSession - ->create("open-ils.auth") - ->request( "open-ils.auth.session.retrieve", $auth_token ) - ->gather(1); - - if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) { - return undef; - } - - return $user if ref($user); - return undef; -} - -sub oils_login { - my( $username, $password, $type ) = @_; - - $type |= "staff"; - my $nametype = 'username'; - $nametype = 'barcode' if ($username =~ /^\d+$/o); - - my $seed = OpenSRF::AppSession - ->create("open-ils.auth") - ->request( 'open-ils.auth.authenticate.init', $username ) - ->gather(1); - - return undef unless $seed; - - my $response = OpenSRF::AppSession - ->create("open-ils.auth") - ->request( 'open-ils.auth.authenticate.complete', - { $nametype => $username, - password => md5_hex($seed . md5_hex($password)), - type => $type }) - ->gather(1); - - return undef unless $response; - - return $response->{payload}->{authtoken}; -} - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Reporter/SQLBuilder.pm b/Open-ILS/src/perlmods/OpenILS/Reporter/SQLBuilder.pm deleted file mode 100644 index 637cbc50d8..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Reporter/SQLBuilder.pm +++ /dev/null @@ -1,1243 +0,0 @@ -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder; - -sub new { - my $class = shift; - $class = ref($class) || $class; - - return bless { _sql => undef } => $class; -} - -sub register_params { - my $self = shift; - my $p = shift; - $self->{_params} = $p; -} - -sub get_param { - my $self = shift; - my $p = shift; - return $self->{_builder}->{_params}->{$p}; -} - -sub set_builder { - my $self = shift; - $self->{_builder} = shift; - return $self; -} - -sub builder { - my $self = shift; - return $self->{_builder}; -} - -sub relative_time { - my $self = shift; - my $t = shift; - $self->builder->{_relative_time} = $t if (defined $t); - return $self->builder->{_relative_time}; -} - -sub resolve_param { - my $self = shift; - my $val = shift; - - if (defined($val) && $val =~ /^::(.+)$/o) { - $val = $self->get_param($1); - } - - if (defined($val) && !ref($val)) { - $val =~ s/\\/\\\\/go; - $val =~ s/"/\\"/go; - } - - return $val; -} - -sub parse_report { - my $self = shift; - my $report = shift; - - my $rs = OpenILS::Reporter::SQLBuilder::ResultSet->new; - - if (!$report->{order_by} || @{$report->{order_by}} == 0) { - $report->{order_by} = $report->{select}; - } - - $rs->is_subquery( 1 ) if ( $report->{alias} ); - - $rs ->set_builder( $self ) - ->set_subquery_alias( $report->{alias} ) - ->set_select( $report->{select} ) - ->set_from( $report->{from} ) - ->set_where( $report->{where} ) - ->set_having( $report->{having} ) - ->set_order_by( $report->{order_by} ) - ->set_pivot_data( $report->{pivot_data} ) - ->set_pivot_label( $report->{pivot_label} ) - ->set_pivot_default( $report->{pivot_default} ); - - return $rs; -} - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::ResultSet; -use base qw/OpenILS::Reporter::SQLBuilder/; - -sub is_subquery { - my $self = shift; - my $flag = shift; - $self->{_is_subquery} = $flag if (defined $flag); - return $self->{_is_subquery}; -} - -sub pivot_data { - my $self = shift; - return $self->builder->{_pivot_data}; -} - -sub pivot_label { - my $self = shift; - return $self->builder->{_pivot_label}; -} - -sub pivot_default { - my $self = shift; - return $self->builder->{_pivot_default}; -} - -sub set_pivot_default { - my $self = shift; - my $p = shift; - $self->builder->{_pivot_default} = $p if (defined $p); - return $self; -} - -sub set_pivot_data { - my $self = shift; - my $p = shift; - $self->builder->{_pivot_data} = $p if (defined $p); - return $self; -} - -sub set_pivot_label { - my $self = shift; - my $p = shift; - $self->builder->{_pivot_label} = $p if (defined $p); - return $self; -} - -sub set_subquery_alias { - my $self = shift; - my $alias = shift; - $self->{_alias} = $alias if (defined $alias); - return $self; -} - -sub set_select { - my $self = shift; - my @cols = @_; - - $self->{_select} = []; - - return $self unless (@cols && defined($cols[0])); - @cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY'); - - push @{ $self->{_select} }, map { OpenILS::Reporter::SQLBuilder::Column::Select->new( $_ )->set_builder( $self->builder ) } @cols; - - return $self; -} - -sub set_from { - my $self = shift; - my $f = shift; - - $self->{_from} = OpenILS::Reporter::SQLBuilder::Relation->parse( $f, $self->builder ); - - return $self; -} - -sub set_where { - my $self = shift; - my @cols = @_; - - $self->{_where} = []; - - return $self unless (@cols && defined($cols[0])); - @cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY'); - - push @{ $self->{_where} }, map { OpenILS::Reporter::SQLBuilder::Column::Where->new( $_ )->set_builder( $self->builder ) } @cols; - - return $self; -} - -sub set_having { - my $self = shift; - my @cols = @_; - - $self->{_having} = []; - - return $self unless (@cols && defined($cols[0])); - @cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY'); - - push @{ $self->{_having} }, map { OpenILS::Reporter::SQLBuilder::Column::Having->new( $_ )->set_builder( $self->builder ) } @cols; - - return $self; -} - -sub set_order_by { - my $self = shift; - my @cols = @_; - - $self->{_order_by} = []; - - return $self unless (@cols && defined($cols[0])); - @cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY'); - - push @{ $self->{_order_by} }, map { OpenILS::Reporter::SQLBuilder::Column::OrderBy->new( $_ )->set_builder( $self->builder ) } @cols; - - return $self; -} - -sub column_label_list { - my $self = shift; - - my @labels; - push @labels, $self->resolve_param( $_->{_alias} ) for ( @{ $self->{_select} } ); - return @labels; -} - -sub group_by_list { - my $self = shift; - my $base = shift; - $base = 1 unless (defined $base); - - my $seen_label = 0; - my $gcount = $base; - my @group_by; - for my $c ( @{ $self->{_select} } ) { - if ($base == 0 && !$seen_label && defined($self->pivot_label) && $gcount == $self->pivot_label - 1) { - $seen_label++; - next; - } - push @group_by, $gcount if (!$c->is_aggregate); - $gcount++; - } - - return @group_by; -} - -sub toSQL { - my $self = shift; - - return $self->{_sql} if ($self->{_sql}); - - my $sql = ''; - - if ($self->is_subquery) { - $sql = '('; - } - - $sql .= "SELECT\t" . join(",\n\t", map { $_->toSQL } @{ $self->{_select} }) . "\n" if (@{ $self->{_select} }); - $sql .= " FROM\t" . $self->{_from}->toSQL . "\n" if ($self->{_from}); - $sql .= " WHERE\t" . join("\n\tAND ", map { $_->toSQL } @{ $self->{_where} }) . "\n" if (@{ $self->{_where} }); - - my @group_by = $self->group_by_list; - - $sql .= ' GROUP BY ' . join(', ', @group_by) . "\n" if (@group_by); - $sql .= " HAVING " . join("\n\tAND ", map { $_->toSQL } @{ $self->{_having} }) . "\n" if (@{ $self->{_having} }); - $sql .= ' ORDER BY ' . join(', ', map { $_->toSQL } @{ $self->{_order_by} }) . "\n" if (@{ $self->{_order_by} }); - - if ($self->is_subquery) { - $sql .= ') '. $self->{_alias} . "\n"; - } - - return $self->{_sql} = $sql; -} - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Input; -use base qw/OpenILS::Reporter::SQLBuilder/; - -sub new { - my $class = shift; - my $self = $class->SUPER::new; - - my $col_data = shift; - - if (ref($col_data)) { - $self->{params} = $col_data->{params}; - my $trans = $col_data->{transform} || 'Bare'; - my $pkg = "OpenILS::Reporter::SQLBuilder::Input::Transform::$trans"; - if (UNIVERSAL::can($pkg => 'toSQL')) { - $self->{_transform} = $trans; - } else { - $self->{_transform} = 'GenericTransform'; - } - } elsif( defined($col_data) ) { - $self->{_transform} = 'Bare'; - $self->{params} = $col_data; - } else { - $self->{_transform} = 'NULL'; - } - - - - return $self; -} - -sub toSQL { - my $self = shift; - my $type = $self->{_transform}; - return $self->{_sql} if ($self->{_sql}); - my $toSQL = "OpenILS::Reporter::SQLBuilder::Input::Transform::${type}::toSQL"; - return $self->{_sql} = $self->$toSQL; -} - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Input::Transform::GenericTransform; - -sub toSQL { - my $self = shift; - my $func = $self->{transform}; - - my @params; - @params = @{ $self->{params} } if ($self->{params}); - - my $sql = $func . '(\''; - $sql .= join("','", @params) if (@params); - $sql .= '\')'; - - return $sql; -} - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Input::Transform::NULL; - -sub toSQL { - return "NULL"; -} - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Input::Transform::Bare; - -sub toSQL { - my $self = shift; - - my $val = $self->{params}; - $val = $$val[0] if (ref($val)); - - $val =~ s/\\/\\\\/go; - $val =~ s/'/\\'/go; - - return "'$val'"; -} - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Input::Transform::age; - -sub toSQL { - my $self = shift; - - my $val = $self->{params}; - $val = $$val[0] if (ref($val)); - - $val =~ s/\\/\\\\/go; - $val =~ s/'/\\'/go; - - return "AGE(NOW(),'" . $val . "'::TIMESTAMPTZ)"; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Input::Transform::relative_year; - -sub toSQL { - my $self = shift; - - my $rtime = $self->relative_time || 'now'; - - $rtime =~ s/\\/\\\\/go; - $rtime =~ s/'/\\'/go; - - my $val = $self->{params}; - $val = $$val[0] if (ref($val)); - - $val =~ s/\\/\\\\/go; - $val =~ s/'/\\'/go; - - return "EXTRACT(YEAR FROM '$rtime'::TIMESTAMPTZ + '$val years')"; -} - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Input::Transform::relative_month; - -sub toSQL { - my $self = shift; - - my $rtime = $self->relative_time || 'now'; - - $rtime =~ s/\\/\\\\/go; - $rtime =~ s/'/\\'/go; - - my $val = $self->{params}; - $val = $$val[0] if (ref($val)); - - $val =~ s/\\/\\\\/go; - $val =~ s/'/\\'/go; - - return "EXTRACT(YEAR FROM '$rtime'::TIMESTAMPTZ + '$val months')" . - " || '-' || LPAD(EXTRACT(MONTH FROM '$rtime'::TIMESTAMPTZ + '$val months')::text,2,'0')"; -} - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Input::Transform::relative_date; - -sub toSQL { - my $self = shift; - - my $rtime = $self->relative_time || 'now'; - - $rtime =~ s/\\/\\\\/go; - $rtime =~ s/'/\\'/go; - - my $val = $self->{params}; - $val = $$val[0] if (ref($val)); - - $val =~ s/\\/\\\\/go; - $val =~ s/'/\\'/go; - - return "DATE('$rtime'::TIMESTAMPTZ + '$val days')"; -} - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Input::Transform::relative_week; - -sub toSQL { - my $self = shift; - - my $rtime = $self->relative_time || 'now'; - - $rtime =~ s/\\/\\\\/go; - $rtime =~ s/'/\\'/go; - - my $val = $self->{params}; - $val = $$val[0] if (ref($val)); - - $val =~ s/\\/\\\\/go; - $val =~ s/'/\\'/go; - - return "EXTRACT(WEEK FROM '$rtime'::TIMESTAMPTZ + '$val weeks')"; -} - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column; -use base qw/OpenILS::Reporter::SQLBuilder/; - -sub new { - my $class = shift; - my $self = $class->SUPER::new; - - my $col_data = shift; - $self->{_relation} = $col_data->{relation}; - $self->{_column} = $col_data->{column}; - - $self->{_aggregate} = $col_data->{aggregate}; - - if (ref($self->{_column})) { - my $trans = $self->{_column}->{transform} || 'Bare'; - my $pkg = "OpenILS::Reporter::SQLBuilder::Column::Transform::$trans"; - if (UNIVERSAL::can($pkg => 'toSQL')) { - $self->{_transform} = $trans; - } else { - $self->{_transform} = 'GenericTransform'; - } - } elsif( defined($self->{_column}) ) { - $self->{_transform} = 'Bare'; - } else { - $self->{_transform} = 'NULL'; - } - - - return $self; -} - -sub find_relation { - my $self = shift; - return $self->builder->{_rels}->{$self->{_relation}}; -} - -sub name { - my $self = shift; - if (ref($self->{_column})) { - return $self->{_column}->{colname}; - } else { - return $self->{_column}; - } -} - -sub toSQL { - my $self = shift; - my $type = $self->{_transform}; - return $self->{_sql} if ($self->{_sql}); - my $toSQL = "OpenILS::Reporter::SQLBuilder::Column::Transform::${type}::toSQL"; - return $self->{_sql} = $self->$toSQL; -} - -sub is_aggregate { - my $self = shift; - my $type = $self->{_transform}; - my $is_agg = "OpenILS::Reporter::SQLBuilder::Column::Transform::${type}::is_aggregate"; - return $self->$is_agg; -} - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::OrderBy; -use base qw/OpenILS::Reporter::SQLBuilder::Column/; - -sub new { - my $class = shift; - my $self = $class->SUPER::new(@_); - - my $col_data = shift; - $self->{_direction} = $col_data->{direction} || 'ascending'; - return $self; -} - -sub toSQL { - my $self = shift; - my $dir = ($self->{_direction} =~ /^d/oi) ? 'DESC' : 'ASC'; - return $self->{_sql} if ($self->{_sql}); - return $self->{_sql} = $self->SUPER::toSQL . " $dir"; -} - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Select; -use base qw/OpenILS::Reporter::SQLBuilder::Column/; - -sub new { - my $class = shift; - my $self = $class->SUPER::new(@_); - - my $col_data = shift; - $self->{_alias} = $col_data->{alias} || $self->name; - return $self; -} - -sub toSQL { - my $self = shift; - return $self->{_sql} if ($self->{_sql}); - return $self->{_sql} = $self->SUPER::toSQL . ' AS "' . $self->resolve_param( $self->{_alias} ) . '"'; -} - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::GenericTransform; - -sub toSQL { - my $self = shift; - my $name = $self->name; - my $func = $self->{_column}->{transform}; - - my @params; - @params = @{ $self->resolve_param( $self->{_column}->{params} ) } if ($self->{_column}->{params}); - - my $sql = $func . '("' . $self->{_relation} . '"."' . $self->name . '"'; - $sql .= ",'" . join("','", @params) . "'" if (@params); - $sql .= ')'; - - return $sql; -} - -sub is_aggregate { return $self->{_aggregate} } - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::Bare; - -sub toSQL { - my $self = shift; - return '"' . $self->{_relation} . '"."' . $self->name . '"'; -} - -sub is_aggregate { return 0 } - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::upper; - -sub toSQL { - my $self = shift; - my $params = $self->resolve_param( $self->{_column}->{params} ); - my $start = $$params[0]; - my $len = $$params[1]; - return 'UPPER("' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::lower; - -sub toSQL { - my $self = shift; - my $params = $self->resolve_param( $self->{_column}->{params} ); - my $start = $$params[0]; - my $len = $$params[1]; - return 'LOWER("' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::substring; - -sub toSQL { - my $self = shift; - my $params = $self->resolve_param( $self->{_column}->{params} ); - my $start = $$params[0]; - my $len = $$params[1]; - return 'SUBSTRING("' . $self->{_relation} . '"."' . $self->name . "\",$start,$len)"; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::day_name; - -sub toSQL { - my $self = shift; - return 'TO_CHAR("' . $self->{_relation} . '"."' . $self->name . '", \'Day\')'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::month_name; - -sub toSQL { - my $self = shift; - return 'TO_CHAR("' . $self->{_relation} . '"."' . $self->name . '", \'Month\')'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::doy; - -sub toSQL { - my $self = shift; - return 'EXTRACT(DOY FROM "' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::woy; - -sub toSQL { - my $self = shift; - return 'EXTRACT(WEEK FROM "' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::moy; - -sub toSQL { - my $self = shift; - return 'EXTRACT(MONTH FROM "' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::qoy; - -sub toSQL { - my $self = shift; - return 'EXTRACT(QUARTER FROM "' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::dom; - -sub toSQL { - my $self = shift; - return 'EXTRACT(DAY FROM "' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::dow; - -sub toSQL { - my $self = shift; - return 'EXTRACT(DOW FROM "' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::year_trunc; - -sub toSQL { - my $self = shift; - return 'EXTRACT(YEAR FROM "' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::month_trunc; - -sub toSQL { - my $self = shift; - return 'EXTRACT(YEAR FROM "' . $self->{_relation} . '"."' . $self->name . '")' . - ' || \'-\' || LPAD(EXTRACT(MONTH FROM "' . $self->{_relation} . '"."' . $self->name . '")::text,2,\'0\')'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::date_trunc; - -sub toSQL { - my $self = shift; - return 'DATE("' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::hour_trunc; - -sub toSQL { - my $self = shift; - return 'EXTRACT(HOUR FROM "' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::quarter; - -sub toSQL { - my $self = shift; - return 'EXTRACT(YEAR FROM "' . $self->{_relation} . '"."' . $self->name . '")' . - ' || \'-Q\' || EXTRACT(QUARTER FROM "' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::months_ago; - -sub toSQL { - my $self = shift; - return 'EXTRACT(MONTH FROM AGE(NOW(),"' . $self->{_relation} . '"."' . $self->name . '"))'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::hod; - -sub toSQL { - my $self = shift; - return 'EXTRACT(HOUR FROM "' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::quarters_ago; - -sub toSQL { - my $self = shift; - return 'EXTRACT(QUARTER FROM AGE(NOW(),"' . $self->{_relation} . '"."' . $self->name . '"))'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::age; - -sub toSQL { - my $self = shift; - return 'AGE(NOW(),"' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 0 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::first; - -sub toSQL { - my $self = shift; - return 'FIRST("' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 1 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::last; - -sub toSQL { - my $self = shift; - return 'LAST("' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 1 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::min; - -sub toSQL { - my $self = shift; - return 'MIN("' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 1 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::max; - -sub toSQL { - my $self = shift; - return 'MAX("' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 1 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::count; - -sub toSQL { - my $self = shift; - return 'COUNT("' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 1 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::count_distinct; - -sub toSQL { - my $self = shift; - return 'COUNT(DISTINCT "' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 1 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::sum; - -sub toSQL { - my $self = shift; - return 'SUM("' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 1 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Transform::average; - -sub toSQL { - my $self = shift; - return 'AVG("' . $self->{_relation} . '"."' . $self->name . '")'; -} - -sub is_aggregate { return 1 } - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Where; -use base qw/OpenILS::Reporter::SQLBuilder::Column/; - -sub new { - my $class = shift; - my $self = $class->SUPER::new(@_); - - my $col_data = shift; - $self->{_condition} = $col_data->{condition}; - - return $self; -} - -sub _flesh_conditions { - my $cond = shift; - my $builder = shift; - $cond = [$cond] unless (ref($cond) eq 'ARRAY'); - - my @out; - for my $c (@$cond) { - push @out, OpenILS::Reporter::SQLBuilder::Input->new( $c )->set_builder( $builder ); - } - - return \@out; -} - -sub toSQL { - my $self = shift; - - return $self->{_sql} if ($self->{_sql}); - - my $sql = ''; - - my $rel = $self->find_relation(); - if ($rel && $rel->is_nullable) { - $sql = "((". $self->SUPER::toSQL .") IS NULL OR "; - } - - $sql .= $self->SUPER::toSQL; - - my ($op) = keys %{ $self->{_condition} }; - my $val = _flesh_conditions( $self->resolve_param( $self->{_condition}->{$op} ), $self->builder ); - - if (lc($op) eq 'in') { - $sql .= " IN (". join(",", map { $_->toSQL } @$val).")"; - - } elsif (lc($op) eq 'not in') { - $sql .= " NOT IN (". join(",", map { $_->toSQL } @$val).")"; - - } elsif (lc($op) eq '= any') { - $val = $$val[0] if (ref($val) eq 'ARRAY'); - $val = $val->toSQL; - if ($rel && $rel->is_nullable) { # need to redo this - $sql = "((". $self->SUPER::toSQL .") IS NULL OR "; - } else { - $sql = ''; - } - $sql .= "$val = ANY (".$self->SUPER::toSQL.")"; - - } elsif (lc($op) eq '<> any') { - $val = $$val[0] if (ref($val) eq 'ARRAY'); - $val = $val->toSQL; - if ($rel && $rel->is_nullable) { # need to redo this - $sql = "((". $self->SUPER::toSQL .") IS NULL OR "; - } else { - $sql = ''; - } - $sql .= "$val <> ANY (".$self->SUPER::toSQL.")"; - - } elsif (lc($op) eq 'is blank') { - if ($rel && $rel->is_nullable) { # need to redo this - $sql = "((". $self->SUPER::toSQL .") IS NULL OR "; - } else { - $sql = ''; - } - $sql .= '('. $self->SUPER::toSQL ." IS NULL OR ". $self->SUPER::toSQL ." = '')"; - - } elsif (lc($op) eq 'is not blank') { - if ($rel && $rel->is_nullable) { # need to redo this - $sql = "((". $self->SUPER::toSQL .") IS NULL OR "; - } else { - $sql = ''; - } - $sql .= '('. $self->SUPER::toSQL ." IS NOT NULL AND ". $self->SUPER::toSQL ." <> '')"; - - } elsif (lc($op) eq 'between') { - $sql .= " BETWEEN ". join(" AND ", map { $_->toSQL } @$val); - - } elsif (lc($op) eq 'not between') { - $sql .= " NOT BETWEEN ". join(" AND ", map { $_->toSQL } @$val); - - } elsif (lc($op) eq 'like') { - $val = $$val[0] if (ref($val) eq 'ARRAY'); - $val = $val->toSQL; - $val =~ s/^'(.*)'$/$1/o; - $val =~ s/%/\\\\%/o; - $val =~ s/_/\\\\_/o; - $sql .= " LIKE '\%$val\%'"; - - } elsif (lc($op) eq 'ilike') { - $val = $$val[0] if (ref($val) eq 'ARRAY'); - $val = $val->toSQL; - $val =~ s/^'(.*)'$/$1/o; - $val =~ s/%/\\\\%/o; - $val =~ s/_/\\\\_/o; - $sql .= " ILIKE '\%$val\%'"; - - } else { - $val = $$val[0] if (ref($val) eq 'ARRAY'); - $sql .= " $op " . $val->toSQL; - } - - if ($rel && $rel->is_nullable) { - $sql .= ")"; - } - - return $self->{_sql} = $sql; -} - - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Column::Having; -use base qw/OpenILS::Reporter::SQLBuilder::Column::Where/; - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Relation; -use base qw/OpenILS::Reporter::SQLBuilder/; - -sub parse { - my $self = shift; - $self = $self->SUPER::new if (!ref($self)); - - my $rel_data = shift; - my $b = shift; - $self->set_builder($b); - - $self->{_table} = $rel_data->{table}; - $self->{_alias} = $rel_data->{alias} || $self->{_table}; - $self->{_join} = []; - $self->{_columns} = []; - - $self->builder->{_rels}{$self->{_alias}} = $self; - - if ($rel_data->{join}) { - $self->add_join( - $_ => OpenILS::Reporter::SQLBuilder::Relation->parse( $rel_data->{join}->{$_}, $b ) => $rel_data->{join}->{$_}->{key} => $rel_data->{join}->{$_}->{type} - ) for ( keys %{ $rel_data->{join} } ); - } - - return $self; -} - -sub add_column { - my $self = shift; - my $col = shift; - - push @{ $self->{_columns} }, $col; -} - -sub find_column { - my $self = shift; - my $col = shift; - return (grep { $_->name eq $col} @{ $self->{_columns} })[0]; -} - -sub add_join { - my $self = shift; - my $col = shift; - my $frel = shift; - my $fkey = shift; - my $type = lc(shift()) || 'inner'; - - if (UNIVERSAL::isa($col,'OpenILS::Reporter::SQLBuilder::Join')) { - push @{ $self->{_join} }, $col; - } else { - push @{ $self->{_join} }, OpenILS::Reporter::SQLBuilder::Join->build( $self => $col, $frel => $fkey, $type ); - } - - return $self; -} - -sub is_nullable { - my $self = shift; - return $self->{_nullable}; -} - -sub is_join { - my $self = shift; - my $j = shift; - $self->{_is_join} = $j if ($j); - return $self->{_is_join}; -} - -sub join_type { - my $self = shift; - my $j = shift; - $self->{_join_type} = $j if ($j); - return $self->{_join_type}; -} - -sub toSQL { - my $self = shift; - return $self->{_sql} if ($self->{_sql}); - - my $sql = $self->{_table} .' AS "'. $self->{_alias} .'"'; - - if (!$self->is_join) { - for my $j ( @{ $self->{_join} } ) { - $sql .= $j->toSQL; - } - } - - return $self->{_sql} = $sql; -} - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Join; -use base qw/OpenILS::Reporter::SQLBuilder/; - -sub build { - my $class = shift; - my $self = $class->SUPER::new if (!ref($class)); - - $self->{_left_rel} = shift; - ($self->{_left_col}) = split(/-/,shift()); - - $self->{_right_rel} = shift; - $self->{_right_col} = shift; - - $self->{_join_type} = shift; - - $self->{_right_rel}->set_builder($self->{_left_rel}->builder); - - $self->{_right_rel}->is_join(1); - $self->{_right_rel}->join_type($self->{_join_type}); - - bless $self => "OpenILS::Reporter::SQLBuilder::Join::$self->{_join_type}"; - - if ( $self->{_join_type} eq 'inner' or !$self->{_join_type}) { - $self->{_join_type} = 'i'; - } else { - if ($self->{_join_type} eq 'left') { - $self->{_right_rel}->{_nullable} = 'l'; - } elsif ($self->{_join_type} eq 'right') { - $self->{_left_rel}->{_nullable} = 'r'; - } else { - $self->{_right_rel}->{_nullable} = 'f'; - $self->{_left_rel}->{_nullable} = 'f'; - } - } - - return $self; -} - -sub toSQL { - my $self = shift; - my $dir = shift; - - my $sql = "JOIN " . $self->{_right_rel}->toSQL . - ' ON ("' . $self->{_left_rel}->{_alias} . '"."' . $self->{_left_col} . - '" = "' . $self->{_right_rel}->{_alias} . '"."' . $self->{_right_col} . '")'; - - $sql .= $_->toSQL($dir) for (@{ $self->{_right_rel}->{_join} }); - - return $sql; -} - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Join::left; -use base qw/OpenILS::Reporter::SQLBuilder::Join/; - -sub toSQL { - my $self = shift; - my $dir = shift; - #return $self->{_sql} if ($self->{_sql}); - - my $j = $dir && $dir eq 'r' ? 'FULL OUTER' : 'LEFT OUTER'; - - my $sql = "\n\t$j ". $self->SUPER::toSQL('l'); - - #$sql .= $_->toSQL for (@{ $self->{_right_rel}->{_join} }); - - return $self->{_sql} = $sql; -} - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Join::right; -use base qw/OpenILS::Reporter::SQLBuilder::Join/; - -sub toSQL { - my $self = shift; - my $dir = shift; - #return $self->{_sql} if ($self->{_sql}); - - my $_nullable_rel = $dir && $dir eq 'l' ? '_right_rel' : '_left_rel'; - $self->{_left_rel}->{_nullable} = 'r'; - $self->{$_nullable_rel}->{_nullable} = $dir; - - my $j = $dir && $dir eq 'l' ? 'FULL OUTER' : 'RIGHT OUTER'; - - my $sql = "\n\t$j ". $self->SUPER::toSQL('r'); - - #$sql .= $_->toSQL for (@{ $self->{_right_rel}->{_join} }); - - return $self->{_sql} = $sql; -} - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Join::inner; -use base qw/OpenILS::Reporter::SQLBuilder::Join/; - -sub toSQL { - my $self = shift; - my $dir = shift; - #return $self->{_sql} if ($self->{_sql}); - - my $_nullable_rel = $dir && $dir eq 'l' ? '_right_rel' : '_left_rel'; - $self->{$_nullable_rel}->{_nullable} = $dir; - - my $j = $dir ? ( $dir eq 'l' ? 'LEFT OUTER' : ( $dir eq 'r' ? 'RIGHT OUTER' : 'FULL OUTER' ) ) : 'INNER'; - - my $sql = "\n\t$j ". $self->SUPER::toSQL; - - #$sql .= $_->toSQL for (@{ $self->{_right_rel}->{_join} }); - - return $self->{_sql} = $sql; -} - -#------------------------------------------------------------------------------------------------- -package OpenILS::Reporter::SQLBuilder::Join::cross; -use base qw/OpenILS::Reporter::SQLBuilder::Join/; - -sub toSQL { - my $self = shift; - #return $self->{_sql} if ($self->{_sql}); - - $self->{_right_rel}->{_nullable} = 'f'; - $self->{_left_rel}->{_nullable} = 'f'; - - my $sql = "\n\tFULL OUTER ". $self->SUPER::toSQL('f'); - - #$sql .= $_->toSQL for (@{ $self->{_right_rel}->{_join} }); - - return $self->{_sql} = $sql; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/SIP.pm b/Open-ILS/src/perlmods/OpenILS/SIP.pm deleted file mode 100644 index fe312ffd2f..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/SIP.pm +++ /dev/null @@ -1,693 +0,0 @@ -# -# ILS.pm: Test ILS interface module -# - -package OpenILS::SIP; -use warnings; use strict; - -use Sys::Syslog qw(syslog); -use Time::HiRes q/time/; - -use OpenILS::SIP::Item; -use OpenILS::SIP::Patron; -use OpenILS::SIP::Transaction; -use OpenILS::SIP::Transaction::Checkout; -use OpenILS::SIP::Transaction::Checkin; -use OpenILS::SIP::Transaction::Renew; - -use OpenSRF::System; -use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Application::AppUtils; -use OpenSRF::Utils qw/:datetime/; -use DateTime::Format::ISO8601; -use Encode; -use Unicode::Normalize; -my $U = 'OpenILS::Application::AppUtils'; - -my $editor; -my $config; -my $target_encoding; # FIXME: this is configured at the institution level. - -use Digest::MD5 qw(md5_hex); - -sub new { - my ($class, $institution, $login) = @_; - my $type = ref($class) || $class; - my $self = {}; - - $self->{login} = $login; - - $config = $institution; - syslog("LOG_DEBUG", "OILS: new ILS '%s'", $institution->{id}); - $self->{institution} = $institution; - - my $bsconfig = $institution->{implementation_config}->{bootstrap}; - $target_encoding = $institution->{implementation_config}->{encoding} || 'ascii'; - - syslog('LOG_DEBUG', "OILS: loading bootstrap config: $bsconfig"); - - local $/ = "\n"; # why? - OpenSRF::System->bootstrap_client(config_file => $bsconfig); - syslog('LOG_DEBUG', "OILS: bootstrap loaded.."); - - $self->{osrf_config} = OpenSRF::Utils::SettingsClient->new; - - Fieldmapper->import($self->{osrf_config}->config_value('IDL')); - - bless( $self, $type ); - - return undef unless - $self->login( $login->{id}, $login->{password} ); - - return $self; -} - -sub fetch_session { - my $self = shift; - - my $ses = $U->simplereq( - 'open-ils.auth', - 'open-ils.auth.session.retrieve', $self->{authtoken}); - - return undef if $U->event_code($ses); # auth timed out - return $self->{login_session} = $ses; -} - -sub verify_session { - my $self = shift; - - return 1 if $self->fetch_session; - - syslog('LOG_INFO', "OILS: Logging back after session timeout as user ".$self->{login}->{id}); - return $self->login( $self->{login}->{id}, $self->{login}->{password} ); -} - -sub editor { - return $editor = make_editor(); -} - -sub config { - return $config; -} - -sub get_option_value { - my($self, $option) = @_; - my $ops = $config->{implementation_config}->{options}->{option}; - $ops = [$ops] unless ref $ops eq 'ARRAY'; - my @vals = grep { $_->{name} eq $option } @$ops; - return @vals ? $vals[0]->{value} : undef; -} - - -# Creates the global editor object -my $cstore_init = 1; # call init on first use -sub make_editor { - OpenILS::Utils::CStoreEditor::init() if $cstore_init; - $cstore_init = 0; - return OpenILS::Utils::CStoreEditor->new; -} - -=head2 clean_text(scalar) - -Evergreen uses the UTF8 encoding for everything from the database up. Perl -doesn't know this, however, so we have to convince it to treat our UTF8 strings -as UTF8 strings. This may enable OpenNCIP to correctly calculate the checksums -for UTF8 text for SIP clients that support such modern options. - -The target encoding is set in the element of the SIPServer.pm -configuration file. - -=cut - -sub clean_text { - my $text = shift || ''; - - # Convert our incoming UTF8 data into Perl's internal string format - - # Also convert to Normalization Form D, as the ASCII, iso-8859-1, - # and latin-1 encodings (at least) require this to substitute - # characters rather than simply returning a string truncated - # after the first non-ASCII character - $text = NFD(decode_utf8($text)); - - if ($target_encoding eq 'ascii') { - - # Try to maintain a reasonable version of the content by - # stripping diacritics from the text, given that the SIP client - # wants just plain ASCII. This is the base requirement according - # to the SIP2 specification. - - # Stripping the combining characters converts ""béè♁ts" - # into "bee?ts" instead of "b???ts" - better, eh? - $text =~ s/\pM+//og; - } - - # Characters that cannot be represented in the target encoding will - # generally be replaced with a question mark (?) character. - $text = encode($target_encoding, $text); - - return $text; -} - -my %org_sn_cache; -sub shortname_from_id { - my $id = shift or return; - return $id->shortname if ref $id; - return $org_sn_cache{$id} if $org_sn_cache{$id}; - return $org_sn_cache{$id} = editor()->retrieve_actor_org_unit($id)->shortname; -} -sub patron_barcode_from_id { - my $id = shift or return; - return editor()->search_actor_card({ usr => $id, active => 't' })->[0]->barcode; -} - -sub format_date { - my $class = shift; - my $date = shift; - my $type = shift || 'dob'; - - return "" unless $date; - - $date = DateTime::Format::ISO8601->new-> - parse_datetime(OpenSRF::Utils::cleanse_ISO8601($date)); - my @time = localtime($date->epoch); - - my $year = $time[5]+1900; - my $mon = $time[4]+1; - my $day = $time[3]; - my $hour = $time[2]; - my $minute = $time[1]; - my $second = $time[0]; - - $date = sprintf("%04d%02d%02d", $year, $mon, $day); - - # Due dates need hyphen separators and time of day as well - if ($type eq 'due') { - $date = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year, $mon, $day, $hour, $minute, $second); - } - - syslog('LOG_DEBUG', "OILS: formatted date [type=$type]: $date"); - return $date; -} - - - -sub login { - my( $self, $username, $password ) = @_; - syslog('LOG_DEBUG', "OILS: Logging in with username $username"); - - my $seed = $U->simplereq( - 'open-ils.auth', - 'open-ils.auth.authenticate.init', $username ); - - my $response = $U->simplereq( - 'open-ils.auth', - 'open-ils.auth.authenticate.complete', - { - username => $username, - password => md5_hex($seed . md5_hex($password)), - type => 'opac', - } - ); - - if( my $code = $U->event_code($response) ) { - my $txt = $response->{textcode}; - syslog('LOG_WARNING', "OILS: Login failed for $username. $txt:$code"); - return undef; - } - - my $key = $response->{payload}->{authtoken}; - syslog('LOG_INFO', "OILS: Login succeeded for $username : authkey = $key"); - - $self->fetch_session; # to cache the login - - return $self->{authtoken} = $key; -} - - -sub find_patron { - my $self = shift; - return OpenILS::SIP::Patron->new(@_); -} - - -sub find_item { - my $self = shift; - return OpenILS::SIP::Item->new(@_); -} - - -sub institution { - my $self = shift; - return $self->{institution}->{id}; # consider making this return the whole institution -} - -sub institution_id { - my $self = shift; - return $self->{institution}->{id}; # then use this for just the ID -} - -sub supports { - my ($self, $op) = @_; - my ($i) = grep { $_->{name} eq $op } - @{$config->{implementation_config}->{supports}->{item}}; - return to_bool($i->{value}); -} - -sub check_inst_id { - my ($self, $id, $whence) = @_; - if ($id ne $self->{institution}->{id}) { - syslog("LOG_WARNING", "OILS: %s: received institution '%s', expected '%s'", $whence, $id, $self->{institution}->{id}); - # Just an FYI check, we don't expect the user to change location from that in SIPconfig.xml - } -} - - -sub to_bool { - my $bool = shift; - # If it's defined, and matches a true sort of string, or is - # a non-zero number, then it's true. - defined($bool) or return; # false - ($bool =~ /true|y|yes/i) and return 1; # true - return ($bool =~ /^\d+$/ and $bool != 0); # true for non-zero numbers, false otherwise -} - -sub checkout_ok { - return to_bool($config->{policy}->{checkout}); -} - -sub checkin_ok { - return to_bool($config->{policy}->{checkin}); -} - -sub renew_ok { - return to_bool($config->{policy}->{renew}); -} - -sub status_update_ok { - return to_bool($config->{policy}->{status_update}); -} - -sub offline_ok { - return to_bool($config->{policy}->{offline}); -} - - - -## -## Checkout(patron_id, item_id, sc_renew): -## patron_id & item_id are the identifiers send by the terminal -## sc_renew is the renewal policy configured on the terminal -## returns a status opject that can be queried for the various bits -## of information that the protocol (SIP or NCIP) needs to generate -## the response. -## - -sub checkout { - my ($self, $patron_id, $item_id, $sc_renew) = @_; - $sc_renew = 0; - - $self->verify_session; - - syslog('LOG_DEBUG', "OILS: OpenILS::Checkout attempt: patron=$patron_id, item=$item_id"); - - my $xact = OpenILS::SIP::Transaction::Checkout->new( authtoken => $self->{authtoken} ); - my $patron = $self->find_patron($patron_id); - my $item = $self->find_item($item_id); - - $xact->patron($patron); - $xact->item($item); - - if (!$patron) { - $xact->screen_msg("Invalid Patron Barcode '$patron_id'"); - return $xact; - } - - if (!$patron->charge_ok) { - $xact->screen_msg("Patron Blocked"); - return $xact; - } - - if( !$item ) { - $xact->screen_msg("Invalid Item Barcode: '$item_id'"); - return $xact; - } - - syslog('LOG_DEBUG', "OILS: OpenILS::Checkout data loaded OK, checking out..."); - - if ($item->{patron} && ($item->{patron} eq $patron_id)) { - syslog('LOG_INFO', "OILS: OpenILS::Checkout data loaded OK, doing renew..."); - $sc_renew = 1; - } elsif ($item->{patron} && ($item->{patron} ne $patron_id)) { - # I can't deal with this right now - # XXX check in then check out? - $xact->screen_msg("Item checked out to another patron"); - $xact->ok(0); - } - - $xact->do_checkout($sc_renew); - $xact->desensitize(!$item->magnetic); - - if( $xact->ok ) { - #editor()->commit; - syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " . - "patron %s checkout %s succeeded", $patron_id, $item_id); - } else { - #editor()->xact_rollback; - syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " . - "patron %s checkout %s FAILED, rolling back xact...", $patron_id, $item_id); - } - - return $xact; -} - - -sub checkin { - my ($self, $item_id, $inst_id, $trans_date, $return_date, - $current_loc, $item_props, $cancel) = @_; - - my $start_time = time(); - - $self->verify_session; - - syslog('LOG_DEBUG', "OILS: OpenILS::Checkin of item=$item_id (to $inst_id)"); - - my $xact = OpenILS::SIP::Transaction::Checkin->new(authtoken => $self->{authtoken}); - my $item = OpenILS::SIP::Item->new($item_id); - - unless ( $xact->item($item) ) { - $xact->ok(0); - # $circ->alert(1); $circ->alert_type(99); - $xact->screen_msg("Invalid Item Barcode: '$item_id'"); - syslog('LOG_INFO', "OILS: Checkin failed. " . $xact->screen_msg() ); - return $xact; - } - - $xact->do_checkin( $self, $inst_id, $trans_date, $return_date, $current_loc, $item_props ); - - if ($xact->ok) { - $xact->patron($self->find_patron(usr => $xact->{circ_user_id}, slim_user => 1)) if $xact->{circ_user_id}; - delete $item->{patron}; - delete $item->{due_date}; - syslog('LOG_INFO', "OILS: Checkin succeeded"); - } else { - syslog('LOG_WARNING', "OILS: Checkin failed"); - } - - syslog('LOG_INFO', "OILS: SIP Checkin request took %0.3f seconds", (time() - $start_time)); - return $xact; -} - -## If the ILS caches patron information, this lets it free it up. -## Also, this could be used for centrally logging session duration. -## We don't do anything with it. -sub end_patron_session { - my ($self, $patron_id) = @_; - return (1, 'Thank you!', ''); -} - - -#sub pay_fee { -# my ($self, $patron_id, $patron_pwd, $fee_amt, $fee_type, -# $pay_type, $fee_id, $trans_id, $currency) = @_; -# my $trans; -# my $patron; -# -# $trans = new ILS::Transaction::FeePayment; -# -# $patron = new ILS::Patron $patron_id; -# -# $trans->transaction_id($trans_id); -# $trans->patron($patron); -# $trans->ok(1); -# -# return $trans; -#} -# -#sub add_hold { -# my ($self, $patron_id, $patron_pwd, $item_id, $title_id, -# $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_; -# my ($patron, $item); -# my $hold; -# my $trans; -# -# -# $trans = new ILS::Transaction::Hold; -# -# # BEGIN TRANSACTION -# $patron = new ILS::Patron $patron_id; -# if (!$patron -# || (defined($patron_pwd) && !$patron->check_password($patron_pwd))) { -# $trans->screen_msg("Invalid Patron."); -# -# return $trans; -# } -# -# $item = new ILS::Item ($item_id || $title_id); -# if (!$item) { -# $trans->screen_msg("No such item."); -# -# # END TRANSACTION (conditionally) -# return $trans; -# } elsif ($item->fee && ($fee_ack ne 'Y')) { -# $trans->screen_msg = "Fee required to place hold."; -# -# # END TRANSACTION (conditionally) -# return $trans; -# } -# -# $hold = { -# item_id => $item->id, -# patron_id => $patron->id, -# expiration_date => $expiry_date, -# pickup_location => $pickup_location, -# hold_type => $hold_type, -# }; -# -# $trans->ok(1); -# $trans->patron($patron); -# $trans->item($item); -# $trans->pickup_location($pickup_location); -# -# push(@{$item->hold_queue}, $hold); -# push(@{$patron->{hold_items}}, $hold); -# -# -# # END TRANSACTION -# return $trans; -#} -# -#sub cancel_hold { -# my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_; -# my ($patron, $item, $hold); -# my $trans; -# -# $trans = new ILS::Transaction::Hold; -# -# # BEGIN TRANSACTION -# $patron = new ILS::Patron $patron_id; -# if (!$patron) { -# $trans->screen_msg("Invalid patron barcode."); -# -# return $trans; -# } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) { -# $trans->screen_msg('Invalid patron password.'); -# -# return $trans; -# } -# -# $item = new ILS::Item ($item_id || $title_id); -# if (!$item) { -# $trans->screen_msg("No such item."); -# -# # END TRANSACTION (conditionally) -# return $trans; -# } -# -# # Remove the hold from the patron's record first -# $trans->ok($patron->drop_hold($item_id)); -# -# if (!$trans->ok) { -# # We didn't find it on the patron record -# $trans->screen_msg("No such hold on patron record."); -# -# # END TRANSACTION (conditionally) -# return $trans; -# } -# -# # Now, remove it from the item record. If it was on the patron -# # record but not on the item record, we'll treat that as success. -# foreach my $i (0 .. scalar @{$item->hold_queue}) { -# $hold = $item->hold_queue->[$i]; -# -# if ($hold->{patron_id} eq $patron->id) { -# # found it: delete it. -# splice @{$item->hold_queue}, $i, 1; -# last; -# } -# } -# -# $trans->screen_msg("Hold Cancelled."); -# $trans->patron($patron); -# $trans->item($item); -# -# return $trans; -#} -# -# -## The patron and item id's can't be altered, but the -## date, location, and type can. -#sub alter_hold { -# my ($self, $patron_id, $patron_pwd, $item_id, $title_id, -# $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_; -# my ($patron, $item); -# my $hold; -# my $trans; -# -# $trans = new ILS::Transaction::Hold; -# -# # BEGIN TRANSACTION -# $patron = new ILS::Patron $patron_id; -# if (!$patron) { -# $trans->screen_msg("Invalid patron barcode."); -# -# return $trans; -# } -# -# foreach my $i (0 .. scalar @{$patron->{hold_items}}) { -# $hold = $patron->{hold_items}[$i]; -# -# if ($hold->{item_id} eq $item_id) { -# # Found it. So fix it. -# $hold->{expiration_date} = $expiry_date if $expiry_date; -# $hold->{pickup_location} = $pickup_location if $pickup_location; -# $hold->{hold_type} = $hold_type if $hold_type; -# -# $trans->ok(1); -# $trans->screen_msg("Hold updated."); -# $trans->patron($patron); -# $trans->item(new ILS::Item $hold->{item_id}); -# last; -# } -# } -# -# # The same hold structure is linked into both the patron's -# # list of hold items and into the queue of outstanding holds -# # for the item, so we don't need to search the hold queue for -# # the item, since it's already been updated by the patron code. -# -# if (!$trans->ok) { -# $trans->screen_msg("No such outstanding hold."); -# } -# -# return $trans; -#} - - -sub renew { - my ($self, $patron_id, $patron_pwd, $item_id, $title_id, - $no_block, $nb_due_date, $third_party, $item_props, $fee_ack) = @_; - - $self->verify_session; - - my $trans = OpenILS::SIP::Transaction::Renew->new( authtoken => $self->{authtoken} ); - $trans->patron($self->find_patron($patron_id)); - $trans->item($self->find_item($item_id)); - - if(!$trans->patron) { - $trans->screen_msg("Invalid patron barcode."); - $trans->ok(0); - return $trans; - } - - if(!$trans->patron->renew_ok) { - $trans->screen_msg("Renewals not allowed."); - $trans->ok(0); - return $trans; - } - - if(!$trans->item) { - if( $title_id ) { - $trans->screen_msg("Title ID renewal not supported. Use item barcode."); - } else { - $trans->screen_msg("Invalid item barcode."); - } - $trans->ok(0); - return $trans; - } - - if(!$trans->item->{patron} or - $trans->item->{patron} ne $patron_id) { - $trans->screen_msg("Item not checked out to " . $trans->patron->name); - $trans->ok(0); - return $trans; - } - - # Perform the renewal - $trans->do_renew(); - - $trans->desensitize(0); # It's already checked out - $trans->item->{due_date} = $nb_due_date if $no_block eq 'Y'; - $trans->item->{sip_item_properties} = $item_props if $item_props; - - return $trans; -} - - - - - -# -#sub renew_all { -# my ($self, $patron_id, $patron_pwd, $fee_ack) = @_; -# my ($patron, $item_id); -# my $trans; -# -# $trans = new ILS::Transaction::RenewAll; -# -# $trans->patron($patron = new ILS::Patron $patron_id); -# if (defined $patron) { -# syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s", -# $patron->name, $patron->renew_ok); -# } else { -# syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'", -# $patron_id); -# } -# -# if (!defined($patron)) { -# $trans->screen_msg("Invalid patron barcode."); -# return $trans; -# } elsif (!$patron->renew_ok) { -# $trans->screen_msg("Renewals not allowed."); -# return $trans; -# } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) { -# $trans->screen_msg("Invalid patron password."); -# return $trans; -# } -# -# foreach $item_id (@{$patron->{items}}) { -# my $item = new ILS::Item $item_id; -# -# if (!defined($item)) { -# syslog("LOG_WARNING", -# "renew_all: Invalid item id associated with patron '%s'", -# $patron->id); -# next; -# } -# -# if (@{$item->hold_queue}) { -# # Can't renew if there are outstanding holds -# push @{$trans->unrenewed}, $item_id; -# } else { -# $item->{due_date} = time + (14*24*60*60); # two weeks hence -# push @{$trans->renewed}, $item_id; -# } -# } -# -# $trans->ok(1); -# -# return $trans; -#} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/SIP/Item.pm b/Open-ILS/src/perlmods/OpenILS/SIP/Item.pm deleted file mode 100644 index 7eb815c9eb..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/SIP/Item.pm +++ /dev/null @@ -1,515 +0,0 @@ -package OpenILS::SIP::Item; -use strict; use warnings; - -use Sys::Syslog qw(syslog); -use Carp; - -use OpenILS::SIP; -use OpenILS::SIP::Transaction; -use OpenILS::Application::AppUtils; -use OpenILS::Application::Circ::ScriptBuilder; -# use Data::Dumper; -use OpenILS::Const qw/:const/; -use OpenSRF::Utils qw/:datetime/; -use DateTime::Format::ISO8601; -use OpenSRF::Utils::SettingsClient; -my $U = 'OpenILS::Application::AppUtils'; - -my %item_db; - -# 0 means read-only -# 1 means read/write Actually, gloves are off. Set what you like. - -my %fields = ( - id => 0, -# sip_media_type => 0, - sip_item_properties => 0, -# magnetic_media => 0, - permanent_location => 0, - current_location => 0, -# print_line => 1, -# screen_msg => 1, -# itemnumber => 0, -# biblionumber => 0, - hold => 0, - hold_patron_bcode => 0, - hold_patron_name => 0, - barcode => 0, - onloan => 0, - collection_code => 0, - destination_loc => 0, - call_number => 0, - enumchron => 0, - location => 0, - author => 0, - title => 0, - copy => 0, - volume => 0, - record => 0, - mods => 0, -); - -our $AUTOLOAD; -sub DESTROY { } # keeps AUTOLOAD from catching inherent DESTROY calls - -sub AUTOLOAD { - my $self = shift; - my $class = ref($self) or croak "$self is not an object"; - my $name = $AUTOLOAD; - - $name =~ s/.*://; - - unless (exists $fields{$name}) { - croak "Cannot access '$name' field of class '$class'"; - } - - if (@_) { - # $fields{$name} or croak "Field '$name' of class '$class' is READ ONLY."; # nah, go ahead - return $self->{$name} = shift; - } else { - return $self->{$name}; - } -} - - -sub new { - my ($class, $item_id) = @_; - my $type = ref($class) || $class; - my $self = bless( {}, $type ); - - syslog('LOG_DEBUG', "OILS: Loading item $item_id..."); - return undef unless $item_id; - - my $e = OpenILS::SIP->editor(); - - my $copy = $e->search_asset_copy( - [ - { barcode => $item_id, deleted => 'f' }, - { - flesh => 3, - flesh_fields => { - acp => [ 'circ_lib', 'call_number', 'status' ], - acn => [ 'owning_lib', 'record' ], - } - } - ] - )->[0]; - - if(!$copy) { - syslog("LOG_DEBUG", "OILS: Item '%s' : not found", $item_id); - return undef; - } - - my $circ = $e->search_action_circulation([ - { - target_copy => $copy->id, - stop_fines_time => undef, - checkin_time => undef - }, - { - flesh => 2, - flesh_fields => { - circ => ['usr'], - au => ['card'] - } - } - ])->[0]; - - if($circ) { - - my $user = $circ->usr; - my $bc = ($user->card) ? $user->card->barcode : ''; - $self->{patron} = $bc; - $self->{patron_object} = $user; - - syslog('LOG_DEBUG', "OILS: Open circulation exists on $item_id : user = $bc"); - } - - $self->{id} = $item_id; - $self->{copy} = $copy; - $self->{volume} = $copy->call_number; - $self->{record} = $copy->call_number->record; - $self->{call_number} = $copy->call_number->label; - $self->{mods} = $U->record_to_mvr($self->{record}) if $self->{record}->marc; - $self->{transit} = $self->fetch_transit; - $self->{hold} = $self->fetch_hold; - - - # use the non-translated version of the copy location as the - # collection code, since it may be used for additional routing - # purposes by the SIP client. Config option? - $self->{collection_code} = - $e->retrieve_asset_copy_location([ - $copy->location, {no_i18n => 1}])->name; - - - if($self->{transit}) { - $self->{destination_loc} = $self->{transit}->dest->shortname; - - } elsif($self->{hold}) { - $self->{destination_loc} = $self->{hold}->pickup_lib->shortname; - } - - syslog("LOG_DEBUG", "OILS: Item('$item_id'): found with title '%s'", $self->title_id); - - my $config = OpenILS::SIP->config(); # FIXME : will not always match! - my $legacy = $config->{implementation_config}->{legacy_script_support} || undef; - - if( defined $legacy ) { - $self->{legacy_script_support} = ($legacy =~ /t(rue)?/io) ? 1 : 0; - syslog("LOG_DEBUG", "legacy_script_support is set in SIP config: " . $self->{legacy_script_support}); - - } else { - my $lss = OpenSRF::Utils::SettingsClient->new->config_value( - apps => 'open-ils.circ', - app_settings => 'legacy_script_support' - ); - $self->{legacy_script_support} = ($lss =~ /t(rue)?/io) ? 1 : 0; - syslog("LOG_DEBUG", "legacy_script_support is set in SRF config: " . $self->{legacy_script_support}); - } - - return $self; -} - -# fetch copy transit -sub fetch_transit { - my $self = shift; - my $copy = $self->{copy} or return; - my $e = OpenILS::SIP->editor(); - - if ($copy->status->id == OILS_COPY_STATUS_IN_TRANSIT) { - my $transit = $e->search_action_transit_copy([ - { - target_copy => $copy->id, # NOT barcode ($self->id) - dest_recv_time => undef - }, - { - flesh => 1, - flesh_fields => { - atc => ['dest'] - } - } - ])->[0]; - - syslog('LOG_WARNING', "OILS: Item(".$copy->barcode. - ") status is In Transit, but no action.transit_copy found!") unless $transit; - - return $transit; - } - - return undef; -} - -# fetch captured hold. -# Assume transit has already beeen fetched -sub fetch_hold { - my $self = shift; - my $copy = $self->{copy} or return; - my $e = OpenILS::SIP->editor(); - - if( ($copy->status->id == OILS_COPY_STATUS_ON_HOLDS_SHELF) || - ($self->{transit} and $self->{transit}->copy_status == OILS_COPY_STATUS_ON_HOLDS_SHELF) ) { - # item has been captured for a hold - - my $hold = $e->search_action_hold_request([ - { - current_copy => $copy->id, - capture_time => {'!=' => undef}, - cancel_time => undef, - fulfillment_time => undef - }, - { - limit => 1, - flesh => 1, - flesh_fields => { - ahr => ['pickup_lib'] - } - } - ])->[0]; - - syslog('LOG_WARNING', "OILS: Item(".$copy->barcode. - ") is captured for a hold, but there is no matching hold request") unless $hold; - - return $hold; - } - - return undef; -} - -sub run_attr_script { - my $self = shift; - return 1 if $self->{ran_script}; - $self->{ran_script} = 1; - - if($self->{legacy_script_support}){ - - syslog('LOG_DEBUG', "Legacy script support is ON"); - my $config = OpenILS::SIP->config(); - my $path = $config->{implementation_config}->{scripts}->{path}; - my $item_config_script = $config->{implementation_config}->{scripts}->{item_config}; - - $path = ref($path) eq 'ARRAY' ? $path : [$path]; - my $path_str = join(", ", @$path); - - syslog('LOG_DEBUG', "OILS: Script path = [$path_str], Item config script = $item_config_script"); - - my $runner = OpenILS::Application::Circ::ScriptBuilder->build({ - copy => $self->{copy}, - editor => OpenILS::SIP->editor(), - }); - - $runner->add_path($_) for @$path; - $runner->load($item_config_script); - - unless( $self->{item_config_result} = $runner->run ) { # assignment, not comparison - $runner->cleanup; - warn "Item config script [$path_str : $item_config_script] failed to run: $@\n"; - syslog('LOG_ERR', "OILS: Item config script [$path_str : $item_config_script] failed to run: $@"); - return undef; - } - - $runner->cleanup; - - } else { - - # use the in-db circ modifier configuration - my $config = {magneticMedia => 'f', SIPMediaType => '001'}; # defaults - my $mod = $self->{copy}->circ_modifier; - - if($mod) { - my $mod_obj = OpenILS::SIP->editor()->retrieve_config_circ_modifier($mod); - if($mod_obj) { - $config->{magneticMedia} = $mod_obj->magnetic_media; - $config->{SIPMediaType} = $mod_obj->sip2_media_type; - } - } - - $self->{item_config_result} = { item_config => $config }; - } - - return 1; -} - -sub magnetic_media { - my $self = shift; - $self->magnetic(@_); -} -sub magnetic { - my $self = shift; - return 0 unless $self->run_attr_script; - my $mag = $self->{item_config_result}->{item_config}->{magneticMedia} || ''; - syslog('LOG_DEBUG', "OILS: magnetic = $mag"); - return ($mag and $mag =~ /t(rue)?/io) ? 1 : 0; -} - -sub sip_media_type { - my $self = shift; - return 0 unless $self->run_attr_script; - my $media = $self->{item_config_result}->{item_config}->{SIPMediaType} || ''; - syslog('LOG_DEBUG', "OILS: media type = $media"); - return ($media) ? $media : '001'; -} - -sub title_id { - my $self = shift; - my $t = ($self->{mods}) ? $self->{mods}->title : $self->{copy}->dummy_title; - return OpenILS::SIP::clean_text($t); -} - -sub permanent_location { - my $self = shift; - return OpenILS::SIP::clean_text($self->{copy}->circ_lib->shortname); -} - -sub current_location { - my $self = shift; - return OpenILS::SIP::clean_text($self->{copy}->circ_lib->shortname); -} - - -# 2 chars 0-99 -# 01 Other -# 02 On order -# 03 Available -# 04 Charged -# 05 Charged; not to be recalled until earliest recall date -# 06 In process -# 07 Recalled -# 08 Waiting on hold shelf -# 09 Waiting to be re-shelved -# 10 In transit between library locations -# 11 Claimed returned -# 12 Lost -# 13 Missing -sub sip_circulation_status { - my $self = shift; - my $stat = $self->{copy}->status->id; - - return '02' if $stat == OILS_COPY_STATUS_ON_ORDER; - return '03' if $stat == OILS_COPY_STATUS_AVAILABLE; - return '04' if $stat == OILS_COPY_STATUS_CHECKED_OUT; - return '06' if $stat == OILS_COPY_STATUS_IN_PROCESS; - return '08' if $stat == OILS_COPY_STATUS_ON_HOLDS_SHELF; - return '09' if $stat == OILS_COPY_STATUS_RESHELVING; - return '10' if $stat == OILS_COPY_STATUS_IN_TRANSIT; - return '12' if $stat == OILS_COPY_STATUS_LOST; - return '13' if $stat == OILS_COPY_STATUS_MISSING; - - return 01; -} - -sub sip_security_marker { - return '02'; # FIXME? 00-other; 01-None; 02-Tattle-Tape Security Strip (3M); 03-Whisper Tape (3M) -} - -sub sip_fee_type { - return '01'; # FIXME? 01-09 enumerated in spec. We just use O1-other/unknown. -} - -sub fee { # TODO - my $self = shift; - return 0; -} - - -sub fee_currency { - my $self = shift; - return OpenILS::SIP->config()->{implementation_config}->{currency}; -} - -sub owner { - my $self = shift; - return OpenILS::SIP::clean_text($self->{copy}->circ_lib->shortname); -} - -sub hold_queue { - my $self = shift; - return []; -} - -sub hold_queue_position { # TODO - my ($self, $patron_id) = @_; - return 1; -} - -sub due_date { - my $self = shift; - - # this should force correct circ fetching - require OpenILS::Utils::CStoreEditor; - my $e = OpenILS::Utils::CStoreEditor->new(xact => 1); - #my $e = OpenILS::SIP->editor(); - - my $circ = $e->search_action_circulation( - { target_copy => $self->{copy}->id, checkin_time => undef } )->[0]; - - $e->rollback; - - if( !$circ ) { - syslog('LOG_INFO', "OILS: No open circ found for copy"); - return 0; - } - - my $due = OpenILS::SIP->format_date($circ->due_date, 'due'); - syslog('LOG_DEBUG', "OILS: Found item due date = $due"); - return $due; -} - -sub recall_date { # TODO - my $self = shift; - return 0; -} - - -# Note: If the held item is in transit, this will be an approximation of shelf -# expire time, since the time is not set until the item is checked in at the pickup location -my %shelf_expire_setting_cache; -sub hold_pickup_date { - my $self = shift; - my $copy = $self->{copy}; - my $hold = $self->{hold} or return 0; - - my $date = $hold->shelf_expire_time; - - if(!$date) { - # hold has not hit the shelf. create a best guess. - - my $interval = $shelf_expire_setting_cache{$hold->pickup_lib->id} || - $U->ou_ancestor_setting_value( - $hold->pickup_lib->id, - 'circ.holds.default_shelf_expire_interval'); - - $shelf_expire_setting_cache{$hold->pickup_lib->id} = $interval; - - if($interval) { - my $seconds = OpenSRF::Utils->interval_to_seconds($interval); - $date = DateTime->now->add(seconds => $seconds); - $date = $date->strftime('%FT%T%z') if $date; - } - } - - return OpenILS::SIP->format_date($date) if $date; - - return 0; -} - -# message to display on console -sub screen_msg { - my $self = shift; - return OpenILS::SIP::clean_text($self->{screen_msg}) || ''; -} - - -# reciept printer -sub print_line { - my $self = shift; - return OpenILS::SIP::clean_text($self->{print_line}) || ''; -} - - -# An item is available for a patron if -# 1) It's not checked out and (there's no hold queue OR patron -# is at the front of the queue) -# OR -# 2) It's checked out to the patron and there's no hold queue -sub available { - my ($self, $for_patron) = @_; - - my $stat = $self->{copy}->status->id; - return 1 if - $stat == OILS_COPY_STATUS_AVAILABLE or - $stat == OILS_COPY_STATUS_RESHELVING; - - return 0; -} - - -1; -__END__ - -=head1 NAME - -OpenILS::SIP::Item - SIP abstraction layer for OpenILS Items. - -=head1 DESCRIPTION - -=head2 owning_lib vs. circ_lib - -In Evergreen, owning_lib is the org unit that purchased the item, the place to which the item -should return after it's done rotating/floating to other branches (via staff intervention), -or some combination of those. The owning_lib, however, is not necessarily where the item -should be going "right now" or where it should return to by default. That would be the copy -circ_lib or the transit destination. (In fact, the item may B go to the owning_lib for -its entire existence). In the context of SIP, the circ_lib more accurately describes the item's -permanent location, i.e. where it needs to be sent if it's not en route to somewhere else. - -This confusion extends also to the SIP extension field of "owner". It means that the SIP owner does not -correspond to EG's asset.volume.owning_lib, mainly because owning_lib is effectively the "ultimate -owner" but not necessarily the "current owner". Because we populate SIP fields with circ_lib, the -owning_lib is unused by SIP. - -=head1 TODO - -Holds queue logic - -=cut diff --git a/Open-ILS/src/perlmods/OpenILS/SIP/Msg.pm b/Open-ILS/src/perlmods/OpenILS/SIP/Msg.pm deleted file mode 100644 index 620a9ba9df..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/SIP/Msg.pm +++ /dev/null @@ -1,31 +0,0 @@ -package OpenILS::SIP::Msg; -use strict; use warnings; -# ------------------------------------------------------- -# Defines the various screen messages -# Currently they are just constants.. they need to be -# moved to an external lang-specific source -# ------------------------------------------------------- -use vars qw(@EXPORT_OK %EXPORT_TAGS); -use Exporter; -use base qw/Exporter/; - - -# --------------------------------------------------------------------- -# Shoves defined constants into the export array -# so they don't have to be listed twice in the code -# --------------------------------------------------------------------- -sub econst { - my($name, $value) = @_; - my $caller = caller; - no strict; - *{$name} = sub () { $value }; - push @{$caller.'::EXPORT_OK'}, $name; -} - - -econst OILS_SIP_MSG_CIRC_EXISTS => 'This item is already checked out'; -econst OILS_SIP_MSG_CIRC_PERMIT_FAILED => 'Patron is not allowed to check out the selected item'; - -%EXPORT_TAGS = ( const => [ @EXPORT_OK ] ); - - diff --git a/Open-ILS/src/perlmods/OpenILS/SIP/Patron.pm b/Open-ILS/src/perlmods/OpenILS/SIP/Patron.pm deleted file mode 100644 index 214281ac8f..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/SIP/Patron.pm +++ /dev/null @@ -1,703 +0,0 @@ -# -# -# A Class for hiding the ILS's concept of the patron from the OpenSIP -# system -# - -package OpenILS::SIP::Patron; - -use strict; -use warnings; -use Exporter; - -use Sys::Syslog qw(syslog); -use Data::Dumper; -use Digest::MD5 qw(md5_hex); - -use OpenILS::SIP; -use OpenILS::Application::AppUtils; -use OpenILS::Application::Actor; -use OpenSRF::Utils qw/:datetime/; -use DateTime::Format::ISO8601; -my $U = 'OpenILS::Application::AppUtils'; - -our (@ISA, @EXPORT_OK); - -@ISA = qw(Exporter); - -@EXPORT_OK = qw(invalid_patron); - -my $INET_PRIVS; - -# -# OpenILS::SIP::Patron->new($barcode); -# OpenILS::SIP::Patron->new(barcode => $barcode); # same as above -# OpenILS::SIP::Patron->new( usr => $id); - -sub new { - my $class = shift; - my $key = (@_ > 1) ? shift : 'barcode'; # if we have multiple args, the first is the key index (default barcode) - my $patron_id = shift; - my %args = @_; - - if ($key ne 'usr' and $key ne 'barcode') { - syslog("LOG_ERROR", "Patron (card) lookup requested by illegeal key '$key'"); - return undef; - } - - unless(defined $patron_id) { - syslog("LOG_WARNING", "No patron ID provided to ILS::Patron->new"); - return undef; - } - - my $type = ref($class) || $class; - my $self = bless({}, $type); - - syslog("LOG_DEBUG", "OILS: new OpenILS Patron(%s => %s): searching...", $key, $patron_id); - - my $e = OpenILS::SIP->editor(); - - my $usr_flesh = { - flesh => 2, - flesh_fields => { - au => [ - "card", - "addresses", - "billing_address", - "mailing_address", - 'profile', - ], - } - }; - - # in some cases, we don't need all of this data. Only fetch the user + barcode - $usr_flesh = {flesh => 1, flesh_fields => {au => ['card']}} if $args{slim_user}; - - my $user; - if($key eq 'barcode') { # retrieve user by barcode - - $$usr_flesh{flesh} += 1; - $$usr_flesh{flesh_fields}{ac} = ['usr']; - - my $card = $e->search_actor_card([{barcode => $patron_id}, $usr_flesh])->[0]; - - if(!$card) { - syslog("LOG_WARNING", "No such patron barcode: $patron_id"); - return undef; - } - - $user = $card->usr; - - } else { - $user = $e->retrieve_actor_user([$patron_id, $usr_flesh]); - } - - if(!$user) { - syslog("LOG_WARNING", "OILS: Unable to find patron %s => %s", $key, $patron_id); - return undef; - } - - # now grab the user's penalties - - $self->flesh_user_penalties($user, $e) unless $args{slim_user}; - - $self->{editor} = $e; - $self->{user} = $user; - $self->{id} = ($key eq 'barcode') ? $patron_id : $user->card->barcode; # The barcode IS the ID to SIP. - # We give back the passed barcode if the key was indeed a barcode, just to be safe. Otherwise pull it from the card. - - syslog("LOG_DEBUG", "OILS: new OpenILS Patron(%s => %s): found patron : barred=%s, card:active=%s", - $key, $patron_id, $user->barred, $user->card->active ); - - return $self; -} - -# grab patron penalties. Only grab non-archived penalties that are for fines, -# excessive overdues, or otherwise block circluation activity -sub flesh_user_penalties { - my ($self, $user, $e) = @_; - - $user->standing_penalties( - $e->search_actor_user_standing_penalty([ - { - usr => $user->id, - '-or' => [ - - # ignore "archived" penalties - {stop_date => undef}, - {stop_date => {'>' => 'now'}} - ], - - org_unit => { - in => { - select => { - aou => [{ - column => 'id', - transform => 'actor.org_unit_ancestors', - result_field => 'id' - }] - }, - from => 'aou', - - # at this point, there is no concept of "here", so fetch penalties - # for the patron's home lib plus ancestors - where => {id => $user->home_ou}, - distinct => 1 - } - }, - - # in addition to fines and excessive overdue penalties, - # we only care about penalties that result in blocks - standing_penalty => { - in => { - select => {csp => ['id']}, - from => 'csp', - where => { - '-or' => [ - {id => [1,2]}, # fines / overdues - {block_list => {'!=' => undef}} - ] - }, - } - } - }, - ]) - ); -} - -sub id { - my $self = shift; - return $self->{id}; -} - -sub name { - my $self = shift; - return format_name($self->{user}); -} - -sub format_name { - my $u = shift; - return OpenILS::SIP::clean_text( - sprintf('%s %s %s', - ($u->first_given_name || ''), - ($u->second_given_name || ''), - ($u->family_name || ''))); -} - -sub home_library { - my $self = shift; - my $lib = OpenILS::SIP::shortname_from_id($self->{user}->home_ou); - syslog('LOG_DEBUG', "OILS: Patron->home_library() = $lib"); - return $lib; -} - -sub __addr_string { - my $addr = shift; - return "" unless $addr; - my $return = OpenILS::SIP::clean_text( - join( ' ', map {$_ || ''} ( - $addr->street1, - $addr->street2, - $addr->city . ',', - $addr->county, - $addr->state, - $addr->country, - $addr->post_code - ) - ) - ); - $return =~ s/\s+/ /sg; # Compress any run of of whitespace to one space - return $return; -} - -sub internal_id { - my $self = shift; - return $self->{user}->id; -} - -sub address { - my $self = shift; - my $u = $self->{user}; - my $str = __addr_string($u->billing_address || $u->mailing_address); - syslog('LOG_DEBUG', "OILS: Patron address: $str"); - return $str; -} - -sub email_addr { - my $self = shift; - return OpenILS::SIP::clean_text($self->{user}->email); -} - -sub home_phone { - my $self = shift; - return $self->{user}->day_phone; -} - -sub sip_birthdate { - my $self = shift; - my $dob = OpenILS::SIP->format_date($self->{user}->dob); - syslog('LOG_DEBUG', "OILS: Patron DOB = $dob"); - return $dob; -} - -sub ptype { - my $self = shift; - - my $use_code = OpenILS::SIP->get_option_value('patron_type_uses_code') || ''; - - # should we use the no_i18n version of patron profile name (as a 'code')? - return $self->{editor}->retrieve_permission_grp_tree( - [$self->{user}->profile->id, {no_i18n => 1}])->name - if $use_code =~ /true/io; - - return OpenILS::SIP::clean_text($self->{user}->profile->name); -} - -sub language { - my $self = shift; - return '000'; # Unspecified -} - -# How much more detail do we need to check here? -sub charge_ok { - my $self = shift; - my $u = $self->{user}; - return (($u->barred eq 'f') and ($u->card->active eq 't')); -} - -# How much more detail do we need to check here? -sub renew_ok { - my $self = shift; - return $self->charge_ok; -} - -sub recall_ok { - my $self = shift; - return 0; -} - -sub hold_ok { - my $self = shift; - return $self->charge_ok; -} - -# return true if the card provided is marked as lost -sub card_lost { - my $self = shift; - return $self->{user}->card->active eq 'f'; -} - -sub recall_overdue { # not implemented - my $self = shift; - return 0; -} - -sub check_password { - my ($self, $pwd) = @_; - syslog('LOG_DEBUG', 'OILS: Patron->check_password()'); - return 0 unless (defined $pwd and $self->{user}); - return md5_hex($pwd) eq $self->{user}->passwd; -} - -sub currency { # not really implemented - my $self = shift; - syslog('LOG_DEBUG', 'OILS: Patron->currency()'); - return 'USD'; -} - -sub fee_amount { - my $self = shift; - syslog('LOG_DEBUG', 'OILS: Patron->fee_amount()'); - my $user_id = $self->{user}->id; - - my $e = $self->{editor}; - $e->xact_begin; - my $summary = $e->retrieve_money_open_user_summary($user_id); - $e->rollback; # xact_rollback + disconnect - - my $total = ($summary) ? $summary->balance_owed : 0; - syslog('LOG_INFO', "User ".$self->{id} .":$user_id has a fee amount of \$$total"); - return $total; -} - -sub screen_msg { - my $self = shift; - my $u = $self->{user}; - - return 'barred' if $u->barred eq 't'; - - my $b = 'blocked'; - - return $b if $u->active eq 'f'; - return $b if $u->card->active eq 'f'; - - # if we have any penalties at this point, they are blocking penalties - return $b if $u->standing_penalties and @{$u->standing_penalties}; - - # has the patron account expired? - my $expire = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($u->expire_date)); - return $b if CORE::time > $expire->epoch; - - return 'OK'; -} - -sub print_line { # not implemented - my $self = shift; - return ''; -} - -sub too_many_charged { # not implemented - my $self = shift; - return 0; -} - -sub too_many_overdue { - my $self = shift; - return scalar( # PATRON_EXCEEDS_OVERDUE_COUNT - grep { $_->standing_penalty == 2 } @{$self->{user}->standing_penalties} - ); -} - -# not completely sure what this means -sub too_many_renewal { - my $self = shift; - return 0; -} - -# not relevant, handled by fines/fees -sub too_many_claim_return { - my $self = shift; - return 0; -} - -# not relevant, handled by fines/fees -sub too_many_lost { - my $self = shift; - return 0; -} - -sub excessive_fines { - my $self = shift; - return scalar( # PATRON_EXCEEDS_FINES - grep { $_->standing_penalty == 1 } @{$self->{user}->standing_penalties} - ); -} - -# Until someone suggests otherwise, fees and fines are the same - -sub excessive_fees { - my $self = shift; - return $self->excessive_fines; -} - -# not relevant, handled by fines/fees -sub too_many_billed { - my $self = shift; - return 0; -} - - - -# -# List of outstanding holds placed -# -sub hold_items { - my ($self, $start, $end) = @_; - syslog('LOG_DEBUG', 'OILS: Patron->hold_items()'); - - my $holds = $self->{editor}->search_action_hold_request( - { usr => $self->{user}->id, fulfillment_time => undef, cancel_time => undef } - ); - - my @holds; - push( @holds, OpenILS::SIP::clean_text($self->__hold_to_title($_)) ) for @$holds; - - return (defined $start and defined $end) ? - [ $holds[($start-1)..($end-1)] ] : - \@holds; -} - -sub __hold_to_title { - my $self = shift; - my $hold = shift; - my $e = $self->{editor}; - - my( $id, $mods, $title, $volume, $copy ); - - return __copy_to_title($e, - $e->retrieve_asset_copy($hold->target)) - if $hold->hold_type eq 'C'; - - return __volume_to_title($e, - $e->retrieve_asset_call_number($hold->target)) - if $hold->hold_type eq 'V'; - - return __record_to_title( - $e, $hold->target) if $hold->hold_type eq 'T'; - - return __metarecord_to_title( - $e, $hold->target) if $hold->hold_type eq 'M'; -} - -sub __copy_to_title { - my( $e, $copy ) = @_; - #syslog('LOG_DEBUG', "OILS: copy_to_title(%s)", $copy->id); - return $copy->dummy_title if $copy->call_number == -1; - - my $vol = (ref $copy->call_number) ? - $copy->call_number : - $e->retrieve_asset_call_number($copy->call_number); - - return __volume_to_title($e, $vol); -} - - -sub __volume_to_title { - my( $e, $volume ) = @_; - #syslog('LOG_DEBUG', "OILS: volume_to_title(%s)", $volume->id); - return __record_to_title($e, $volume->record); -} - - -sub __record_to_title { - my( $e, $title_id ) = @_; - #syslog('LOG_DEBUG', "OILS: record_to_title($title_id)"); - my $mods = $U->simplereq( - 'open-ils.search', - 'open-ils.search.biblio.record.mods_slim.retrieve', $title_id ); - return ($mods) ? $mods->title : ""; -} - -sub __metarecord_to_title { - my( $e, $m_id ) = @_; - #syslog('LOG_DEBUG', "OILS: metarecord_to_title($m_id)"); - my $mods = $U->simplereq( - 'open-ils.search', - 'open-ils.search.biblio.metarecord.mods_slim.retrieve', $m_id); - return ($U->event_code($mods)) ? "" : $mods->title; -} - - -# -# remove the hold on item item_id from my hold queue. -# return true if I was holding the item, false otherwise. -# -sub drop_hold { - my ($self, $item_id) = @_; - return 0; -} - -sub __patron_items_info { - my $self = shift; - return if $self->{item_info}; - $self->{item_info} = - OpenILS::Application::Actor::_checked_out( - 0, $self->{editor}, $self->{user}->id);; -} - - - -sub overdue_items { - my ($self, $start, $end) = @_; - - $self->__patron_items_info(); - my @overdues = @{$self->{item_info}->{overdue}}; - #$overdues[$_] = __circ_to_title($self->{editor}, $overdues[$_]) for @overdues; - - my @o; - syslog('LOG_DEBUG', "OILS: overdue_items() fleshing circs @overdues"); - - my $return_datatype = OpenILS::SIP->get_option_value('msg64_summary_datatype') || ''; - - for my $circid (@overdues) { - next unless $circid; - if($return_datatype eq 'barcode') { - push( @o, __circ_to_barcode($self->{editor}, $circid)); - } else { - push( @o, OpenILS::SIP::clean_text(__circ_to_title($self->{editor}, $circid))); - } - } - @overdues = @o; - - return (defined $start and defined $end) ? - [ $overdues[($start-1)..($end-1)] ] : \@overdues; -} - -sub __circ_to_barcode { - my ($e, $circ) = @_; - return unless $circ; - $circ = $e->retrieve_action_circulation($circ); - my $copy = $e->retrieve_asset_copy($circ->target_copy); - return $copy->barcode; -} - -sub __circ_to_title { - my( $e, $circ ) = @_; - return unless $circ; - $circ = $e->retrieve_action_circulation($circ); - return __copy_to_title( $e, - $e->retrieve_asset_copy($circ->target_copy) ); -} - -sub charged_items { - my ($self, $start, $end) = shift; - - $self->__patron_items_info(); - - my @charges = ( - @{$self->{item_info}->{out}}, - @{$self->{item_info}->{overdue}} - ); - - #$charges[$_] = __circ_to_title($self->{editor}, $charges[$_]) for @charges; - - my @c; - syslog('LOG_DEBUG', "OILS: charged_items() fleshing circs @charges"); - - my $return_datatype = OpenILS::SIP->get_option_value('msg64_summary_datatype') || ''; - - for my $circid (@charges) { - next unless $circid; - if($return_datatype eq 'barcode') { - push( @c, __circ_to_barcode($self->{editor}, $circid)); - } else { - push( @c, OpenILS::SIP::clean_text(__circ_to_title($self->{editor}, $circid))); - } - } - - @charges = @c; - - return (defined $start and defined $end) ? - [ $charges[($start-1)..($end-1)] ] : - \@charges; -} - -sub fine_items { - my ($self, $start, $end) = @_; - my @fines; - syslog('LOG_DEBUG', 'OILS: Patron->fine_items()'); - return (defined $start and defined $end) ? - [ $fines[($start-1)..($end-1)] ] : \@fines; -} - -# not currently supported -sub recall_items { - my ($self, $start, $end) = @_; - return []; -} - -sub unavail_holds { - my ($self, $start, $end) = @_; - my @holds; - syslog('LOG_DEBUG', 'OILS: Patron->unavail_holds()'); - return (defined $start and defined $end) ? - [ $holds[($start-1)..($end-1)] ] : \@holds; -} - -sub block { - my ($self, $card_retained, $blocked_card_msg) = @_; - $blocked_card_msg ||= ''; - - my $e = $self->{editor}; - my $u = $self->{user}; - - syslog('LOG_INFO', "OILS: Blocking user %s", $u->card->barcode ); - - return $self if $u->card->active eq 'f'; - - $e->xact_begin; # connect and start a new transaction - - $u->card->active('f'); - if( ! $e->update_actor_card($u->card) ) { - syslog('LOG_ERR', "OILS: Block card update failed: %s", $e->event->{textcode}); - $e->rollback; # rollback + disconnect - return $self; - } - - # retrieve the un-fleshed user object for update - $u = $e->retrieve_actor_user($u->id); - my $note = OpenILS::SIP::clean_text($u->alert_message) || ""; - $note = " CARD BLOCKED BY SELF-CHECK MACHINE. $blocked_card_msg\n$note"; # XXX Config option - $note =~ s/\s*$//; # kill trailng whitespace - $u->alert_message($note); - - if( ! $e->update_actor_user($u) ) { - syslog('LOG_ERR', "OILS: Block: patron alert update failed: %s", $e->event->{textcode}); - $e->rollback; # rollback + disconnect - return $self; - } - - # stay in synch - $self->{user}->alert_message( $note ); - - $e->commit; # commits and disconnects - return $self; -} - -# Testing purposes only -sub enable { - my ($self, $card_retained) = @_; - $self->{screen_msg} = "All privileges restored."; - - # Un-mark card as inactive, grep out the patron alert - my $e = $self->{editor}; - my $u = $self->{user}; - - syslog('LOG_INFO', "OILS: Unblocking user %s", $u->card->barcode ); - - return $self if $u->card->active eq 't'; - - $e->xact_begin; # connect and start a new transaction - - $u->card->active('t'); - if( ! $e->update_actor_card($u->card) ) { - syslog('LOG_ERR', "OILS: Unblock card update failed: %s", $e->event->{textcode}); - $e->rollback; # rollback + disconnect - return $self; - } - - # retrieve the un-fleshed user object for update - $u = $e->retrieve_actor_user($u->id); - my $note = OpenILS::SIP::clean_text($u->alert_message) || ""; - $note =~ s#.*##; - $note =~ s/^\s*//; # kill leading whitespace - $note =~ s/\s*$//; # kill trailng whitespace - $u->alert_message($note); - - if( ! $e->update_actor_user($u) ) { - syslog('LOG_ERR', "OILS: Unblock: patron alert update failed: %s", $e->event->{textcode}); - $e->rollback; # rollback + disconnect - return $self; - } - - # stay in synch - $self->{user}->alert_message( $note ); - - $e->commit; # commits and disconnects - return $self; -} - -# -# Messages -# - -sub invalid_patron { - return "Please contact library staff"; -} - -sub charge_denied { - return "Please contact library staff"; -} - -sub inet_privileges { - my( $self ) = @_; - my $e = OpenILS::SIP->editor(); - $INET_PRIVS = $e->retrieve_all_config_net_access_level() unless $INET_PRIVS; - my ($level) = grep { $_->id eq $self->{user}->net_access_level } @$INET_PRIVS; - my $name = OpenILS::SIP::clean_text($level->name); - syslog('LOG_DEBUG', "OILS: Patron inet_privs = $name"); - return $name; -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/SIP/Transaction.pm b/Open-ILS/src/perlmods/OpenILS/SIP/Transaction.pm deleted file mode 100644 index eeb9fafc80..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/SIP/Transaction.pm +++ /dev/null @@ -1,71 +0,0 @@ -# -# Transaction: Superclass of all the transactional status objects -# - -package OpenILS::SIP::Transaction; - -use Carp; -use strict; use warnings; -use Sys::Syslog qw(syslog); - -use OpenILS::SIP; -use OpenILS::SIP::Msg qw/:const/; - - -my %fields = ( - ok => 0, - patron => undef, - item => undef, - desensitize => 0, - alert => '', - transation_id => undef, - sip_fee_type => '01', # Other/Unknown - fee_amount => undef, - sip_currency => 'CAD', - screen_msg => '', - print_line => '', - editor => undef, - authtoken => '', -); - -our $AUTOLOAD; - -sub new { - my( $class, %args ) = @_; - - my $self = { _permitted => \%fields, %fields }; - - bless $self, $class; - $self->authtoken($args{authtoken}); - - syslog('LOG_DEBUG', "OILS: Created new transaction with authtoken %s", $self->authtoken); - - my $e = OpenILS::SIP->editor(); - $e->{authtoken} = $self->authtoken; - - return $self; -} - -sub DESTROY { - # be cool -} - -sub AUTOLOAD { - my $self = shift; - my $class = ref($self) or croak "$self is not an object"; - my $name = $AUTOLOAD; - - $name =~ s/.*://; - - unless (exists $self->{_permitted}->{$name}) { - croak "Can't access '$name' field of class '$class'"; - } - - if (@_) { - return $self->{$name} = shift; - } else { - return $self->{$name}; - } -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/SIP/Transaction/Checkin.pm b/Open-ILS/src/perlmods/OpenILS/SIP/Transaction/Checkin.pm deleted file mode 100644 index 42a689cb7e..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/SIP/Transaction/Checkin.pm +++ /dev/null @@ -1,239 +0,0 @@ -package OpenILS::SIP::Transaction::Checkin; -use warnings; use strict; - -use POSIX qw(strftime); -use Sys::Syslog qw(syslog); -use Data::Dumper; -use Time::HiRes q/time/; - -use OpenILS::SIP; -use OpenILS::SIP::Transaction; -use OpenILS::Const qw/:const/; -use OpenILS::Application::AppUtils; -my $U = 'OpenILS::Application::AppUtils'; - -use base qw(OpenILS::SIP::Transaction); - -my $debug = 0; - -my %fields = ( - magnetic => 0, - sort_bin => undef, - # 3M extensions: (most of the data is stored under Item) -# collection_code => undef, -# call_number => undef, - destination_loc => undef, - alert_type => undef, # 00,01,02,03,04 or 99 -# hold_patron_id => undef, -# hold_patron_name => "", -# hold => undef, -); - -sub new { - my $class = shift;; - my $self = $class->SUPER::new(@_); # start with an Transaction object - - foreach (keys %fields) { - $self->{_permitted}->{$_} = $fields{$_}; # overlaying _permitted - } - - @{$self}{keys %fields} = values %fields; # copying defaults into object - - $self->load_override_events; - - return bless $self, $class; -} - -sub resensitize { - my $self = shift; - return 0 if !$self->{item}; - return !$self->{item}->magnetic; -} - -my %override_events; -sub load_override_events { - return if %override_events; - my $override = OpenILS::SIP->config->{implementation_config}->{checkin_override}; - return unless $override; - my $events = $override->{event}; - $events = [$events] unless ref $events eq 'ARRAY'; - $override_events{$_} = 1 for @$events; -} - -my %org_sn_cache; -sub do_checkin { - my $self = shift; - my ($sip_handler, $inst_id, $trans_date, $return_date, $current_loc, $item_props) = @_; # most unused - - unless($self->{item}) { - $self->ok(0); - return undef; - } - - $inst_id ||= ''; - - # physical location defaults to ws ou of the logged in sip user, - # which currently defaults to home_ou, since ws's aren't used. - my $phys_location = $sip_handler->{login_session}->ws_ou; - - my $args = {barcode => $self->{item}->id}; - - if($return_date) { - # SIP date format is YYYYMMDD. Translate to ISO8601 - $return_date =~ s/(\d{4})(\d{2})(\d{2}).*/$1-$2-$3/; - syslog('LOG_INFO', "Checking in with backdate $return_date"); - $args->{backdate} = $return_date; - } - - if($current_loc) { # SIP client specified a physical location - - my $org_id = (defined $org_sn_cache{$current_loc}) ? - $org_sn_cache{$current_loc} : - OpenILS::SIP->editor()->search_actor_org_unit({shortname => $current_loc}, {idlist => 1})->[0]; - - $org_sn_cache{$current_loc} = $org_id; - - # if the caller specifies a physical location, use it as the checkin circ lib - $args->{circ_lib} = $phys_location = $org_id if defined $org_id; - } - - my $override = 0; - my ($resp, $txt, $code); - - while(1) { - - my $method = 'open-ils.circ.checkin'; - $method .= '.override' if $override; - - my $start_time = time(); - $resp = $U->simplereq('open-ils.circ', $method, $self->{authtoken}, $args); - syslog('LOG_INFO', "OILS: Checkin API call took %0.3f seconds", (time() - $start_time)); - - if ($debug) { - my $s = Dumper($resp); - $s =~ s/\n//mog; - syslog('LOG_INFO', "OILS: Checkin response: $s"); - } - - # In oddball cases, we can receive an array of events. - # The first event received should be treated as the main result. - $resp = $$resp[0] if ref($resp) eq 'ARRAY'; - $code = $U->event_code($resp); - $txt = (defined $code) ? $resp->{textcode} : ''; - - last if $override; - - if ( $override_events{$txt} ) { - $override = 1; - } else { - last; - } - } - - syslog('LOG_INFO', "OILS: Checkin resulted in event: $txt, phys_location: $phys_location"); - - $resp->{org} &&= OpenILS::SIP::shortname_from_id($resp->{org}); # Convert id to shortname - - $self->destination_loc($resp->{org}) if $resp->{org}; - - if ($txt eq 'ROUTE_ITEM') { - # Note, this alert_type will be overridden below if this is a hold transit - $self->alert_type('04'); # send to other branch - - } elsif ($txt and $txt ne 'NO_CHANGE' and $txt ne 'SUCCESS') { - syslog('LOG_WARNING', "OILS: Checkin returned unexpected event $code : $txt"); - $self->alert_type('00'); # unknown - } - - my $payload = $resp->{payload} || {}; - - my ($circ, $copy); - - if(ref $payload eq 'HASH') { - - # Two places to look for hold data. These are more important and more definitive than above. - if ($payload->{remote_hold}) { - # actually only used for checkin at non-owning branch w/ hold at same branch - $self->item->hold($payload->{remote_hold}); - - } elsif ($payload->{hold}) { - $self->item->hold($payload->{hold}); - } - - $circ = $resp->{payload}->{circ} || ''; - $copy = $resp->{payload}->{copy} || ''; - } - - if ($self->item->hold) { - my ($pickup_lib_id, $pickup_lib_sn); - - my $holder = OpenILS::SIP->editor()->retrieve_actor_user( - [$self->item->hold->usr, {flesh => 1, flesh_fields => {au => ['card']}}]); - - my $holder_name = OpenILS::SIP::Patron::format_name($holder); - - if (ref $self->item->hold->pickup_lib) { - $pickup_lib_id = $self->item->hold->pickup_lib->id; - $pickup_lib_sn = $self->item->hold->pickup_lib->shortname; - - } else { - $pickup_lib_id = $self->item->hold->pickup_lib; - $pickup_lib_sn = OpenILS::SIP::shortname_from_id($pickup_lib_id); - } - - $self->item->hold_patron_bcode( ($holder->card) ? $holder->card->barcode : ''); - $self->item->hold_patron_name($holder_name); - $self->item->destination_loc($pickup_lib_sn); - - my $atype = ($pickup_lib_id == $phys_location) ? '01' : '02'; - $self->alert_type($atype); - } - - $self->alert(1) if defined $self->alert_type; # alert_type could be "00", hypothetically - - if ( $circ ) { - $self->{circ_user_id} = $circ->usr; - $self->ok(1); - } elsif ($txt eq 'NO_CHANGE' or $txt eq 'SUCCESS' or $txt eq 'ROUTE_ITEM') { - $self->ok(1); # NO_CHANGE means it wasn't checked out anyway, no problem - } else { - $self->alert(1); - $self->alert_type('00') unless $self->alert_type; # wasn't checked out, but *something* changed - # $self->ok(0); # maybe still ok? - } -} - -1; -__END__ - -Successful Checkin event payload includes: - $payload->{copy} (unfleshed) - $payload->{record} - $payload->{circ} - $payload->{transit} - $payload->{cancelled_hold_transit} - $payload->{hold} - $payload->{patron} - -Some EVENT strings: - SUCCESS => , - ASSET_COPY_NOT_FOUND => , - NO_CHANGE => , - PERM_FAILURE => , - CIRC_CLAIMS_RETURNED => , - COPY_ALERT_MESSAGE => , - COPY_STATUS_LOST => , - COPY_STATUS_MISSING => , - COPY_BAD_STATUS => , - ITEM_DEPOSIT_PAID => , - ROUTE_ITEM => , - DATABASE_UPDATE_FAILED => , - DATABASE_QUERY_FAILED => , - -# alert_type: -# 00 - Unknown -# 01 - hold in local library -# 02 - hold for other branch -# 03 - hold for ILL (not used in EG) -# 04 - send to other branch (no hold) -# 99 - Other diff --git a/Open-ILS/src/perlmods/OpenILS/SIP/Transaction/Checkout.pm b/Open-ILS/src/perlmods/OpenILS/SIP/Transaction/Checkout.pm deleted file mode 100644 index 1b94492c01..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/SIP/Transaction/Checkout.pm +++ /dev/null @@ -1,148 +0,0 @@ -# -# An object to handle checkout status -# - -package OpenILS::SIP::Transaction::Checkout; - -use warnings; -use strict; - -use POSIX qw(strftime); - -use OpenILS::SIP; -use OpenILS::SIP::Transaction; -use OpenILS::SIP::Msg qw/:const/; -use Sys::Syslog qw(syslog); - -use OpenILS::Application::AppUtils; -my $U = 'OpenILS::Application::AppUtils'; - - -our @ISA = qw(OpenILS::SIP::Transaction); - -# Most fields are handled by the Transaction superclass -my %fields = ( - security_inhibit => 0, - due => undef, - renew_ok => 0, - ); - -sub new { - my $class = shift; - - my $self = $class->SUPER::new(@_); - - my $element; - - foreach $element (keys %fields) { - $self->{_permitted}->{$element} = $fields{$element}; - } - - @{$self}{keys %fields} = values %fields; - - return bless $self, $class; -} - - -# if this item is already checked out to the requested patron, -# renew the item and set $self->renew_ok to true. -# XXX if it's a renewal and the renewal is not permitted, set -# $self->screen_msg("Item on Hold for Another User"); (or somesuch) -# XXX Set $self->ok(0) on any errors -sub do_checkout { - my $self = shift; - my $is_renew = shift || 0; - - $self->ok(0); - - my $args = { - barcode => $self->{item}->id, - patron_barcode => $self->{patron}->id - }; - - my $resp; - - if ($is_renew) { - $resp = $U->simplereq( - 'open-ils.circ', - 'open-ils.circ.renew', $self->{authtoken}, - { barcode => $self->item->id, patron_barcode => $self->patron->id }); - } else { - $resp = $U->simplereq( - 'open-ils.circ', - 'open-ils.circ.checkout.permit', - $self->{authtoken}, $args ); - - $resp = [$resp] unless ref $resp eq 'ARRAY'; - - my $key; - - syslog('LOG_DEBUG', "OILS: Checkout permit returned event: " . OpenSRF::Utils::JSON->perl2JSON($resp)); - - if( @$resp == 1 and ! $U->event_code($$resp[0]) ) { - $key = $$resp[0]->{payload}; - syslog('LOG_INFO', "OILS: circ permit key => $key"); - - } else { - - # We got one or more non-success events - $self->screen_msg(''); - for my $r (@$resp) { - - if( my $code = $U->event_code($resp) ) { - my $txt = $resp->{textcode}; - syslog('LOG_INFO', "OILS: Checkout permit failed with event $code : $txt"); - - if( $txt eq 'OPEN_CIRCULATION_EXISTS' ) { - $self->screen_msg(OILS_SIP_MSG_CIRC_EXISTS); - return 0; - } else { - $self->screen_msg(OILS_SIP_MSG_CIRC_PERMIT_FAILED); - } - } - } - return 0; - } - - # -------------------------------------------------------------------- - # Now do the actual checkout - # -------------------------------------------------------------------- - - $args = { - permit_key => $key, - patron_barcode => $self->{patron}->id, - barcode => $self->{item}->id - }; - - $resp = $U->simplereq( - 'open-ils.circ', - 'open-ils.circ.checkout', $self->{authtoken}, $args ); - } - - syslog('LOG_INFO', "OILS: Checkout returned event: " . OpenSRF::Utils::JSON->perl2JSON($resp)); - - # XXX Check for events - if( $resp ) { - - if( my $code = $U->event_code($resp) ) { - my $txt = $resp->{textcode}; - syslog('LOG_INFO', "OILS: Checkout failed with event $code : $txt"); - $self->screen_msg('Checkout failed. Please contact a librarian'); - return 0; - } - - syslog('LOG_INFO', "OILS: Checkout succeeded"); - - my $circ = $resp->{payload}->{circ}; - $self->{'due'} = OpenILS::SIP->format_date($circ->due_date, 'due'); - $self->ok(1); - - return 1; - } - - return 0; -} - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/SIP/Transaction/Renew.pm b/Open-ILS/src/perlmods/OpenILS/SIP/Transaction/Renew.pm deleted file mode 100644 index fb2681e1d6..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/SIP/Transaction/Renew.pm +++ /dev/null @@ -1,57 +0,0 @@ -# -# Status of a Renew Transaction -# - -package OpenILS::SIP::Transaction::Renew; -use warnings; use strict; - -use Sys::Syslog qw(syslog); -use OpenILS::SIP; -use OpenILS::SIP::Transaction; -use OpenILS::Application::AppUtils; -my $U = 'OpenILS::Application::AppUtils'; - -our @ISA = qw(OpenILS::SIP::Transaction); - -my %fields = ( - renewal_ok => 0, - ); - -sub new { - my $class = shift;; - my $self = $class->SUPER::new(@_); - - $self->{_permitted}->{$_} = $fields{$_} for keys %fields; - @{$self}{keys %fields} = values %fields; - - return bless $self, $class; -} - -sub do_renew { - my $self = shift; - - my $resp = $U->simplereq( - 'open-ils.circ', - 'open-ils.circ.renew', $self->{authtoken}, - { barcode => $self->item->id, patron_barcode => $self->patron->id }); - - if( my $code = $U->event_code($resp) ) { - syslog('LOG_INFO', "OILS: Renewal failed with event $code : " . $resp->{textcode}); - $self->renewal_ok(0); - $self->ok(0); - return $self; - } - - $self->item->{due_date} = $resp->{payload}->{circ}->due_date; - syslog('LOG_INFO', "OILS: Renewal succeeded with due_date = " . $self->item->{due_date}); - - $self->renewal_ok(1); - $self->ok(1); - - return $self; -} - - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Template/Plugin/Unicode.pm b/Open-ILS/src/perlmods/OpenILS/Template/Plugin/Unicode.pm deleted file mode 100644 index 6a3423793a..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Template/Plugin/Unicode.pm +++ /dev/null @@ -1,12 +0,0 @@ -package OpenILS::Template::Plugin::Unicode; -use Unicode::Normalize; - -sub new { return bless {}, __PACKAGE__ } -sub load { return __PACKAGE__ } - -sub C { shift; return NFC(@_); } -sub D { shift; return NFD(@_); } -sub entityDecode { shift; $_ = shift; s/&#x([0-9a-fA-F]+);/chr(hex($1))/egos; return $_ } -sub entityEncode { shift; $_ = shift; s/(\PM\pM+)/sprintf('&#x%0.4x;',ord(NFC($1)))/sgoe; return $_ } - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Template/Plugin/WebSession.pm b/Open-ILS/src/perlmods/OpenILS/Template/Plugin/WebSession.pm deleted file mode 100644 index ace78c0a35..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Template/Plugin/WebSession.pm +++ /dev/null @@ -1,34 +0,0 @@ -package OpenILS::Template::Plugin::WebSession; -use strict; use warnings; -use OpenILS::Utils::Fieldmapper; - -use Template::Plugin; -use base qw/Template::Plugin/; -use OpenSRF::AppSession; -use OpenSRF::System; - -sub new { - my ($class) = @_; - $class = ref($class) || $class; - my $self = {}; - return bless($self,$class); -} - -my $bootstrapped = 0; -sub bootstrap_client { - my( $self, $config_file ) = @_; - if(!$bootstrapped) { - OpenSRF::System->bootstrap_client( config_file => $config_file ); - $bootstrapped = 1; - } -} - -sub init_app_session { - my($self, $service) = @_; - return undef unless $service; - return OpenSRF::AppSession->create($service); -} - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Template/Plugin/WebUtils.pm b/Open-ILS/src/perlmods/OpenILS/Template/Plugin/WebUtils.pm deleted file mode 100644 index 050aee2b4a..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Template/Plugin/WebUtils.pm +++ /dev/null @@ -1,49 +0,0 @@ -package OpenILS::Template::Plugin::WebUtils; -use strict; use warnings; -use OpenILS::Utils::Fieldmapper; - -use Template::Plugin; -use base qw/Template::Plugin/; -use OpenSRF::AppSession; -use OpenSRF::System; -use XML::LibXML; -use OpenSRF::Utils::SettingsParser; -use OpenSRF::Utils::JSON; - -sub new { - my ($class) = @_; - $class = ref($class) || $class; - my $self = {}; - return bless($self,$class); -} - - -sub XML2perl { - my( $self, $doc ) = @_; - return OpenSRF::Utils::SettingsParser::XML2perl($doc); -} - - -sub perl2JSON { - my( $self, $perl ) = @_; - my $json = OpenSRF::Utils::JSON->perl2JSON($perl); - warn "Created JSON from perl:\n$json\n"; - return $json; -} - -sub JSON2perl { - my( $self, $perl ) = @_; - warn "Turning JSON into perl:\n$perl\n"; - my $obj = OpenSRF::Utils::JSON->JSON2perl($perl); - warn "Created Perl from JSON: $obj \n"; - return $obj; -} - -sub perl2prettyJSON { - my( $self, $perl ) = @_; - return OpenSRF::Utils::JSON->perl2prettyJSON($perl); -} - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/CStoreEditor.pm b/Open-ILS/src/perlmods/OpenILS/Utils/CStoreEditor.pm deleted file mode 100644 index ff298f42d1..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/CStoreEditor.pm +++ /dev/null @@ -1,856 +0,0 @@ -use strict; use warnings; -package OpenILS::Utils::CStoreEditor; -use OpenILS::Application::AppUtils; -use OpenSRF::AppSession; -use OpenSRF::EX qw(:try); -use OpenILS::Utils::Fieldmapper; -use OpenILS::Event; -use Data::Dumper; -use OpenSRF::Utils::JSON; -use OpenSRF::Utils::Logger qw($logger); -my $U = "OpenILS::Application::AppUtils"; -my %PERMS; -my $cache; -my %xact_ed_cache; - -our $always_xact = 0; -our $_loaded = 1; - -#my %PERMS = ( -# 'biblio.record_entry' => { update => 'UPDATE_MARC' }, -# 'asset.copy' => { update => 'UPDATE_COPY'}, -# 'asset.call_number' => { update => 'UPDATE_VOLUME'}, -# 'action.circulation' => { retrieve => 'VIEW_CIRCULATIONS'}, -#); - -sub flush_forced_xacts { - for my $k ( keys %xact_ed_cache ) { - try { - $xact_ed_cache{$k}->rollback; - } catch Error with { - # rollback failed - }; - delete $xact_ed_cache{$k}; - } -} - -# ----------------------------------------------------------------------------- -# Export some useful functions -# ----------------------------------------------------------------------------- -use vars qw(@EXPORT_OK %EXPORT_TAGS); -use Exporter; -use base qw/Exporter/; -push @EXPORT_OK, ( 'new_editor', 'new_rstore_editor' ); -%EXPORT_TAGS = ( funcs => [ qw/ new_editor new_rstore_editor / ] ); - -sub new_editor { return OpenILS::Utils::CStoreEditor->new(@_); } - -sub new_rstore_editor { - my $e = OpenILS::Utils::CStoreEditor->new(@_); - $e->app('open-ils.reporter-store'); - return $e; -} - - -# ----------------------------------------------------------------------------- -# Log levels -# ----------------------------------------------------------------------------- -use constant E => 'error'; -use constant W => 'warn'; -use constant I => 'info'; -use constant D => 'debug'; -use constant A => 'activity'; - - - -# ----------------------------------------------------------------------------- -# Params include: -# xact=> : creates a storage transaction -# authtoken=>$token : the login session key -# ----------------------------------------------------------------------------- -sub new { - my( $class, %params ) = @_; - $class = ref($class) || $class; - my $self = bless( \%params, $class ); - $self->{checked_perms} = {}; - return $self; -} - -sub DESTROY { - my $self = shift; - $self->reset; - return undef; -} - -sub app { - my( $self, $app ) = @_; - $self->{app} = $app if $app; - $self->{app} = 'open-ils.cstore' unless $self->{app}; - return $self->{app}; -} - - -# ----------------------------------------------------------------------------- -# Log the editor metadata along with the log string -# ----------------------------------------------------------------------------- -sub log { - my( $self, $lev, $str ) = @_; - my $s = "editor["; - if ($always_xact) { - $s .= "!|"; - } elsif ($self->{xact}) { - $s .= "1|"; - } else { - $s .= "0|"; - } - $s .= "0" unless $self->requestor; - $s .= $self->requestor->id if $self->requestor; - $s .= "]"; - $logger->$lev("$s $str"); -} - -# ----------------------------------------------------------------------------- -# Verifies the auth token and fetches the requestor object -# ----------------------------------------------------------------------------- -sub checkauth { - my $self = shift; - $self->log(D, "checking auth token ".$self->authtoken); - my ($reqr, $evt) = $U->checkses($self->authtoken); - $self->event($evt) if $evt; - return $self->{requestor} = $reqr; -} - - -=head test -sub checkauth { - my $self = shift; - $cache = OpenSRF::Utils::Cache->new('global') unless $cache; - $self->log(D, "checking cached auth token ".$self->authtoken); - my $user = $cache->get_cache("oils_auth_".$self->authtoken); - return $self->{requestor} = $user->{userobj} if $user; - $self->event(OpenILS::Event->new('NO_SESSION')); - return undef; -} -=cut - - -# ----------------------------------------------------------------------------- -# Returns the last generated event -# ----------------------------------------------------------------------------- -sub event { - my( $self, $evt ) = @_; - $self->{event} = $evt if $evt; - return $self->{event}; -} - -# ----------------------------------------------------------------------------- -# Destroys the transaction and disconnects where necessary, -# then returns the last event that occurred -# ----------------------------------------------------------------------------- -sub die_event { - my $self = shift; - my $evt = shift; - $self->rollback; - $self->died(1); - $self->event($evt); - return $self->event; -} - - -# ----------------------------------------------------------------------------- -# Clears the last caught event -# ----------------------------------------------------------------------------- -sub clear_event { - my $self = shift; - $self->{event} = undef; -} - -sub died { - my($self, $died) = @_; - $self->{died} = $died if defined $died; - return $self->{died}; -} - -sub authtoken { - my( $self, $auth ) = @_; - $self->{authtoken} = $auth if $auth; - return $self->{authtoken}; -} - -sub timeout { - my($self, $to) = @_; - $self->{timeout} = $to if defined $to; - return defined($self->{timeout}) ? $self->{timeout} : 60; -} - -# ----------------------------------------------------------------------------- -# fetches the session, creating if necessary. If 'xact' is true on this -# object, a db session is created -# ----------------------------------------------------------------------------- -sub session { - my( $self, $session ) = @_; - $self->{session} = $session if $session; - - if(!$self->{session}) { - $self->{session} = OpenSRF::AppSession->create($self->app); - - if( ! $self->{session} ) { - my $str = "Error creating cstore session with OpenSRF::AppSession->create()!"; - $self->log(E, $str); - throw OpenSRF::EX::ERROR ($str); - } - - $self->{session}->connect if $self->{xact} or $self->{connect} or $always_xact; - $self->xact_begin if $self->{xact} or $always_xact; - } - - $xact_ed_cache{$self->{xact_id}} = $self if $always_xact and $self->{xact_id}; - return $self->{session}; -} - - -# ----------------------------------------------------------------------------- -# Starts a storage transaction -# ----------------------------------------------------------------------------- -sub xact_begin { - my $self = shift; - return $self->{xact_id} if $self->{xact_id}; - $self->session->connect unless $self->session->state == OpenSRF::AppSession::CONNECTED(); - $self->log(D, "starting new database transaction"); - unless($self->{xact_id}) { - my $stat = $self->request($self->app . '.transaction.begin'); - $self->log(E, "error starting database transaction") unless $stat; - $self->{xact_id} = $stat; - } - $self->{xact} = 1; - return $self->{xact_id}; -} - -# ----------------------------------------------------------------------------- -# Commits a storage transaction -# ----------------------------------------------------------------------------- -sub xact_commit { - my $self = shift; - return unless $self->{xact_id}; - $self->log(D, "comitting db session"); - my $stat = $self->request($self->app.'.transaction.commit'); - $self->log(E, "error comitting database transaction") unless $stat; - delete $self->{xact_id}; - delete $self->{xact}; - return $stat; -} - -# ----------------------------------------------------------------------------- -# Rolls back a storage stransaction -# ----------------------------------------------------------------------------- -sub xact_rollback { - my $self = shift; - return unless $self->{session} and $self->{xact_id}; - $self->log(I, "rolling back db session"); - my $stat = $self->request($self->app.".transaction.rollback"); - $self->log(E, "error rolling back database transaction") unless $stat; - delete $self->{xact_id}; - delete $self->{xact}; - return $stat; -} - - -# ----------------------------------------------------------------------------- -# Savepoint functions. If no savepoint name is provided, the same name is used -# for each successive savepoint, in which case only the last savepoint set can -# be released or rolled back. -# ----------------------------------------------------------------------------- -sub set_savepoint { - my $self = shift; - my $name = shift || 'savepoint'; - return unless $self->{session} and $self->{xact_id}; - $self->log(I, "setting savepoint '$name'"); - my $stat = $self->request($self->app.".savepoint.set", $name) - or $self->log(E, "error setting savepoint '$name'"); - return $stat; -} - -sub release_savepoint { - my $self = shift; - my $name = shift || 'savepoint'; - return unless $self->{session} and $self->{xact_id}; - $self->log(I, "releasing savepoint '$name'"); - my $stat = $self->request($self->app.".savepoint.release", $name) - or $self->log(E, "error releasing savepoint '$name'"); - return $stat; -} - -sub rollback_savepoint { - my $self = shift; - my $name = shift || 'savepoint'; - return unless $self->{session} and $self->{xact_id}; - $self->log(I, "rollback savepoint '$name'"); - my $stat = $self->request($self->app.".savepoint.rollback", $name) - or $self->log(E, "error rolling back savepoint '$name'"); - return $stat; -} - - -# ----------------------------------------------------------------------------- -# Rolls back the transaction and disconnects -# ----------------------------------------------------------------------------- -sub rollback { - my $self = shift; - my $err; - my $ret; - try { - $self->xact_rollback; - } catch Error with { - $err = shift - } finally { - $ret = $self->disconnect - }; - throw $err if ($err); - return $ret; -} - -sub disconnect { - my $self = shift; - $self->session->disconnect if - $self->{session} and - $self->{session}->state == OpenSRF::AppSession::CONNECTED(); - delete $self->{session}; -} - - -# ----------------------------------------------------------------------------- -# commits the db session and destroys the session -# returns the status of the commit call -# ----------------------------------------------------------------------------- -sub commit { - my $self = shift; - return unless $self->{xact_id}; - my $stat = $self->xact_commit; - $self->disconnect; - return $stat; -} - -# ----------------------------------------------------------------------------- -# clears all object data. Does not commit the db transaction. -# ----------------------------------------------------------------------------- -sub reset { - my $self = shift; - $self->disconnect; - $$self{$_} = undef for (keys %$self); -} - - -# ----------------------------------------------------------------------------- -# commits and resets -# ----------------------------------------------------------------------------- -sub finish { - my $self = shift; - my $err; - my $ret; - try { - $self->commit; - } catch Error with { - $err = shift - } finally { - $ret = $self->reset - }; - throw $err if ($err); - return $ret; -} - - - -# ----------------------------------------------------------------------------- -# Does a simple storage request -# ----------------------------------------------------------------------------- -sub request { - my( $self, $method, @params ) = @_; - - my $val; - my $err; - my $argstr = __arg_to_string( (scalar(@params)) == 1 ? $params[0] : \@params); - my $locale = $self->session->session_locale; - - $self->log(I, "request $locale $method $argstr"); - - if( ($self->{xact} or $always_xact) and - $self->session->state != OpenSRF::AppSession::CONNECTED() ) { - #$logger->error("CStoreEditor lost it's connection!!"); - throw OpenSRF::EX::ERROR ("CStore connection timed out - transaction cannot continue"); - } - - - try { - - my $req = $self->session->request($method, @params); - - if($self->substream) { - $self->log(D,"running in substream mode"); - $val = []; - while( my $resp = $req->recv(timeout => $self->timeout) ) { - push(@$val, $resp->content) if $resp->content and not $self->discard; - } - - } else { - my $resp = $req->recv(timeout => $self->timeout); - if($req->failed) { - $err = $resp; - $self->log(E, "request error $method : $argstr : $err"); - } else { - $val = $resp->content if $resp; - } - } - - $req->finish; - - } catch Error with { - $err = shift; - $self->log(E, "request error $method : $argstr : $err"); - }; - - throw $err if $err; - return $val; -} - -sub substream { - my( $self, $bool ) = @_; - $self->{substream} = $bool if defined $bool; - return $self->{substream}; -} - -# ----------------------------------------------------------------------------- -# discard response data instead of returning it to the caller. currently only -# works in conjunction with substream mode. -# ----------------------------------------------------------------------------- -sub discard { - my( $self, $bool ) = @_; - $self->{discard} = $bool if defined $bool; - return $self->{discard}; -} - - -# ----------------------------------------------------------------------------- -# Sets / Returns the requestor object. This is set when checkauth succeeds. -# ----------------------------------------------------------------------------- -sub requestor { - my($self, $requestor) = @_; - $self->{requestor} = $requestor if $requestor; - return $self->{requestor}; -} - - - -# ----------------------------------------------------------------------------- -# Holds the last data received from a storage call -# ----------------------------------------------------------------------------- -sub data { - my( $self, $data ) = @_; - $self->{data} = $data if defined $data; - return $self->{data}; -} - - -# ----------------------------------------------------------------------------- -# True if this perm has already been checked at this org -# ----------------------------------------------------------------------------- -sub perm_checked { - my( $self, $perm, $org ) = @_; - $self->{checked_perms}->{$org} = {} - unless $self->{checked_perms}->{$org}; - my $checked = $self->{checked_perms}->{$org}->{$perm}; - if(!$checked) { - $self->{checked_perms}->{$org}->{$perm} = 1; - return 0; - } - return 1; -} - - - -# ----------------------------------------------------------------------------- -# Returns true if the requested perm is allowed. If the perm check fails, -# $e->event is set and undef is returned -# The perm user is $e->requestor->id and perm org defaults to the requestor's -# ws_ou -# if perm is an array of perms, method will return true at the first allowed -# permission. If none of the perms are allowed, the perm_failure event -# is created with the last perm to fail -# ----------------------------------------------------------------------------- -my $PERM_QUERY = { - select => { - au => [ { - transform => 'permission.usr_has_perm', - alias => 'has_perm', - column => 'id', - params => [] - } ] - }, - from => 'au', - where => {}, -}; - -my $OBJECT_PERM_QUERY = { - select => { - au => [ { - transform => 'permission.usr_has_object_perm', - alias => 'has_perm', - column => 'id', - params => [] - } ] - }, - from => 'au', - where => {}, -}; - -sub allowed { - my( $self, $perm, $org, $object, $hint ) = @_; - my $uid = $self->requestor->id; - $org ||= $self->requestor->ws_ou; - - my $perms = (ref($perm) eq 'ARRAY') ? $perm : [$perm]; - - for $perm (@$perms) { - $self->log(I, "checking perms user=$uid, org=$org, perm=$perm"); - - if($object) { - my $params; - if(ref $object) { - # determine the ID field and json_hint from the object - my $id_field = $object->Identity; - $params = [$perm, $object->json_hint, $object->$id_field]; - } else { - # we were passed an object-id and json_hint - $params = [$perm, $hint, $object]; - } - push(@$params, $org) if $org; - $OBJECT_PERM_QUERY->{select}->{au}->[0]->{params} = $params; - $OBJECT_PERM_QUERY->{where}->{id} = $uid; - return 1 if $U->is_true($self->json_query($OBJECT_PERM_QUERY)->[0]->{has_perm}); - - } else { - $PERM_QUERY->{select}->{au}->[0]->{params} = [$perm, $org]; - $PERM_QUERY->{where}->{id} = $uid; - return 1 if $U->is_true($self->json_query($PERM_QUERY)->[0]->{has_perm}); - } - } - - # set the perm failure event if the permission check returned false - my $e = OpenILS::Event->new('PERM_FAILURE', ilsperm => $perm, ilspermloc => $org); - $self->event($e); - return undef; -} - - -# ----------------------------------------------------------------------------- -# Returns the list of object IDs this user has object-specific permissions for -# ----------------------------------------------------------------------------- -sub objects_allowed { - my($self, $perm, $obj_type) = @_; - - my $perms = (ref($perm) eq 'ARRAY') ? $perm : [$perm]; - my @ids; - - for $perm (@$perms) { - my $query = { - select => {puopm => ['object_id']}, - from => { - puopm => { - ppl => {field => 'id',fkey => 'perm'} - } - }, - where => { - '+puopm' => {usr => $self->requestor->id, object_type => $obj_type}, - '+ppl' => {code => $perm} - } - }; - - my $list = $self->json_query($query); - push(@ids, 0+$_->{object_id}) for @$list; - } - - my %trim; - $trim{$_} = 1 for @ids; - return [ keys %trim ]; -} - - -# ----------------------------------------------------------------------------- -# checks the appropriate perm for the operation -# ----------------------------------------------------------------------------- -sub _checkperm { - my( $self, $ptype, $action, $org ) = @_; - $org ||= $self->requestor->ws_ou; - my $perm = $PERMS{$ptype}{$action}; - if( $perm ) { - return undef if $self->perm_checked($perm, $org); - return $self->event unless $self->allowed($perm, $org); - } else { - $self->log(I, "no perm provided for $ptype.$action"); - } - return undef; -} - - - -# ----------------------------------------------------------------------------- -# Logs update actions to the activity log -# ----------------------------------------------------------------------------- -sub log_activity { - my( $self, $type, $action, $arg ) = @_; - my $str = "$type.$action"; - $str .= _prop_string($arg); - $self->log(A, $str); -} - - - -sub _prop_string { - my $obj = shift; - my @props = $obj->properties; - my $str = ""; - for(@props) { - my $prop = $obj->$_() || ""; - $prop = substr($prop, 0, 128) . "..." if length $prop > 131; - $str .= " $_=$prop"; - } - return $str; -} - - -sub __arg_to_string { - my $arg = shift; - return "" unless defined $arg; - if( UNIVERSAL::isa($arg, "Fieldmapper") ) { - my $idf = $arg->Identity; - return (defined $arg->$idf) ? $arg->$idf : ''; - } - return OpenSRF::Utils::JSON->perl2JSON($arg); - return ""; -} - - -# ----------------------------------------------------------------------------- -# This does the actual storage query. -# -# 'search' calls become search_where calls and $arg can be a search hash or -# an array-ref of storage search options. -# -# 'retrieve' expects an id -# 'update' expects an object -# 'create' expects an object -# 'delete' expects an object -# -# All methods return true on success and undef on failure. On failure, -# $e->event is set to the generated event. -# Note: this method assumes that updating a non-changed object and -# thereby receiving a 0 from storage, is a successful update. -# -# The method will therefore return true so the caller can just do -# $e->update_blah($x) or return $e->event; -# The true value returned from storage for all methods will be stored in -# $e->data, until the next method is called. -# -# not-found events are generated on retrieve and serach methods. -# action=search methods will return [] (==true) if no data is found. If the -# caller is interested in the not found event, they can do: -# return $e->event unless @$results; -# ----------------------------------------------------------------------------- -sub runmethod { - my( $self, $action, $type, $arg, $options ) = @_; - - $options ||= {}; - - if( $action eq 'retrieve' ) { - if(! defined($arg) ) { - $self->log(W,"$action $type called with no ID..."); - $self->event(_mk_not_found($type, $arg)); - return undef; - } elsif( ref($arg) =~ /Fieldmapper/ ) { - $self->log(D,"$action $type called with an object.. attempting Identity retrieval.."); - my $idf = $arg->Identity; - $arg = $arg->$idf; - } - } - - my @arg = ( ref($arg) eq 'ARRAY' ) ? @$arg : ($arg); - my $method = $self->app.".direct.$type.$action"; - - if( $action eq 'search' ) { - $method .= '.atomic'; - - } elsif( $action eq 'batch_retrieve' ) { - $action = 'search'; - @arg = ( { id => $arg } ); - $method =~ s/batch_retrieve/search/o; - $method .= '.atomic'; - - } elsif( $action eq 'retrieve_all' ) { - $action = 'search'; - $method =~ s/retrieve_all/search/o; - my $tt = $type; - $tt =~ s/\./::/og; - my $fmobj = "Fieldmapper::$tt"; - @arg = ( { $fmobj->Identity => { '!=' => undef } } ); - $method .= '.atomic'; - } - - $method =~ s/search/id_list/o if $options->{idlist}; - - $method =~ s/\.atomic$//o if $self->substream($$options{substream} || 0); - $self->timeout($$options{timeout}); - $self->discard($$options{discard}); - - # remove any stale events - $self->clear_event; - - if( $action eq 'update' or $action eq 'delete' or $action eq 'create' ) { - if(!($self->{xact} or $always_xact)) { - $logger->error("Attempt to update DB while not in a transaction : $method"); - throw OpenSRF::EX::ERROR ("Attempt to update DB while not in a transaction : $method"); - } - $self->log_activity($type, $action, $arg); - } - - if($$options{checkperm}) { - my $a = ($action eq 'search') ? 'retrieve' : $action; - my $e = $self->_checkperm($type, $a, $$options{permorg}); - if($e) { - $self->event($e); - return undef; - } - } - - my $obj; - my $err = ''; - - try { - $obj = $self->request($method, @arg); - } catch Error with { $err = shift; }; - - - if(!defined $obj) { - $self->log(I, "request returned no data : $method"); - - if( $action eq 'retrieve' ) { - $self->event(_mk_not_found($type, $arg)); - - } elsif( $action eq 'update' or - $action eq 'delete' or $action eq 'create' ) { - my $evt = OpenILS::Event->new( - 'DATABASE_UPDATE_FAILED', payload => $arg, debug => "$err" ); - $self->event($evt); - } - - if( $err ) { - $self->event( - OpenILS::Event->new( 'DATABASE_QUERY_FAILED', - payload => $arg, debug => "$err" )); - return undef; - } - - return undef; - } - - if( $action eq 'create' and $obj == 0 ) { - my $evt = OpenILS::Event->new( - 'DATABASE_UPDATE_FAILED', payload => $arg, debug => "$err" ); - $self->event($evt); - return undef; - } - - # If we havn't dealt with the error in a nice way, go ahead and throw it - if( $err ) { - $self->event( - OpenILS::Event->new( 'DATABASE_QUERY_FAILED', - payload => $arg, debug => "$err" )); - return undef; - } - - if( $action eq 'search' ) { - $self->log(I, "$type.$action : returned ".scalar(@$obj). " result(s)"); - $self->event(_mk_not_found($type, $arg)) unless @$obj; - } - - if( $action eq 'create' ) { - my $idf = $obj->Identity; - $self->log(I, "created a new $type object with Identity " . $obj->$idf); - $arg->$idf($obj->$idf); - } - - $self->data($obj); # cache the data for convenience - - return ($obj) ? $obj : 1; -} - - -sub _mk_not_found { - my( $type, $arg ) = @_; - (my $t = $type) =~ s/\./_/og; - $t = uc($t); - return OpenILS::Event->new("${t}_NOT_FOUND", payload => $arg); -} - - - -# utility method for loading -sub __fm2meth { - my $str = shift; - my $sep = shift; - $str =~ s/Fieldmapper:://o; - $str =~ s/::/$sep/g; - return $str; -} - - -# ------------------------------------------------------------- -# Load up the methods from the FM classes -# ------------------------------------------------------------- - -sub init { - no warnings; # Here we potentially redefine subs via eval - my $map = $Fieldmapper::fieldmap; - for my $object (keys %$map) { - my $obj = __fm2meth($object, '_'); - my $type = __fm2meth($object, '.'); - foreach my $command (qw/ update retrieve search create delete batch_retrieve retrieve_all /) { - eval "sub ${command}_$obj {return shift()->runmethod('$command', '$type', \@_);}\n"; - } - # TODO: performance test against concatenating a big string of all the subs and eval'ing only ONCE. - } -} - -init(); # Add very many subs to this namespace - -sub json_query { - my( $self, $arg, $options ) = @_; - $options ||= {}; - my @arg = ( ref($arg) eq 'ARRAY' ) ? @$arg : ($arg); - my $method = $self->app.'.json_query.atomic'; - $method =~ s/\.atomic$//o if $self->substream($$options{substream} || 0); - - $self->timeout($$options{timeout}); - $self->discard($$options{discard}); - $self->clear_event; - my $obj; - my $err; - - try { - $obj = $self->request($method, @arg); - } catch Error with { $err = shift; }; - - if( $err ) { - $self->event( - OpenILS::Event->new( 'DATABASE_QUERY_FAILED', - payload => $arg, debug => "$err" )); - return undef; - } - - $self->log(I, "json_query : returned ".scalar(@$obj). " result(s)") if (ref($obj)); - return $obj; -} - - - -1; - - diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/Cronscript.pm.in b/Open-ILS/src/perlmods/OpenILS/Utils/Cronscript.pm.in deleted file mode 100644 index 73281fbc60..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/Cronscript.pm.in +++ /dev/null @@ -1,371 +0,0 @@ -package OpenILS::Utils::Cronscript; - -# --------------------------------------------------------------- -# Copyright (C) 2010 Equinox Software, Inc -# Author: Joe Atzberger -# -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# --------------------------------------------------------------- - -# The purpose of this module is to consolidate the common aspects -# of various cron tasks that all need the same things: -# ~ non-duplicative processing, i.e. lockfiles and lockfile checking -# ~ opensrf_core.xml file location -# ~ common options like help and debug - -use strict; -use warnings; - -use Getopt::Long qw(:DEFAULT GetOptionsFromArray); -use OpenSRF::System; -use OpenSRF::AppSession; -use OpenSRF::Utils::JSON; -use OpenSRF::EX qw(:try); -use OpenILS::Utils::Fieldmapper; -use OpenILS::Utils::Lockfile; -use OpenILS::Utils::CStoreEditor q/:funcs/; - -use File::Basename qw/fileparse/; - -use Data::Dumper; -use Carp; - -our @extra_opts = ( # additional keys are stored here - # 'addlopt' -); - -our $debug = 0; - -sub _default_self { - return { - # opts => {}, - # opts_clean => {}, - # default_opts_clean => {}, - default_opts => { - 'lock-file=s' => OpenILS::Utils::Lockfile::default_filename, - 'osrf-config=s' => '@sysconfdir@/opensrf_core.xml', - 'debug' => 0, - 'verbose+' => 0, - 'help' => 0, - # 'internal_var' => 'XYZ', - }, - # lockfile => undef, - # session => undef, - # bootstrapped => 0, - # got_options => 0, - auto_get_options_4_bootstrap => 1, - }; -} - -sub is_clean { - my $key = shift or return 1; - $key =~ /[=:].*$/ and return 0; - $key =~ /[+!]$/ and return 0; - return 1; -} - -sub clean { - my $key = shift or return; - $key =~ s/[=:].*$//; - $key =~ s/[+!]$//; - return $key; -} - -sub fuzzykey { # when you know the hash you want from, but not the exact key - my $self = shift or return; - my $key = shift or return; - my $target = @_ ? shift : 'opts_clean'; - foreach (map {clean($_)} keys %{$self->{default_opts}}) { # TODO: cache - $key eq $_ and return $self->{$target}->{$_}; - } -} - -# MyGetOptions -# A wrapper around GetOptions -# {opts} does two things for GetOptions (see Getopt::Long) -# (1) maps command-line options to the *other* variables where values are stored (in opts_clean) -# (2) provides hashspace for the rest of the arbitrary options from the command-line -# -# TODO: allow more options to be passed here, maybe mimic Getopt::Long::GetOptions style -# -# If an arrayref argument is passed, then @ARGV will NOT be touched. -# Instead, the array will be passed to GetOptionsFromArray. -# - -sub MyGetOptions { - my $self = shift; - my $arrayref = @_ ? shift : undef; - if ($arrayref and ref($arrayref) ne 'ARRAY') { - carp "MyGetOptions argument is not an array ref. Expect GetOptionsFromArray to explode"; - } - $self->{got_options} and carp "MyGetOptions called after options were already retrieved previously"; - my @keys = sort {is_clean($b) <=> is_clean($a)} keys %{$self->{default_opts}}; - $debug and print "KEYS: ", join(", ", @keys), "\n"; - foreach (@keys) { - my $clean = clean($_); - my $place = $self->{default_opts_clean}->{$clean}; - $self->{opts_clean}->{$clean} = $place; # prepopulate default - # $self->{opts}->{$_} = $self->{opts_clean}->{$clean}; # pointer for GetOptions - $self->{opts}->{$_} = sub { - my $opt = shift; - my $val = shift; - ref ( $self->{opts_clean}->{$opt} ) and ref($self->{opts_clean}->{$opt}) eq 'SCALAR' - and ${$self->{opts_clean}->{$opt}} = $val; # set the referent's value - $self->{opts_clean}->{$opt} = $val; # burn the map, stick the value there - }; # pointer for GetOptions - } - $arrayref ? GetOptionsFromArray($arrayref, $self->{opts}, @keys) - : GetOptions( $self->{opts}, @keys) ; - - foreach (@keys) { - delete $self->{opts}->{$_}; # now remove the mappings from (1) so we just have (2) - } - $self->clean_mirror('opts'); # populate clean_opts w/ cleaned versions of (2), plus everything else - - print $self->help() and exit if $self->{opts_clean}->{help}; - $self->new_lockfile(); - $self->{got_options}++; - return wantarray ? %{$self->{opts_clean}} : $self->{opts_clean}; -} - -sub new_lockfile { - my $self = shift; - $debug and $OpenILS::Utils::Lockfile::debug = $debug; - unless ($self->{opts_clean}->{nolockfile} || $self->{default_opts_clean}->{nolockfile}) { - $self->{lockfile_obj} = OpenILS::Utils::Lockfile->new($self->first_defined('lock-file')); - $self->{lockfile} = $self->{lockfile_obj}->filename; - } -} - -sub first_defined { - my $self = shift; - my $key = shift or return; - foreach (qw(opts_clean opts default_opts_clean default_opts)) { - defined $self->{$_}->{$key} and return $self->{$_}->{$key}; - } - return; -} - -sub clean_mirror { - my $self = shift; - my $dirty = @_ ? shift : 'default_opts'; - foreach (keys %{$self->{$dirty}}) { - defined $self->{$dirty}->{$_} or next; - $self->{$dirty . '_clean'}->{clean($_)} = $self->{$dirty}->{$_}; - } -} - -sub new { - my $class = shift; - my $self = _default_self; - bless ($self, $class); - $self->init(@_); - $debug and print "new ", __PACKAGE__, " obj: ", Dumper($self); - return $self; -} - -sub add_and_purge { - my $self = shift; - my $key = shift; - my $val = shift; - my $clean = clean($key); - my @others = grep {/$clean/ and $_ ne $key} keys %{$self->{default_opts}}; - unless (@others) { - $debug and print "unique key $key => $val\n"; - $self->{default_opts}->{$key} = $val; # no purge, just add - return; - } - foreach (@others) { - $debug and print "variant of $key => $_\n"; - if ($key ne $clean) { # if it is a dirtier key, delete the clean one - delete $self->{default_opts}->{$_}; - $self->{default_opts}->{$key} = $val; - } else { # else update the dirty one - $self->{default_opts}->{$_} = $val; - } - } -} - -sub init { # not INIT - my $self = shift; - my $opts = @_ ? shift : {}; # user can specify more default options to constructor -# TODO: check $opts is hashref; then check verbose/debug first. maybe check negations e.g. "no-verbose" ? - @extra_opts = keys %$opts; - foreach (@extra_opts) { # add any other keys w/ default values - $debug and print "init() adding option $_, default value: $opts->{$_}\n"; - $self->add_and_purge($_, $opts->{$_}); - } - $self->clean_mirror; - return $self; -} - -sub usage { - # my $self = shift; - return "\nUSAGE: $0 [OPTIONS]"; -} - -sub options_help { - my $self = shift; - my $chunk = @_ ? shift : ''; - return < Default: $self->{default_opts_clean}->{'osrf-config'} - Specify OpenSRF core config file. - - --lock-file Default: $self->{default_opts_clean}->{'lock-file'} - Specify lock file. - -HELP - . $chunk . <usage() . "\n" . $self->options_help(@_) . $self->example(); -} - -sub example { - return "\n\nEXAMPLES:\n\n $0 --osrf-config /my/other/opensrf_core.xml\n"; -} - -# the proper order is: MyGetOptions, bootstrap, session. -# But the latter subs will check to see if they need to call the preceeding one(s). - -sub session { - my $self = shift or return; - $self->{bootstrapped} or $self->bootstrap(); - @_ or croak "session() called without required argument (app_name, e.g. 'open-ils.acq')"; - return ($self->{session} ||= OpenSRF::AppSession->create(@_)); -} - -sub bootstrap { - my $self = shift or return; - if ($self->{auto_get_options_4_bootstrap} and not $self->{got_options}) { - $debug and print "Automatically calling MyGetOptions before bootstrap\n"; - $self->MyGetOptions(); - } - try { - $debug and print "bootstrap lock-file : ", $self->first_defined('lock-file'), "\n"; - $debug and print "bootstrap osrf-config: ", $self->first_defined('osrf-config'), "\n"; - OpenSRF::System->bootstrap_client(config_file => $self->first_defined('osrf-config')); - Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL")); - $self->{bootstrapped} = 1; - } otherwise { - $self->{bootstrapped} = 0; - warn shift; - }; -} - -sub editor_init { - my $self = shift or return; - OpenILS::Utils::CStoreEditor::init(); # no return value to check - $self->{editor_inited} = 1; -} - -sub editor { - my $self = shift or return; - $self->{bootstrapped} or $self->bootstrap(); - $self->{editor_inited} or $self->editor_init(); - return new_editor(@_); -} - -1; -__END__ - -=pod - -=head1 NAME - -OpenILS::Utils::Cronscript - Consolidated options handling for any script (not just cron, really) - -=head1 SYNOPSIS - - use OpenILS::Utils::Cronscript; - - my %defaults = ( - 'min=i' => 0, # keys are Getopt::Long style options - 'max=i' => 999, # values are default values - 'user=s' => 'admin', - 'password=s' => '', - 'nolockfile' => 1, - }; - - my $core = OpenILS::Utils::Cronscript->new(\%defaults); - my $opts = $core->MyGetOptions(); # options now in, e.g.: $opts->{max} - $core->bootstrap; - -Or if you don't need any additional options and just want to get a session going: - - use OpenILS::Utils::Cronscript; - my $session = OpenILS::Utils::Cronscript->new()->session('open-ils.acq'); - -=head1 DESCRIPTION - -There are a few main problems when writing a new script for Evergreen. - -=head2 Initialization - -The runtime -environment for the application requires a lot of initialization, but during normal operation it -has already occured (when Evergreen was started). So most of the EG code never has to deal with -this problem, but standalone scripts do. The timing and sequence of requisite events is important and not obvious. - -=head2 Common Options, Consistent Options - -We need several common options for each script that accesses the database or -uses EG data objects and methods. Logically, these options often deal with initialization. They -should take the B same form(s) for each script and should not be -dependent on the local author to copy and paste them from some reference source. We really don't want to encourage (let alone force) -admins to use C<--config>, C<--osrf-confg>, C<-c>, and C<@ARGV[2]> for the same purpose in different scripts, with different -default handling, help descriptions and error messages (or lack thereof). - -This suggests broader problem of UI consistency and uniformity, also partially addressed by this module. - -=head2 Lockfiles - -A lockfile is necessary for a script that wants to prevent possible simultaneous execution. For example, consider a script -that is scheduled to run frequently, but that experiences occasional high load: you wouldn't want crontab to start running -it again if the first instance had not yet finished. - -But the code for creating, writing to, checking for, reading and cleaning up a lockfile for the script bloats what might otherwise be a terse -method call. Conscript handles lockfile generation and removal automatically. - -=head1 OPTIONS - -The common options (and default values) are: - - 'lock-file=s' => OpenILS::Utils::Lockfile::default_filename, - 'osrf-config=s' => '/openils/conf/opensrf_core.xml', - 'debug' => 0, - 'verbose+' => 0, - 'help' => 0, - -=head1 TODO - -More docs here. - -=head1 SEE ALSO - - Getopt::Long - OpenILS::Utils::Lockfile - oils_header.pl - -=head1 AUTHOR - -Joe Atzberger - -=cut - diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/Editor.pm b/Open-ILS/src/perlmods/OpenILS/Utils/Editor.pm deleted file mode 100644 index 801faff550..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/Editor.pm +++ /dev/null @@ -1,532 +0,0 @@ -use strict; use warnings; -package OpenILS::Utils::Editor; -use OpenILS::Application::AppUtils; -use OpenSRF::AppSession; -use OpenSRF::EX qw(:try); -use OpenILS::Utils::Fieldmapper; -use OpenILS::Event; -use Data::Dumper; -use OpenSRF::Utils::JSON; -use OpenSRF::Utils::Logger qw($logger); -my $U = "OpenILS::Application::AppUtils"; - - -# ----------------------------------------------------------------------------- -# Export some useful functions -# ----------------------------------------------------------------------------- -use vars qw(@EXPORT_OK %EXPORT_TAGS); -use Exporter; -use base qw/Exporter/; -push @EXPORT_OK, 'new_editor'; -%EXPORT_TAGS = ( funcs => [ qw/ new_editor / ] ); - -sub new_editor { return OpenILS::Utils::Editor->new(@_); } - - -# ----------------------------------------------------------------------------- -# These need to be auto-generated -# ----------------------------------------------------------------------------- -my %PERMS = ( - 'biblio.record_entry' => { update => 'UPDATE_MARC' }, - 'asset.copy' => { update => 'UPDATE_COPY' }, - 'asset.call_number' => { update => 'UPDATE_VOLUME' }, - 'action.circulation' => { retrieve => 'VIEW_CIRCULATIONS' }, -); - -use constant E => 'error'; -use constant W => 'warn'; -use constant I => 'info'; -use constant D => 'debug'; -use constant A => 'activity'; - - - -# ----------------------------------------------------------------------------- -# Params include: -# xact=> : creates a storage transaction -# authtoken=>$token : the login session key -# ----------------------------------------------------------------------------- -sub new { - my( $class, %params ) = @_; - $class = ref($class) || $class; - my $self = bless( \%params, $class ); - $self->{checked_perms} = {}; - return $self; -} - -# ----------------------------------------------------------------------------- -# Log the editor metadata along with the log string -# ----------------------------------------------------------------------------- -sub log { - my( $self, $lev, $str ) = @_; - my $s = "editor["; - $s .= "0|" unless $self->{xact}; - $s .= "1|" if $self->{xact}; - $s .= "0" unless $self->requestor; - $s .= $self->requestor->id if $self->requestor; - $s .= "]"; - $logger->$lev("$s $str"); -} - -# ----------------------------------------------------------------------------- -# Verifies the auth token and fetches the requestor object -# ----------------------------------------------------------------------------- -sub checkauth { - my $self = shift; - $self->log(D, "checking auth token ".$self->authtoken); - my ($reqr, $evt) = $U->checkses($self->authtoken); - $self->event($evt) if $evt; - return $self->{requestor} = $reqr; -} - - -# ----------------------------------------------------------------------------- -# Returns the last generated event -# ----------------------------------------------------------------------------- -sub event { - my( $self, $evt ) = @_; - $self->{event} = $evt if $evt; - return $self->{event}; -} - -# ----------------------------------------------------------------------------- -# Clears the last caught event -# ----------------------------------------------------------------------------- -sub clear_event { - my $self = shift; - $self->{event} = undef; -} - -sub authtoken { - my( $self, $auth ) = @_; - $self->{authtoken} = $auth if $auth; - return $self->{authtoken}; -} - -# ----------------------------------------------------------------------------- -# fetches the session, creating if necessary. If 'xact' is true on this -# object, a db session is created -# ----------------------------------------------------------------------------- -sub session { - my( $self, $session ) = @_; - $self->{session} = $session if $session; - - if(!$self->{session}) { - $self->{session} = OpenSRF::AppSession->create('open-ils.storage'); - - if( ! $self->{session} ) { - my $str = "Error creating storage session with OpenSRF::AppSession->create()!"; - $self->log(E, $str); - throw OpenSRF::EX::ERROR ($str); - } - - $self->{session}->connect if $self->{xact} or $self->{connect}; - $self->xact_start if $self->{xact}; - } - return $self->{session}; -} - - -# ----------------------------------------------------------------------------- -# Starts a storage transaction -# ----------------------------------------------------------------------------- -sub xact_start { - my $self = shift; - $self->log(D, "starting new db session"); - my $stat = $self->request('open-ils.storage.transaction.begin'); - $self->log(E, "error starting database transaction") unless $stat; - return $stat; -} - -# ----------------------------------------------------------------------------- -# Commits a storage transaction -# ----------------------------------------------------------------------------- -sub xact_commit { - my $self = shift; - $self->log(D, "comitting db session"); - my $stat = $self->request('open-ils.storage.transaction.commit'); - $self->log(E, "error comitting database transaction") unless $stat; - return $stat; -} - -# ----------------------------------------------------------------------------- -# Rolls back a storage stransaction -# ----------------------------------------------------------------------------- -sub xact_rollback { - my $self = shift; - $self->log(I, "rolling back db session"); - return $self->request("open-ils.storage.transaction.rollback"); -} - - -# ----------------------------------------------------------------------------- -# commits the db session and destroys the session -# ----------------------------------------------------------------------------- -sub commit { - my $self = shift; - return unless $self->{xact}; - $self->xact_commit; - $self->session->disconnect; - $self->{session} = undef; -} - -# ----------------------------------------------------------------------------- -# clears all object data. Does not commit the db transaction. -# ----------------------------------------------------------------------------- -sub reset { - my $self = shift; - $self->session->disconnect if $self->{session}; - $$self{$_} = undef for (keys %$self); -} - - -# ----------------------------------------------------------------------------- -# commits and resets -# ----------------------------------------------------------------------------- -sub finish { - my $self = shift; - $self->commit; - $self->reset; -} - - - -# ----------------------------------------------------------------------------- -# Does a simple storage request -# ----------------------------------------------------------------------------- -sub request { - my( $self, $method, @params ) = @_; - - my $val; - my $err; - my $argstr = __arg_to_string( (scalar(@params)) == 1 ? $params[0] : \@params); - - $self->log(I, "request $method : $argstr"); - - try { - $val = $self->session->request($method, @params)->gather(1); - - } catch Error with { - $err = shift; - $self->log(E, "request error $method : $argstr : $err"); - }; - - throw $err if $err; - return $val; -} - - -# ----------------------------------------------------------------------------- -# Sets / Returns the requstor object. This is set when checkauth succeeds. -# ----------------------------------------------------------------------------- -sub requestor { - my($self, $requestor) = @_; - $self->{requestor} = $requestor if $requestor; - return $self->{requestor}; -} - - - -# ----------------------------------------------------------------------------- -# Holds the last data received from a storage call -# ----------------------------------------------------------------------------- -sub data { - my( $self, $data ) = @_; - $self->{data} = $data if defined $data; - return $self->{data}; -} - - -# ----------------------------------------------------------------------------- -# True if this perm has already been checked at this org -# ----------------------------------------------------------------------------- -sub perm_checked { - my( $self, $perm, $org ) = @_; - $self->{checked_perms}->{$org} = {} - unless $self->{checked_perms}->{$org}; - my $checked = $self->{checked_perms}->{$org}->{$perm}; - if(!$checked) { - $self->{checked_perms}->{$org}->{$perm} = 1; - return 0; - } - return 1; -} - - - -# ----------------------------------------------------------------------------- -# Returns true if the requested perm is allowed. If the perm check fails, -# $e->event is set and undef is returned -# The perm user is $e->requestor->id and perm org defaults to the requestor's -# ws_ou -# If this perm at the given org has already been verified, true is returned -# and the perm is not re-checked -# ----------------------------------------------------------------------------- -sub allowed { - my( $self, $perm, $org ) = @_; - my $uid = $self->requestor->id; - $org ||= $self->requestor->ws_ou; - $self->log(I, "checking perms user=$uid, org=$org, perm=$perm"); - return 1 if $self->perm_checked($perm, $org); - return $self->checkperm($uid, $org, $perm); -} - -sub checkperm { - my($self, $userid, $org, $perm) = @_; - my $s = $self->request( - "open-ils.storage.permission.user_has_perm", $userid, $perm, $org ); - - if(!$s) { - my $e = OpenILS::Event->new('PERM_FAILURE', ilsperm => $perm, ilspermloc => $org); - $self->event($e); - return undef; - } - - return 1; -} - - - -# ----------------------------------------------------------------------------- -# checks the appropriate perm for the operation -# ----------------------------------------------------------------------------- -sub _checkperm { - my( $self, $ptype, $action, $org ) = @_; - $org ||= $self->requestor->ws_ou; - my $perm = $PERMS{$ptype}{$action}; - if( $perm ) { - return undef if $self->perm_checked($perm, $org); - return $self->event unless $self->allowed($perm, $org); - } else { - $self->log(E, "no perm provided for $ptype.$action"); - } - return undef; -} - - - -# ----------------------------------------------------------------------------- -# Logs update actions to the activity log -# ----------------------------------------------------------------------------- -sub log_activity { - my( $self, $type, $action, $arg ) = @_; - my $str = "$type.$action"; - $str .= _prop_string($arg); - $self->log(A, $str); -} - - - -sub _prop_string { - my $obj = shift; - my @props = $obj->properties; - my $str = ""; - for(@props) { - my $prop = $obj->$_() || ""; - $prop = substr($prop, 0, 128) . "..." if length $prop > 131; - $str .= " $_=$prop"; - } - return $str; -} - - -sub __arg_to_string { - my $arg = shift; - return "" unless defined $arg; - return $arg->id if UNIVERSAL::isa($arg, "Fieldmapper"); - return OpenSRF::Utils::JSON->perl2JSON($arg); -} - - -# ----------------------------------------------------------------------------- -# This does the actual storage query. -# -# 'search' calls become search_where calls and $arg can be a search hash or -# an array-ref of storage search options. -# -# 'retrieve' expects an id -# 'update' expects an object -# 'create' expects an object -# 'delete' expects an object -# -# All methods return true on success and undef on failure. On failure, -# $e->event is set to the generated event. -# Note: this method assumes that updating a non-changed object and -# thereby receiving a 0 from storage, is a successful update. -# -# The method will therefore return true so the caller can just do -# $e->update_blah($x) or return $e->event; -# The true value returned from storage for all methods will be stored in -# $e->data, until the next method is called. -# -# not-found events are generated on retrieve and serach methods. -# action=search methods will return [] (==true) if no data is found. If the -# caller is interested in the not found event, they can do: -# return $e->event unless @$results; -# ----------------------------------------------------------------------------- -sub runmethod { - my( $self, $action, $type, $arg, $options ) = @_; - - my @arg = ($arg); - my $method = "open-ils.storage.direct.$type.$action"; - - if( $action eq 'search' ) { - $method =~ s/search/search_where/o; - $method =~ s/direct/id_list/o if $options->{idlist}; - $method = "$method.atomic"; - @arg = @$arg if ref($arg) eq 'ARRAY'; - - } elsif( $action eq 'batch_retrieve' ) { - $method =~ s/batch_retrieve/batch.retrieve/o; - $method = "$method.atomic"; - @arg = @$arg if ref($arg) eq 'ARRAY'; - - } elsif( $action eq 'retrieve_all' ) { - $method =~ s/retrieve_all/retrieve.all.atomic/o; - } - - # remove any stale events - $self->clear_event; - - if( $action eq 'update' or $action eq 'delete' or $action eq 'create' ) { - $self->log_activity($type, $action, $arg); - } - - if($$options{checkperm}) { - my $a = ($action eq 'search' or - $action eq 'batch_retrieve' or $action eq 'retrieve_all') ? 'retrieve' : $action; - my $e = $self->_checkperm($type, $a, $$options{permorg}); - if($e) { - $self->event($e); - return undef; - } - } - - my $obj; - my $err; - - try { - $obj = $self->request($method, @arg); - } catch Error with { $err = shift; }; - - - if(!defined $obj) { - $self->log(I, "request returned no data"); - - if( $action eq 'retrieve' ) { - $self->event(_mk_not_found($type, $arg)); - - } elsif( $action eq 'update' or - $action eq 'delete' or $action eq 'create' ) { - my $evt = OpenILS::Event->new( - 'DATABASE_UPDATE_FAILED', payload => $arg, debug => "$err" ); - $self->event($evt); - } - - if( $err ) { - $self->event( - OpenILS::Event->new( 'DATABASE_QUERY_FAILED', - payload => $arg, debug => "$err" )); - return undef; - } - - return undef; - } - - if( $action eq 'create' and $obj == 0 ) { - my $evt = OpenILS::Event->new( - 'DATABASE_UPDATE_FAILED', payload => $arg, debug => "$err" ); - $self->event($evt); - return undef; - } - - # If we havn't dealt with the error in a nice way, go ahead and throw it - if( $err ) { - $self->event( - OpenILS::Event->new( 'DATABASE_QUERY_FAILED', - payload => $arg, debug => "$err" )); - return undef; - } - - if( $action eq 'search' or $action eq 'batch_retrieve' or $action eq 'retrieve_all') { - $self->log(I, "$type.$action : returned ".scalar(@$obj). " result(s)"); - $self->event(_mk_not_found($type, $arg)) unless @$obj; - } - - $arg->id($obj) if $action eq 'create'; # grabs the id on create - $self->data($obj); # cache the data for convenience - - return ($obj) ? $obj : 1; -} - - -sub _mk_not_found { - my( $type, $arg ) = @_; - (my $t = $type) =~ s/\./_/og; - $t = uc($t); - return OpenILS::Event->new("${t}_NOT_FOUND", payload => $arg); -} - - - -# utility method for loading -sub __fm2meth { - my $str = shift; - my $sep = shift; - $str =~ s/Fieldmapper:://o; - $str =~ s/::/$sep/g; - return $str; -} - - -# ------------------------------------------------------------- -# Load up the methods from the FM classes -# ------------------------------------------------------------- -my $map = $Fieldmapper::fieldmap; -for my $object (keys %$map) { - my $obj = __fm2meth($object,'_'); - my $type = __fm2meth($object, '.'); - - my $update = "update_$obj"; - my $updatef = - "sub $update {return shift()->runmethod('update', '$type', \@_);}"; - eval $updatef; - - my $retrieve = "retrieve_$obj"; - my $retrievef = - "sub $retrieve {return shift()->runmethod('retrieve', '$type', \@_);}"; - eval $retrievef; - - my $search = "search_$obj"; - my $searchf = - "sub $search {return shift()->runmethod('search', '$type', \@_);}"; - eval $searchf; - - my $create = "create_$obj"; - my $createf = - "sub $create {return shift()->runmethod('create', '$type', \@_);}"; - eval $createf; - - my $delete = "delete_$obj"; - my $deletef = - "sub $delete {return shift()->runmethod('delete', '$type', \@_);}"; - eval $deletef; - - my $bretrieve = "batch_retrieve_$obj"; - my $bretrievef = - "sub $bretrieve {return shift()->runmethod('batch_retrieve', '$type', \@_);}"; - eval $bretrievef; - - my $retrieveall = "retrieve_all_$obj"; - my $retrieveallf = - "sub $retrieveall {return shift()->runmethod('retrieve_all', '$type', \@_);}"; - eval $retrieveallf; - - -} - - - -1; - - diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/Fieldmapper.pm b/Open-ILS/src/perlmods/OpenILS/Utils/Fieldmapper.pm deleted file mode 100644 index b8e5693ecd..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/Fieldmapper.pm +++ /dev/null @@ -1,407 +0,0 @@ -package Fieldmapper; -use OpenSRF::Utils::JSON; -use Data::Dumper; -use base 'OpenSRF::Application'; -use OpenSRF::Utils::Logger; -use OpenSRF::Utils::SettingsClient; -use OpenSRF::System; -use XML::LibXML; - -my $log = 'OpenSRF::Utils::Logger'; - -use vars qw/$fieldmap $VERSION/; - -sub publish_fieldmapper { - my ($self,$client,$class) = @_; - - return $fieldmap unless (defined $class); - return undef unless (exists($$fieldmap{$class})); - return {$class => $$fieldmap{$class}}; -} -__PACKAGE__->register_method( - api_name => 'opensrf.open-ils.system.fieldmapper', - api_level => 1, - method => 'publish_fieldmapper', -); - -# -# To dump the Javascript version of the fieldmapper struct use the command: -# -# PERL5LIB=~/cvs/ILS/OpenSRF/src/perlmods/:~/cvs/ILS/Open-ILS/src/perlmods/ GEN_JS=1 perl -MOpenILS::Utils::Fieldmapper -e 'print "\n";' -# -# ... adjusted for your CVS sandbox, of course. -# - -sub classes { - return () unless (defined $fieldmap); - return keys %$fieldmap; -} - -sub get_attribute { - my $attr_list = shift; - my $attr_name = shift; - - my $attr = $attr_list->getNamedItem( $attr_name ); - if( defined( $attr ) ) { - return $attr->getValue(); - } - return undef; -} - -sub load_fields { - my $field_list = shift; - my $fm = shift; - - # Get attributes of the field list. Since there is only one - # per class, these attributes logically belong to the - # enclosing class, and that's where we load them. - - my $field_attr_list = $field_list->attributes(); - - my $sequence = get_attribute( $field_attr_list, 'oils_persist:sequence' ); - if( ! defined( $sequence ) ) { - $sequence = ''; - } - my $primary = get_attribute( $field_attr_list, 'oils_persist:primary' ); - - # Load attributes into the Fieldmapper ---------------------- - - $$fieldmap{$fm}{ sequence } = $sequence; - $$fieldmap{$fm}{ identity } = $primary; - - # Load each field ------------------------------------------- - - my $array_position = 0; - for my $field ( $field_list->childNodes() ) { # For each - if( $field->nodeName eq 'field' ) { - - my $attribute_list = $field->attributes(); - - my $name = get_attribute( $attribute_list, 'name' ); - next if( $name eq 'isnew' || $name eq 'ischanged' || $name eq 'isdeleted' ); - my $required = get_attribute( $attribute_list, 'oils_obj:required' ); - my $validate = get_attribute( $attribute_list, 'oils_obj:validate' ); - my $virtual = get_attribute( $attribute_list, 'oils_persist:virtual' ); - if( ! defined( $virtual ) ) { - $virtual = "false"; - } - my $selector = get_attribute( $attribute_list, 'reporter:selector' ); - - $$fieldmap{$fm}{fields}{ $name } = - { virtual => ( $virtual eq 'true' ) ? 1 : 0, - required => ( $required eq 'true' ) ? 1 : 0, - position => $array_position, - }; - - $$fieldmap{$fm}{fields}{ $name }{validate} = qr/$validate/ if (defined($validate)); - - # The selector attribute, if present at all, attaches to only one - # of the fields in a given class. So if we see it, we store it at - # the level of the enclosing class. - - if( defined( $selector ) ) { - $$fieldmap{$fm}{selector} = $selector; - } - - ++$array_position; - } - } - - # Load the standard 3 virtual fields ------------------------ - - for my $vfield ( qw/isnew ischanged isdeleted/ ) { - $$fieldmap{$fm}{fields}{ $vfield } = - { position => $array_position, - virtual => 1 - }; - ++$array_position; - } -} - -sub load_links { - my $link_list = shift; - my $fm = shift; - - for my $link ( $link_list->childNodes() ) { # For each - if( $link->nodeName eq 'link' ) { - my $attribute_list = $link->attributes(); - - my $field = get_attribute( $attribute_list, 'field' ); - my $reltype = get_attribute( $attribute_list, 'reltype' ); - my $key = get_attribute( $attribute_list, 'key' ); - my $class = get_attribute( $attribute_list, 'class' ); - - $$fieldmap{$fm}{links}{ $field } = - { class => $class, - reltype => $reltype, - key => $key, - }; - } - } -} - -sub load_class { - my $class_node = shift; - - # Get attributes --------------------------------------------- - - my $attribute_list = $class_node->attributes(); - - my $fm = get_attribute( $attribute_list, 'oils_obj:fieldmapper' ); - $fm = 'Fieldmapper::' . $fm; - my $id = get_attribute( $attribute_list, 'id' ); - my $controller = get_attribute( $attribute_list, 'controller' ); - my $virtual = get_attribute( $attribute_list, 'virtual' ); - if( ! defined( $virtual ) ) { - $virtual = 'false'; - } - my $tablename = get_attribute( $attribute_list, 'oils_persist:tablename' ); - if( ! defined( $tablename ) ) { - $tablename = ''; - } - my $restrict_primary = get_attribute( $attribute_list, 'oils_persist:restrict_primary' ); - - # Load the attributes into the Fieldmapper -------------------- - - $log->debug("Building Fieldmapper class for [$fm] from IDL"); - - $$fieldmap{$fm}{ hint } = $id; - $$fieldmap{$fm}{ virtual } = ( $virtual eq 'true' ) ? 1 : 0; - $$fieldmap{$fm}{ table } = $tablename; - $$fieldmap{$fm}{ controller } = [ split ' ', $controller ]; - $$fieldmap{$fm}{ restrict_primary } = $restrict_primary; - - # Load fields and links - - for my $child ( $class_node->childNodes() ) { - my $nodeName = $child->nodeName; - if( $nodeName eq 'fields' ) { - load_fields( $child, $fm ); - } elsif( $nodeName eq 'links' ) { - load_links( $child, $fm ); - } - } -} - -import(); -sub import { - my $class = shift; - my %args = @_; - - return if (keys %$fieldmap); - return if (!OpenSRF::System->connected && !$args{IDL}); - - # parse the IDL ... - my $parser = XML::LibXML->new(); - my $file = $args{IDL} || OpenSRF::Utils::SettingsClient->new->config_value( 'IDL' ); - my $fmdoc = $parser->parse_file( $file ); - my $rootnode = $fmdoc->documentElement(); - - for my $child ( $rootnode->childNodes() ) { # For each - my $nodeName = $child->nodeName; - if( $nodeName eq 'class' ) { - load_class( $child ); - } - } - - #------------------------------------------------------------------------------- - # Now comes the evil! Generate classes - - for my $pkg ( __PACKAGE__->classes ) { - (my $cdbi = $pkg) =~ s/^Fieldmapper:://o; - - eval <<" PERL"; - package $pkg; - use base 'Fieldmapper'; - PERL - - if (exists $$fieldmap{$pkg}{proto_fields}) { - for my $pfield ( sort keys %{ $$fieldmap{$pkg}{proto_fields} } ) { - $$fieldmap{$pkg}{fields}{$pfield} = { position => $pos, virtual => $$fieldmap{$pkg}{proto_fields}{$pfield} }; - $pos++; - } - } - - OpenSRF::Utils::JSON->register_class_hint( - hint => $pkg->json_hint, - name => $pkg, - type => 'array', - ); - - } -} - -sub new { - my $self = shift; - my $value = shift; - $value = [] unless (defined $value); - return bless $value => $self->class_name; -} - -sub decast { - my $self = shift; - return [ @$self ]; -} - -sub DESTROY {} - -sub AUTOLOAD { - my $obj = shift; - my $value = shift; - (my $field = $AUTOLOAD) =~ s/^.*://o; - my $class_name = $obj->class_name; - - my $fpos = $field; - $fpos =~ s/^clear_//og ; - - my $pos = $$fieldmap{$class_name}{fields}{$fpos}{position}; - - if ($field =~ /^clear_/o) { - { no strict 'subs'; - *{$obj->class_name."::$field"} = sub { - my $self = shift; - $self->[$pos] = undef; - return 1; - }; - } - return $obj->$field(); - } - - die "No field by the name $field in $class_name!" - unless (exists $$fieldmap{$class_name}{fields}{$field} && defined($pos)); - - - { no strict 'subs'; - *{$obj->class_name."::$field"} = sub { - my $self = shift; - my $new_val = shift; - $self->[$pos] = $new_val if (defined $new_val); - return $self->[$pos]; - }; - } - return $obj->$field($value); -} - -sub Selector { - my $self = shift; - return $$fieldmap{$self->class_name}{selector}; -} - -sub Identity { - my $self = shift; - return $$fieldmap{$self->class_name}{identity}; -} - -sub RestrictPrimary { - my $self = shift; - return $$fieldmap{$self->class_name}{restrict_primary}; -} - -sub Sequence { - my $self = shift; - return $$fieldmap{$self->class_name}{sequence}; -} - -sub Table { - my $self = shift; - return $$fieldmap{$self->class_name}{table}; -} - -sub Controller { - my $self = shift; - return $$fieldmap{$self->class_name}{controller}; -} - -sub RequiredField { - my $self = shift; - my $f = shift; - return undef unless ($f); - return $$fieldmap{$self->class_name}{fields}{$f}{required}; -} - -sub ValidateField { - my $self = shift; - my $f = shift; - return undef unless ($f); - return 1 if (!exists($$fieldmap{$self->class_name}{fields}{$f}{validate})); - return $self->$f =~ $$fieldmap{$self->class_name}{fields}{$f}{validate}; -} - -sub class_name { - my $class_name = shift; - return ref($class_name) || $class_name; -} - -sub real_fields { - my $self = shift; - my $class_name = $self->class_name; - my $fields = $$fieldmap{$class_name}{fields}; - - my @f = grep { - !$$fields{$_}{virtual} - } sort {$$fields{$a}{position} <=> $$fields{$b}{position}} keys %$fields; - - return @f; -} - -sub has_field { - my $self = shift; - my $field = shift; - my $class_name = $self->class_name; - return 1 if grep { $_ eq $field } keys %{$$fieldmap{$class_name}{fields}}; - return 0; -} - -sub properties { - my $self = shift; - my $class_name = $self->class_name; - return keys %{$$fieldmap{$class_name}{fields}}; -} - -sub to_bare_hash { - my $self = shift; - - my %hash = (); - for my $f ($self->properties) { - my $val = $self->$f; - $hash{$f} = $val; - } - - return \%hash; -} - -sub clone { - my $self = shift; - return $self->new( [@$self] ); -} - -sub api_level { - my $self = shift; - return $fieldmap->{$self->class_name}->{api_level}; -} - -sub cdbi { - my $self = shift; - return $fieldmap->{$self->class_name}->{cdbi}; -} - -sub is_virtual { - my $self = shift; - my $field = shift; - return $fieldmap->{$self->class_name}->{proto_fields}->{$field} if ($field); - return $fieldmap->{$self->class_name}->{virtual}; -} - -sub is_readonly { - my $self = shift; - my $field = shift; - return $fieldmap->{$self->class_name}->{readonly}; -} - -sub json_hint { - my $self = shift; - return $fieldmap->{$self->class_name}->{hint}; -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/ISBN.pm b/Open-ILS/src/perlmods/OpenILS/Utils/ISBN.pm deleted file mode 100644 index 34eed663a8..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/ISBN.pm +++ /dev/null @@ -1,96 +0,0 @@ -package OpenILS::Utils::ISBN; - -# --------------------------------------------------------------- -# Copyright (C) 2010 Equinox Software, Inc -# Author: Joe Atzberger -# -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# --------------------------------------------------------------- - -use strict; -use warnings; - -use Business::ISBN; - -use base qw/Exporter/; -our $VERSION = '0.01'; -our @EXPORT_OK = qw/isbn_upconvert/; - -# Jason Stephenson at Merrimack Valley Library Consortium -# Dan Scott at Laurentian University - -sub isbn_upconvert { - my $in = @_ ? shift : return; - my $pretty = @_ ? shift : 0; - $in =~ s/\s*//g; - $in =~ s/-//g; - length($in) or return; - my $isbn = Business::ISBN->new($in) or return; - $isbn->fix_checksum() if $isbn->is_valid_checksum() == Business::ISBN::BAD_CHECKSUM; - $isbn->is_valid() or return; - return $pretty ? $isbn->as_isbn13->as_string : $isbn->as_isbn13->isbn; -} - -1; -__END__ - -For example, if you have a file isbns.txt with these lines: - -1598884093 - 1598884093 - 15 988 840 93 -0446357197 - 0 446 3 5 7 1 9 7 - 0 446 3 5 7 1 9 1 -0596526857 -0786222735 -0446360015 -0446350109 -0446314129 -0439139597 -0743294394 -159143047X -1590203097 -075480965X -0393048799 -0446831832 -0446310069 -1598883275 -0446313033 -0446360279 - -And you run: - perl -pe 'use OpenILS::Utils::ISBN qw/isbn_upconvert/; $_ = isbn_upconvert($_) . "\n";' -# -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# --------------------------------------------------------------- - -# The purpose of this module is to consolidate -# non-duplicative processing, i.e. lockfiles and lockfile checking - -use strict; -use warnings; -use Carp; - -use File::Basename qw/fileparse/; - -sub _tempdir { - return $ENV{TEMP} || $ENV{TMP} || '/tmp'; -} - -our $debug = 0; - -sub default_filename { - my $tempdir = _tempdir; - my $filename = fileparse($0, '.pl'); - return "$tempdir/$filename-LOCK"; -} - -sub new { - my $class = shift; - my $lockfile = @_ ? shift : default_filename; - - croak "Script already running with lockfile $lockfile" if -e $lockfile; - $debug and print "Writing lockfile $lockfile (PID: $$)\n"; - - open (F, ">$lockfile") or croak "Cannot write to lockfile '$lockfile': $!"; - print F $$; - close F; - - my $self = { - filename => $lockfile, - contents => $$, - }; - return bless ($self, $class); -} - -sub filename { - my $self = shift; - return $self->{filename}; -} -sub contents { - my $self = shift; - return $self->{contents}; -} - -DESTROY { - my $self = shift; - # lockfile cleanup - if (-e $self->{filename}) { - open LF, $self->{filename}; - my $contents = ; - close LF; - $debug and print "deleting lockfile $self->{filename}\n"; - if ($contents == $self->{contents}) { - unlink $self->{filename} or carp "Failed to remove lockfile '$self->{filename}'"; - } else { - carp "Lockfile contents '$contents' no longer match '$self->{contents}'. Cannot remove $self->{filename}"; - } - - } -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD.pm b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD.pm deleted file mode 100644 index 48f00cb1a7..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD.pm +++ /dev/null @@ -1,610 +0,0 @@ -package MFHD; -use strict; -use warnings; -use integer; -use Carp; -use DateTime::Format::Strptime; -use Data::Dumper; - -# for inherited methods to work properly, we need to force a -# MARC::Record version greater than 2.0.0 -use MARC::Record "2.0.1"; -use base 'MARC::Record'; - -use OpenILS::Utils::MFHD::Caption; -use OpenILS::Utils::MFHD::Holding; - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = shift; - - $self->{_strp_date} = new DateTime::Format::Strptime(pattern => '%F'); - - $self->{_mfhd_CAPTIONS} = {}; - $self->{_mfhd_COMPRESSIBLE} = (substr($self->leader, 17, 1) =~ /[45]/); - - foreach my $field ('853', '854', '855') { - my $captions = {}; - foreach my $caption ($self->field($field)) { - my $cap_id; - - $cap_id = $caption->subfield('8') || '0'; - - if (exists $captions->{$cap_id}) { - carp "Multiple MFHD captions with label '$cap_id'"; - } - - $captions->{$cap_id} = new MFHD::Caption($caption); - if ($self->{_mfhd_COMPRESSIBLE}) { - $self->{_mfhd_COMPRESSIBLE} &&= - $captions->{$cap_id}->compressible; - } - } - $self->{_mfhd_CAPTIONS}->{$field} = $captions; - } - - foreach my $field ('863', '864', '865') { - my $holdings = {}; - my $cap_field; - - ($cap_field = $field) =~ s/6/5/; - - foreach my $hfield ($self->field($field)) { - my ($linkage, $link_id, $seqno); - my $holding; - - $linkage = $hfield->subfield('8'); - ($link_id, $seqno) = split(/\./, $linkage); - - if (!exists $holdings->{$link_id}) { - $holdings->{$link_id} = {}; - } - $holding = - new MFHD::Holding($seqno, $hfield, - $self->{_mfhd_CAPTIONS}->{$cap_field}->{$link_id}); - $holdings->{$link_id}->{$seqno} = $holding; - - if ($self->{_mfhd_COMPRESSIBLE}) { - $self->{_mfhd_COMPRESSIBLE} &&= $holding->validate; - } - } - $self->{_mfhd_HOLDINGS}->{$field} = $holdings; - } - - bless($self, $class); - return $self; -} - -sub compressible { - my $self = shift; - - return $self->{_mfhd_COMPRESSIBLE}; -} - -sub caption_link_ids { - my $self = shift; - my $field = shift; - - return sort keys %{$self->{_mfhd_CAPTIONS}->{$field}}; -} - -# optional argument to get back a 'hashref' or an 'array' (default) -sub captions { - my $self = shift; - my $tag = shift; - my $return_type = shift; - - # TODO: add support for caption types as argument? (base, index, supplement) - my @sorted_ids = $self->caption_link_ids($tag); - - if (defined($return_type) and $return_type eq 'hashref') { - my %captions; - foreach my $link_id (@sorted_ids) { - $captions{$link_id} = $self->{_mfhd_CAPTIONS}{$tag}{$link_id}; - } - return \%captions; - } else { - my @captions; - foreach my $link_id (@sorted_ids) { - push(@captions, $self->{_mfhd_CAPTIONS}{$tag}{$link_id}); - } - return @captions; - } -} - -sub append_fields { - my $self = shift; - - my $field_count = $self->SUPER::append_fields(@_); - if ($field_count) { - foreach my $field (@_) { - $self->_avoid_link_collision($field); - my $field_type = ref $field; - if ($field_type eq 'MFHD::Holding') { - $self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno} = $field; - } elsif ($field_type eq 'MFHD::Caption') { - $self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id} = $field; - } - } - return $field_count; - } else { - return; - } -} - -sub delete_field { - my $self = shift; - my $field = shift; - - my $field_count = $self->SUPER::delete_field($field); - if ($field_count) { - my $field_type = ref($field); - if ($field_type eq 'MFHD::Holding') { - delete($self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno}); - } elsif ($field_type eq 'MFHD::Caption') { - delete($self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id}); - } - return $field_count; - } else { - return; - } -} - -sub insert_fields_before { - my $self = shift; - my $before = shift; - - my $field_count = $self->SUPER::insert_fields_before($before, @_); - if ($field_count) { - foreach my $field (@_) { - $self->_avoid_link_collision($field); - my $field_type = ref $field; - if ($field_type eq 'MFHD::Holding') { - $self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno} = $field; - } elsif ($field_type eq 'MFHD::Caption') { - $self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id} = $field; - } - } - return $field_count; - } else { - return; - } -} - -sub insert_fields_after { - my $self = shift; - my $after = shift; - - my $field_count = $self->SUPER::insert_fields_after($after, @_); - if ($field_count) { - foreach my $field (@_) { - $self->_avoid_link_collision($field); - my $field_type = ref $field; - if ($field_type eq 'MFHD::Holding') { - $self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno} = $field; - } elsif ($field_type eq 'MFHD::Caption') { - $self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id} = $field; - } - } - return $field_count; - } else { - return; - } -} - -sub _avoid_link_collision { - my $self = shift; - my $field = shift; - - my $fieldref = ref($field); - if ($fieldref eq 'MFHD::Holding') { - my $seqno = $field->seqno; - my $changed_seqno = 0; - if (exists($self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$seqno})) { - $changed_seqno = 1; - do { - $seqno++; - } while (exists($self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$seqno})); - } - $field->seqno($seqno) if $changed_seqno; - } elsif ($fieldref eq 'MFHD::Caption') { - my $link_id = $field->link_id; - my $changed_link_id = 0; - if (exists($self->{_mfhd_CAPTIONS}{$field->tag}{$link_id})) { - $link_id++; - $changed_link_id = 1; - do { - $link_id++; - } while (exists($self->{_mfhd_CAPTIONS}{$field->tag}{$link_id})); - } - $field->link_id($link_id) if $changed_link_id; - } -} - -sub active_captions { - my $self = shift; - my $tag = shift; - - # TODO: add support for caption types as argument? (basic, index, supplement) - my @captions; - my @active_captions; - - @captions = $self->captions($tag); - - # TODO: for now, we will assume the last 85X field is active - # and the rest are historical. The standard is hazy about - # how multiple active patterns of the same 85X type should be - # handled. We will, however, return as an array for future - # use. - push(@active_captions, $captions[-1]); - - return @active_captions; -} - -sub holdings { - my $self = shift; - my $field = shift; - my $capid = shift; - - return - sort { $a->seqno <=> $b->seqno } - values %{$self->{_mfhd_HOLDINGS}->{$field}->{$capid}}; -} - -sub _holding_date { - my $self = shift; - my $holding = shift; - - return $self->{_strp_date}->parse_datetime($holding->chron_to_date); -} - -# -# generate_predictions() -# Accepts a hash ref of options initially defined as: -# base_holding : reference to the holding field to predict from -# num_to_predict : the number of issues you wish to predict -# OR -# end_holding : holding field ref, keep predicting until you meet or exceed it -# OR -# end_date : keep predicting until you exceed this -# -# The basic method is to first convert to a single holding if compressed, then -# increment the holding and save the resulting values to @predictions. -# -# returns @predictions, an array of holding field refs (including end_holding -# if applicable but NOT base_holding) -# -sub generate_predictions { - my ($self, $options) = @_; - - my $base_holding = $options->{base_holding}; - my $num_to_predict = $options->{num_to_predict}; - my $end_holding = $options->{end_holding}; - my $end_date = $options->{end_date}; - my $max_to_predict = $options->{max_to_predict} || 10000; # fail-safe - - if (!defined($base_holding)) { - carp("Base holding not defined in generate_predictions, returning empty set"); - return (); - } - if ($base_holding->is_compressed) { - carp("Ambiguous compressed base holding in generate_predictions, returning empty set"); - return (); - } - my $curr_holding = $base_holding->clone; # prevent side-effects - - my @predictions; - - if ($num_to_predict) { - for (my $i = 0; $i < $num_to_predict; $i++) { - push(@predictions, $curr_holding->increment->clone); - } - } elsif (defined($end_holding)) { - $end_holding = $end_holding->clone; # prevent side-effects - my $next_holding = $curr_holding->increment->clone; - my $num_predicted = 0; - while ($next_holding le $end_holding) { - push(@predictions, $next_holding); - $num_predicted++; - if ($num_predicted >= $max_to_predict) { - carp("Maximum prediction count exceeded"); - last; - } - $next_holding = $curr_holding->increment->clone; - } - } elsif (defined($end_date)) { - my $next_holding = $curr_holding->increment->clone; - my $num_predicted = 0; - while ($self->_holding_date($next_holding) <= $end_date) { - push(@predictions, $next_holding); - $num_predicted++; - if ($num_predicted >= $max_to_predict) { - carp("Maximum prediction count exceeded"); - last; - } - $next_holding = $curr_holding->increment->clone; - } - } - - return @predictions; -} - -# -# create an array of compressed holdings from all holdings for a given caption, -# compressing as needed -# -# Optionally you can skip sorting, but the resulting compression will be compromised -# if the current holdings are out of order -# -# TODO: gap marking, gap preservation -# -# TODO: some of this could be moved to the Caption object to allow for -# decompression in the absense of an overarching MFHD object -# -sub get_compressed_holdings { - my $self = shift; - my $caption = shift; - my $opts = shift; - my $skip_sort = $opts->{'skip_sort'}; - - # make sure none are compressed - my @decomp_holdings; - if ($skip_sort) { - @decomp_holdings = $self->get_decompressed_holdings($caption, {'skip_sort' => 1}); - } else { - # sort for best algorithm - @decomp_holdings = $self->get_decompressed_holdings($caption, {'dedupe' => 1}); - } - - my $runner = $decomp_holdings[0]->clone->increment; - my $curr_holding = shift(@decomp_holdings); - $curr_holding = $curr_holding->clone; - my $seqno = 1; - $curr_holding->seqno($seqno); - my @comp_holdings; -# my $last_holding; - foreach my $holding (@decomp_holdings) { - if ($runner eq $holding) { - $curr_holding->extend; - $runner->increment; -# } elsif ($holding eq $last_holding) { -# carp("Found duplicate holding in compression set, skipping"); - } elsif ($runner gt $holding) { # should not happen unless holding is not in series - carp("Found unexpected holding, skipping"); - } else { - push(@comp_holdings, $curr_holding); - while ($runner le $holding) { - $runner->increment; - } - $curr_holding = $holding->clone; - $seqno++; - $curr_holding->seqno($seqno); - } -# $last_holding = $holding; - } - push(@comp_holdings, $curr_holding); - - return @comp_holdings; -} - -# -# create an array of single holdings from all holdings for a given caption, -# decompressing as needed -# -# resulting array is returned as they come in the record, unsorted -# -# optional argument will reorder and renumber the holdings before returning -# -# TODO: some of this could be moved to the Caption (and/or Holding) object to -# allow for decompression in the absense of an overarching MFHD object -# -sub get_decompressed_holdings { - my $self = shift; - my $caption = shift; - my $opts = shift; - my $skip_sort = $opts->{'skip_sort'}; - my $dedupe = $opts->{'dedupe'}; - - if ($dedupe and $skip_sort) { - carp("Attempted deduplication without sorting, failure likely"); - } - - my $htag = $caption->tag; - my $link_id = $caption->link_id; - $htag =~ s/^85/86/; - my @holdings = $self->holdings($htag, $link_id); - my @decomp_holdings; - - foreach my $holding (@holdings) { - if (!$holding->is_compressed) { - push(@decomp_holdings, $holding->clone); - } else { - my $base_holding = $holding->clone->compressed_to_first; - my @new_holdings = $self->generate_predictions( - {'base_holding' => $base_holding, - 'end_holding' => $holding->clone->compressed_to_last}); - push(@decomp_holdings, $base_holding, @new_holdings); - } - } - - unless ($skip_sort) { - my @temp_holdings = sort {$a cmp $b} @decomp_holdings; - @decomp_holdings = @temp_holdings; - } - - my @return_holdings = (shift(@decomp_holdings)); - $return_holdings[0]->seqno(1); - my $seqno = 2; - foreach my $holding (@decomp_holdings) { # renumber sequence - if ($holding eq $return_holdings[-1] and $dedupe) { - carp("Found duplicate holding in decompression set, discarding"); - next; - } - $holding->seqno($seqno); - $seqno++; - push(@return_holdings, $holding); - } - - return @return_holdings; -} - -# -# format_holdings(): Generate textual display of all holdings in record -# for given type of caption (853--855) taking into account all the -# captions, holdings statements, and textual -# holdings. -# -# returns string formatted holdings as one very long line. -# Caller must provide any label (such as "library has:" and insert -# line breaks as appropriate. - -# Translate caption field labels to the corresponding textual holdings -# statement labels. That is, convert 853 "Basic bib unit" caption to -# 866 "basic bib unit" text holdings label. - -my %cap_to_txt = ( - '853' => '866', - '854' => '867', - '855' => '868', - ); - -sub format_holdings { - my $self = shift; - my $field = shift; - my $holdings_field; - my @txt_holdings; - my %txt_link_ids; - my $holdings_stmt = ''; - my ($l, $start); - - # convert caption field id to holdings field id - ($holdings_field = $field) =~ s/5/6/; - - # Textual holdings statements complicate the basic algorithm for - # formatting the holdings: If there's a textual holdings statement - # with the subfield "$80", then that overrides ALL the MFHD holdings - # information and is all that is displayed. Otherwise, the textual - # holdings statements will either replace some of the MFHD holdings - # information, or supplement it, depending on the value of the - # $8 linkage subfield. - - if (defined $self->field($cap_to_txt{$field})) { - @txt_holdings = $self->field($cap_to_txt{$field}); - - foreach my $txt (@txt_holdings) { - - # if there's a $80 subfield, then we're done, it's - # all the formatted holdings - if ($txt->subfield('8') eq '0') { - # textual holdings statement that completely - # replaces MFHD holdings in 853/863, etc. - $holdings_stmt = $txt->subfield('a'); - - if (defined $txt->subfield('z')) { - $holdings_stmt .= ' -- ' . $txt->subfield('z'); - } - - printf("# format_holdings() returning %s txt holdings\n", - $cap_to_txt{$field}); - return $holdings_stmt; - } - - # If there are non-$80 subfields in the textual holdings - # then we need to keep track of the subfields, so we can - # intersperse the textual holdings in with the the calculated - # holdings from the 853/863 fields. - foreach my $linkid ($txt->subfield('8')) { - $txt_link_ids{$linkid} = $txt; - } - } - } - - # Now loop through all the captions, finding the corresponding - # holdings statements (either MFHD or textual), and build up the - # complete formatted holdings statement. The textual holdings statements - # have either the same link id field as a caption, which means that - # the text holdings win, or they have ids that are interfiled with - # the captions, which mean they go into the middle. - - my @ids = sort($self->caption_link_ids($field), keys %txt_link_ids); - foreach my $cap_id (@ids) { - my $last_txt = undef; - - if (exists $txt_link_ids{$cap_id}) { - # there's a textual holding statement with this caption ID, - # so just use that. This covers both the "replaces" and - # the "supplements" holdings information options. - - # a single textual holdings statement can replace multiple - # captions. If the _last_ caption we saw had a textual - # holdings statement, and this caption has the same one, then - # we don't add the holdings again. - if (!defined $last_txt || ($last_txt != $txt_link_ids{$cap_id})) { - my $txt = $txt_link_ids{$cap_id}; - $holdings_stmt .= ',' if $holdings_stmt; - $holdings_stmt .= $txt->subfield('a'); - if (defined $txt->subfield('z')) { - $holdings_stmt .= ' -- ' . $txt->subfield('z'); - } - - $last_txt = $txt; - } - next; - } - - # We found a caption that doesn't have a corresponding textual - # holdings statement, so reset $last_txt to undef. - $last_txt = undef; - - my @holdings = $self->holdings($holdings_field, $cap_id); - - next unless scalar @holdings; - - # XXX Need to format compressed holdings. see code in test.pl - # for example. Try to do it without indexing? - $holdings_stmt .= ',' if $holdings_stmt; - - if ($self->compressible) { - $start = $l = shift @holdings; - $holdings_stmt .= $l->format; - - while (my $h = shift @holdings) { - if (!$h->matches($l->next)) { - # this item is not part of the current run, - # close out the run and record this item - if ($l != $start) { - $holdings_stmt .= '-' . $l->format; - } - - $holdings_stmt .= ',' . $h->format; - $start = $h - } elsif (!scalar(@holdings) || defined($h->subfield('z'))) { - # This is the end of the holdings for this caption - # or this item has a public note that we want - # to display - $holdings_stmt .= '-' . $h->format; - } - - if (defined $h->subfield('z')) { - $holdings_stmt .= ' -- ' . $h->subfield('z'); - } - - $l = $h; - } - } else { - $holdings_stmt .= ',' if $holdings_stmt; - $holdings_stmt .= (shift @holdings)->format; - foreach my $h (@holdings) { - $holdings_stmt .= ',' . $h->format; - if (defined $h->subfield('z')) { - $holdings_stmt .= ' -- ' . $h->subfield('z'); - } - } - } - } - - return $holdings_stmt; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm deleted file mode 100644 index 55e6df9d86..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm +++ /dev/null @@ -1,739 +0,0 @@ -package MFHD::Caption; -use strict; -use integer; -use Carp; - -use Data::Dumper; - -use OpenILS::Utils::MFHD::Date; - -use base 'MARC::Field'; - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = shift; - my $last_enum = undef; - - $self->{_mfhdc_ENUMS} = {}; - $self->{_mfhdc_CHRONS} = {}; - $self->{_mfhdc_PATTERN} = {}; - $self->{_mfhdc_COPY} = undef; - $self->{_mfhdc_UNIT} = undef; - $self->{_mfhdc_LINK_ID} = undef; - $self->{_mfhdc_COMPRESSIBLE} = 1; # until proven otherwise - - foreach my $subfield ($self->subfields) { - my ($key, $val) = @$subfield; - if ($key eq '8') { - $self->{_mfhdc_LINK_ID} = $val; - } elsif ($key =~ /[a-h]/) { - # Enumeration Captions - $self->{_mfhdc_ENUMS}->{$key} = { - CAPTION => $val, - COUNT => undef, - RESTART => undef - }; - if ($key =~ /[ag]/) { - $last_enum = undef; - } else { - $last_enum = $key; - } - } elsif ($key =~ /[i-m]/) { - # Chronology captions - $self->{_mfhdc_CHRONS}->{$key} = $val; - } elsif ($key eq 'u') { - # Bib units per next higher enumeration level - - # Some files seem to have "empty" $u subfields, - # especially for top level of enumeration. Just drop them - next if (!defined($val) || !$val); - - carp('$u specified for top-level enumeration') - unless defined($last_enum); - $self->{_mfhdc_ENUMS}->{$last_enum}->{COUNT} = $val; - } elsif ($key eq 'v') { - # Is this level of enumeration continuous, or does it restart? - - # Some files seem to have "empty" $v subfields, - # especially for top level of enumeration. Just drop them - next if (!defined($val) || !$val); - - carp '$v specified for top-level enumeration' - unless defined($last_enum); - $self->{_mfhdc_ENUMS}->{$last_enum}->{RESTART} = ($val eq 'r'); - } elsif ($key =~ /[npwz]/) { - # Publication Pattern info ('o' == type of unit, 'q'..'t' undefined) - $self->{_mfhdc_PATTERN}->{$key} = $val; - } elsif ($key =~ /x/) { - # Calendar change can have multiple comma-separated values - $self->{_mfhdc_PATTERN}->{x} = [split /,/, $val]; - } elsif ($key eq 'y') { - $self->{_mfhdc_PATTERN}->{y} = {} - unless exists $self->{_mfhdc_PATTERN}->{y}; - update_pattern($self, $val); - } elsif ($key eq 'o') { - # Type of unit - $self->{_mfhdc_UNIT} = $val; - } elsif ($key eq 't') { - $self->{_mfhdc_COPY} = $val; - } else { - carp "Unknown caption subfield '$key'"; - } - } - - # subsequent levels of enumeration (primary and alternate) - # If an enumeration level doesn't document the number - # of "issues" per "volume", or whether numbering of issues - # restarts, then we can't compress. - foreach my $key ('b', 'c', 'd', 'e', 'f', 'h') { - if (exists $self->{_mfhdc_ENUMS}->{$key}) { - my $pattern = $self->{_mfhdc_ENUMS}->{$key}; - if ( !$pattern->{RESTART} - || !$pattern->{COUNT} - || ($pattern->{COUNT} eq 'var') - || ($pattern->{COUNT} eq 'und')) { - $self->{_mfhdc_COMPRESSIBLE} = 0; - last; - } - } - } - - my $pat = $self->{_mfhdc_PATTERN}; - - # Sanity check publication frequency vs publication pattern: - # if the frequency is a number, then the pattern better - # have that number of values associated with it. - if ( exists($pat->{w}) - && ($pat->{w} =~ /^\d+$/) - && ($pat->{w} != scalar(@{$pat->{y}->{p}}))) { - carp( -"Caption::new: publication frequency '$pat->{w}' != publication pattern @{$pat->{y}->{p}}" - ); - } - - # If there's a $x subfield and a $j, then it's compressible - if (exists $pat->{x} && exists $self->{_mfhdc_CHRONS}->{'j'}) { - $self->{_mfhdc_COMPRESSIBLE} = 1; - } - - bless($self, $class); - - return $self; -} - -sub update_pattern { - my $self = shift; - my $val = shift; - my $pathash = $self->{_mfhdc_PATTERN}->{y}; - my ($pubcode, $pat) = unpack("a1a*", $val); - - $pathash->{$pubcode} = [] unless exists $pathash->{$pubcode}; - push @{$pathash->{$pubcode}}, $pat; -} - -sub decode_pattern { - my $self = shift; - my $pattern = $self->{_mfhdc_PATTERN}->{y}; - - # XXX WRITE ME (?) -} - -sub compressible { - my $self = shift; - - return $self->{_mfhdc_COMPRESSIBLE}; -} - -sub chrons { - my $self = shift; - my $key = shift; - - if (exists $self->{_mfhdc_CHRONS}->{$key}) { - return $self->{_mfhdc_CHRONS}->{$key}; - } else { - return undef; - } -} - -sub capfield { - my $self = shift; - my $key = shift; - - if (exists $self->{_mfhdc_ENUMS}->{$key}) { - return $self->{_mfhdc_ENUMS}->{$key}; - } elsif (exists $self->{_mfhdc_CHRONS}->{$key}) { - return $self->{_mfhdc_CHRONS}->{$key}; - } else { - return undef; - } -} - -sub capstr { - my $self = shift; - my $key = shift; - my $val = $self->capfield($key); - - if (ref $val) { - return $val->{CAPTION}; - } else { - return $val; - } -} - -sub type_of_unit { - my $self = shift; - - return $self->{_mfhdc_UNIT}; -} - -sub link_id { - my $self = shift; - - return $self->{_mfhdc_LINK_ID}; -} - -sub calendar_change { - my $self = shift; - - return $self->{_mfhdc_PATTERN}->{x}; -} - -# If items are identified by chronology only, with no separate -# enumeration (eg, a newspaper issue), then the chronology is -# recorded in the enumeration subfields $a - $f. We can tell -# that this is the case if there are $a - $f subfields and no -# chronology subfields ($i-$k), and none of the $a-$f subfields -# have associated $u or $v subfields, but there's a $w and no $x - -sub enumeration_is_chronology { - my $self = shift; - - # There is always a '$a' subfield in well-formed fields. - return 0 - if exists $self->{_mfhdc_CHRONS}->{i} - || exists $self->{_mfhdc_PATTERN}->{x}; - - foreach my $key ('a'..'f') { - my $enum; - - last if !exists $self->{_mfhdc_ENUMS}->{$key}; - - $enum = $self->{_mfhdc_ENUMS}->{$key}; - return 0 if defined $enum->{COUNT} || defined $enum->{RESTART}; - } - - return (exists $self->{_mfhdc_PATTERN}->{w}); -} - -sub regularity_match { - my $self = shift; - my $pubcode = shift; - my @date = @_; - - # we can't match something that doesn't exist. - return 0 if !exists $self->{_mfhdc_PATTERN}->{y}->{$pubcode}; - - foreach my $regularity (@{$self->{_mfhdc_PATTERN}->{y}->{$pubcode}}) { - my $chroncode = substr($regularity, 0, 1); - my $matchfunc = MFHD::Date::dispatch($chroncode); - my @pats = split(/,/, substr($regularity, 1)); - - if (!defined $matchfunc) { - carp "Unrecognized chroncode '$chroncode'"; - return 0; - } - - # XXX WRITE ME - foreach my $pat (@pats) { - $pat =~ s|/.+||; # If it's a combined date, match the start - if ($matchfunc->($pat, @date)) { - return 1; - } - } - } - - return 0; -} - -sub is_omitted { - my $self = shift; - my @date = @_; - - # printf("# is_omitted: testing date %s: %d\n", join('/', @date), - # $self->regularity_match('o', @date)); - return $self->regularity_match('o', @date); -} - -sub is_published { - my $self = shift; - my @date = @_; - - return $self->regularity_match('p', @date); -} - -sub is_combined { - my $self = shift; - my @date = @_; - - return $self->regularity_match('c', @date); -} - -sub enum_is_combined { - my $self = shift; - my $subfield = shift; - my $iss = shift; - my $level = ord($subfield) - ord('a') + 1; - - return 0 if !exists $self->{_mfhdc_PATTERN}->{y}->{c}; - - foreach my $regularity (@{$self->{_mfhdc_PATTERN}->{y}->{c}}) { - next unless $regularity =~ m/^e$level/o; - - my @pats = split(/,/, substr($regularity, 2)); - - foreach my $pat (@pats) { - $pat =~ s|/.+||; # if it's a combined issue, match the start - return 1 if ($iss eq $pat); - } - } - - return 0; -} - -# Test to see if $dt1 is on or after $dt2 -# if length(@{$dt2} == 2, then just month/day are compared -# if length(@{$dt2} == 1, then just the months are compared -sub on_or_after { - my $dt1 = shift; - my $dt2 = shift; - -# printf("# on_or_after(%s, %s): ", join('/', @{$dt1}), join('/', @{$dt2})); - - foreach my $i (0..(scalar(@{$dt2}) - 1)) { - if ($dt1->[$i] > $dt2->[$i]) { - # printf("after - pass\n"); - # $dt1 occurs AFTER $dt2 - return 1; - } elsif ($dt1->[$i] < $dt2->[$i]) { - # printf("before - fail\n"); - # $dt1 occurs BEFORE $dt2 - return 0; - } - # both are still equal, keep going - } - - # We fell out of the loop with them being equal, so it's 'on' - # printf("on - pass\n"); - return 1; -} - -sub calendar_increment { - my $self = shift; - my $cur = shift; - my $new = shift; - my $cal_change = $self->calendar_change; - my $month; - my $day; - my $cur_before; - my $new_on_or_after; - - # A calendar change is defined, need to check if it applies - if (scalar(@{$new}) == 1) { - carp "Can't calculate date change for ", $self->as_string; - return 0; - } - - foreach my $change (@{$cal_change}) { - my $incr; - - if (length($change) == 2) { - $month = $change; - } elsif (length($change) == 4) { - ($month, $day) = unpack("a2a2", $change); - } - - # printf("# calendar_increment('%s', '%s'): change on '%s/%s'\n", - # join('/', @{$cur}), join('/', @{$new}), - # $month, defined($day) ? $day : 'UNDEF'); - - if ($cur->[0] == $new->[0]) { - # Same year, so a 'simple' month/day comparison will be fine - $incr = - ( !on_or_after([$cur->[1], $cur->[2]], [$month, $day]) - && on_or_after([$new->[1], $new->[2]], [$month, $day])); - } else { - # @cur is in the year before @new. There are - # two possible cases for the calendar change date that - # indicate that it's time to change the volume: - # (1) the change date is AFTER @cur in the year, or - # (2) the change date is BEFORE @new in the year. - # - # -------|------|------X------|------| - # @cur (1) Jan 1 (2) @new - - $incr = - (on_or_after([$new->[1], $new->[2]], [$month, $day]) - || !on_or_after([$cur->[1], $cur->[2]], [$month, $day])); - } - return $incr if $incr; - } - - return 0; -} - -sub next_chron { - my $self = shift; - my $next = shift; - my $carry = shift; - my @keys = @_; - my @cur; - my @new; - my @newend; # only used for combined issues - my $incr; - - my $reg = $self->{_mfhdc_REGULARITY}; - my $pattern = $self->{_mfhdc_PATTERN}; - my $freq = $pattern->{w}; - - foreach my $i (0..$#keys) { - $cur[$i] = $next->{$keys[$i]} if exists $next->{$keys[$i]}; - } - - # If the current issue has a combined date (eg, May/June) - # get rid of the first date and base the calculation - # on the final date in the combined issue. - $cur[-1] =~ s|^[^/]+/||; - - if (defined $pattern->{y}->{p}) { - # There is a $y publication pattern defined in the record: - # use it to calculate the next issue date. - - foreach my $pubpat (@{$pattern->{y}->{p}}, @{$pattern->{y}->{c}}) { - my $chroncode = substr($pubpat, 0, 1); - my $genfunc = MFHD::Date::generator($chroncode); - my @pats = split(/,/, substr($pubpat, 1)); - - next if $chroncode eq 'e'; - - if (!defined $genfunc) { - carp "Unrecognized chroncode '$chroncode'"; - return undef; - } - - foreach my $pat (@pats) { - my $combined = $pat =~ m|/|; - my ($start, $end); - my @candidate; - - # printf("# next_date: generating with pattern '%s'\n", $pat); - - if ($combined) { - ($start, $end) = split('/', $pat, 2); - } else { - ($start, $end) = (undef, undef); - } - - @candidate = $genfunc->($start || $pat, @cur); - - while ($self->is_omitted(@candidate)) { - # printf("# pubpat omitting date '%s'\n", - # join('/', @candidate)); - @candidate = $genfunc->($start || $pat, @candidate); - } - - # printf("# testing new candidate '%s' against '%s'\n", - # join('/', @candidate), join('/', @new)); - - if (!defined($new[0]) || !on_or_after(\@candidate, \@new)) { - # first time through the loop - # or @candidate is before @new => - # @candidate is the next issue. - @new = @candidate; - if (defined $end) { - @newend = $genfunc->($end, @cur); - } else { - $newend[0] = undef; - } - - # printf("# selecting candidate date '%s'\n", join('/', @new)); - } - } - } - - if (defined($newend[0])) { - # The best match was a combined issue - foreach my $i (0..$#new) { - # don't combine identical fields - next if $new[$i] eq $newend[$i]; - $new[$i] .= '/' . $newend[$i]; - } - } - } - - if (scalar @new == 0) { - # There was no suitable publication pattern defined, - # so use the $w frequency to figure out the next date - if (!defined($freq)) { - carp "Undefined frequency in next_chron!"; - } elsif (!MFHD::Date::can_increment($freq)) { - carp "Don't know how to deal with frequency '$freq'!"; - } else { - # One of the standard defined issue frequencies - @new = MFHD::Date::incr_date($freq, @cur); - - while ($self->is_omitted(@new)) { - @new = MFHD::Date::incr_date($freq, @new); - } - - if ($self->is_combined(@new)) { - my @second_date = MFHD::Date::incr_date($freq, @new); - - # I am cheating: This code assumes that only the smallest - # time increment is combined. So, no "Apr 15/May 1" allowed. - $new[-1] = $new[-1] . '/' . $second_date[-1]; - } - } - } - - for my $i (0..$#new) { - $next->{$keys[$i]} = $new[$i]; - } - # Figure out if we need to adjust volume number - # right now just use the $carry that was passed in. - # in long run, need to base this on ($carry or date_change) - if ($carry) { - # if $carry is set, the date doesn't matter: we're not - # going to increment the v. number twice at year-change. - $next->{a} += $carry; - } elsif (defined $pattern->{x}) { - $next->{a} += $self->calendar_increment(\@cur, \@new); - } -} - -sub next_alt_enum { - my $self = shift; - my $next = shift; - - # First handle any "alternative enumeration", since they're - # a lot simpler, and don't depend on the the calendar - foreach my $key ('h', 'g') { - next if !exists $next->{$key}; - if (!$self->capstr($key)) { - warn "Holding data exists for $key, but no caption specified"; - $next->{$key} += 1; - last; - } - - my $cap = $self->capfield($key); - if ( $cap->{RESTART} - && $cap->{COUNT} - && ($next->{$key} == $cap->{COUNT})) { - $next->{$key} = 1; - } else { - $next->{$key} += 1; - last; - } - } -} - -# Check caption for $ype subfield, specifying that there's a -# particular publication pattern for the given level of enumeration -# returns the pattern string or undef -sub enum_pubpat { - my $self = shift; - my $level = shift; - - return undef if !exists $self->{_mfhdc_PATTERN}->{y}->{p}; - - foreach my $reg (@{$self->{_mfhdc_PATTERN}->{y}->{p}}) { - if ($reg =~ m/^e$level/o) { - return substr($reg, 2); - } - } - return undef; -} - -sub next_enum { - my $self = shift; - my $next = shift; - my $carry; - - # $carry keeps track of whether we need to carry into the next - # higher level of enumeration. It's not actually necessary except - # for when the loop ends: if we need to carry from $b into $a - # then $carry will be set when the loop ends. - # - # We need to keep track of this because there are two different - # reasons why we might increment the highest level of enumeration ($a) - # 1) we hit the correct number of items in $b (ie, 5th iss of quarterly) - # 2) it's the right time of the year. - # - - # If there's a subfield b, then we will go through the loop at - # least once. If there's no subfield b, then there's only a single - # level of enumeration, so we just add one to it and we're done. - if (exists $next->{b}) { - $carry = 0; - } else { - $carry = 1; - } - foreach my $key (reverse('b'..'f')) { - my $level; - my $pubpat; - - next if !exists $next->{$key}; - - # If the current issue has a combined issue number (eg, 2/3) - # get rid of the first issue number and base the calculation - # on the final issue number in the combined issue. - if ($next->{$key} =~ m|/|) { - $next->{$key} =~ s|^[^/]+/||; - } - - $level = ord($key) - ord('a') + 1; # enumeration level - - $pubpat = $self->enum_pubpat($level); - - if ($pubpat) { - # printf("# next_enum: found pubpat '%s' for subfield '%s'\n", - # $pubpat, $key); - my @pats = split(/,/, $pubpat); - - # If we fall out the bottom of the loop, then $carry - # will still be 1, and we will reset the current - # level to the first value in @pats and increment - # then next higher level. - $carry = 1; - - foreach my $pat (@pats) { - my $combined = $pat =~ m|/|; - my $end; - - # printf("# next_enum: checking current '%s' against pat '%s'\n", - # $next->{$key}, $pat); - - if ($combined) { - ($pat, $end) = split('/', $pat, 2); - } else { - $end = undef; - } - - if ($pat > $next->{$key}) { - $carry = 0; - $next->{$key} = $pat; - $next->{$key} .= '/' . $end if $end; - # printf("# next_enum: selecting new issue no. %s\n", $next->{$key}); - last; # We've found the correct next issue number - } - } - if ($carry) { - $next->{$key} = $pats[0]; - } else { - last; # exit the top level loop because we're done - } - - } else { - # No enumeration publication pattern specified for this level, - # just keep adding one. - - if (!$self->capstr($key)) { - # Just assume that it increments continuously and give up - warn "Holding data exists for $key, but no caption specified"; - $next->{$key} += 1; - $carry = 0; - last; - } - - # printf("# next_enum: no publication pattern, using frequency\n"); - - my $cap = $self->capfield($key); - if ( $cap->{RESTART} - && $cap->{COUNT} - && ($next->{$key} eq $cap->{COUNT})) { - $next->{$key} = 1; - $carry = 1; - } else { - # If I don't need to "carry" beyond here, then I just increment - # this level of the enumeration and stop looping, since the - # "next" hash has been initialized with the current values - - $next->{$key} += 1; - $carry = 0; - } - - # You can't have a combined issue that spans two volumes: no.12/1 - # is forbidden - if ($self->enum_is_combined($key, $next->{$key})) { - $next->{$key} .= '/' . ($next->{$key} + 1); - } - - last if !$carry; - } - } - - # The easy part is done. There are two things left to do: - # 1) Calculate the date of the next issue, if necessary - # 2) Increment the highest level of enumeration (either by date - # or because $carry is set because of the above loop - - if (!$self->subfield('i') || !$next->{i}) { - # The simple case: if there is no chronology specified - # then just check $carry and return - $next->{'a'} += $carry; - } else { - # Figure out date of next issue, then decide if we need - # to adjust top level enumeration based on that - $self->next_chron($next, $carry, ('i'..'m')); - } -} - -sub next { - my $self = shift; - my $holding = shift; - my $next = {}; - - # If the holding is compressed and not open ended, base next() on the - # closing date. If the holding is open-ended, next() is undefined - my $index; - if ($holding->is_compressed) { - return undef if $holding->is_open_ended; - # TODO: error on next for open-ended holdings? - $index = 1; - } else { - $index = 0; - } - - # Initialize $next with current enumeration & chronology, then - # we can just operate on $next, based on the contents of the caption - foreach my $key ('a'..'m') { - my $holding_values = $holding->field_values($key); - $next->{$key} = ${$holding_values}[$index] if defined $holding_values; - } - - if ($self->enumeration_is_chronology) { - $self->next_chron($next, 0, ('a'..'h')); - return $next; - } - - if (exists $next->{'h'}) { - $self->next_alt_enum($next); - } - - $self->next_enum($next); - - return ($next); -} - -# return a simple subfields list -sub subfields_list { - my $self = shift; - my @subfields; - - foreach my $subfield ($self->subfields) { - push(@subfields, $subfield->[0], $subfield->[1]); - } - return @subfields; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Date.pm b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Date.pm deleted file mode 100644 index 34c85d9691..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Date.pm +++ /dev/null @@ -1,580 +0,0 @@ -package MFHD::Date; -use strict; -use integer; -use Carp; - -use Data::Dumper; -use DateTime; - -use base 'Exporter'; - -our @EXPORT_OK = qw(dispatch generator incr_date can_increment); - -my %daynames = ( - 'mo' => 1, - 'tu' => 2, - 'we' => 3, - 'th' => 4, - 'fr' => 5, - 'sa' => 6, - 'su' => 7, -); - -my $daypat = '(mo|tu|we|th|fr|sa|su)'; -my $weekpat = '(99|98|97|00|01|02|03|04|05)'; -my $weeknopat; -my $monthpat = '(01|02|03|04|05|06|07|08|09|10|11|12)'; -my $seasonpat = '(21|22|23|24)'; - -# Initialize $weeknopat to be '(01|02|03|...|51|52|53)' -$weeknopat = '('; -foreach my $weekno (1..52) { - $weeknopat .= sprintf('%02d|', $weekno); -} -$weeknopat .= '53)'; - -sub match_day { - my $pat = shift; - my @date = @_; - # Translate daynames into day of week for DateTime - # also used to check if dayname is valid. - - if (exists $daynames{$pat}) { - # dd - # figure out day of week for date and compare - my $dt = DateTime->new( - year => $date[0], - month => $date[1], - day => $date[2] - ); - return ($dt->day_of_week == $daynames{$pat}); - } elsif (length($pat) == 2) { - # DD - return $pat == $date[2]; - } elsif (length($pat) == 4) { - # MMDD - my ($mon, $day) = unpack("a2a2", $pat); - - return (($mon == $date[1]) && ($day == $date[2])); - } else { - carp "Invalid day pattern '$pat'"; - return 0; - } -} - -sub subsequent_day { - my $pat = shift; - my @cur = @_; - my $dt = DateTime->new( - year => $cur[0], - month => $cur[1], - day => $cur[2] - ); - - # printf("# subsequent_day: pat='%s' cur='%s'\n", $pat, join('/', @cur)); - - if (exists $daynames{$pat}) { - # dd: published on the given weekday - my $dow = $dt->day_of_week; - my $corr = ($daynames{$pat} - $dow + 7) % 7; - - if ($dow == $daynames{$pat}) { - # the next one is one week hence - $dt->add(days => 7); - } else { - # the next one is later this week, - # or it is next week (ie, on or after next Monday) - # $corr will take care of it. - $dt->add(days => $corr); - } - @cur = ($dt->year, $dt->month, $dt->day); - } elsif (length($pat) == 2) { - # DD: published on the give day of every month - if ($dt->day >= $pat) { - # current date is on or after $pat: next one is next month - $dt->set(day => $pat); - $dt->add(months => 1); - @cur = ($dt->year, $dt->month, $dt->day); - } else { - # current date is before $pat: set day to pattern - $cur[2] = $pat; - } - } elsif (length($pat) == 4) { - # MMDD: published on the given day of the given month - my ($mon, $day) = unpack("a2a2", $pat); - - if (on_or_after($mon, $day, $cur[1], $cur[2])) { - # Current date is on or after pattern; next one is next year - $cur[0] += 1; - } - # Year is now right. Either it's next year (because of on_or_after) - # or it's this year, because the current date is NOT on or after - # the pattern. Just fix the month and day - $cur[1] = $mon; - $cur[2] = $day; - } else { - carp "Invalid day pattern '$pat'"; - return undef; - } - - foreach my $i (0..$#cur) { - $cur[$i] = '0' . (0 + $cur[$i]) if $cur[$i] < 10; - } - - # printf("subsequent_day: returning '%s'\n", join('/', @cur)); - - return @cur; -} - -# Calculate date of 3rd Friday of the month (for example) -# 1-5: count from beginning of month -# 99-97: count back from end of month -sub nth_week_of_month { - my $dt = shift; - my $week = shift; - my $day = shift; - my ($nth_day, $dow); - - # printf("# nth_week_of_month(dt, '%s', '%s')\n", $week, $day); - - if (0 < $week && $week <= 5) { - $nth_day = $dt->clone->set(day => 1); - } elsif ($week >= 97) { - $nth_day = DateTime->last_day_of_month( - year => $dt->year, - month => $dt->month - ); - } else { - return undef; - } - - $dow = $nth_day->day_of_week(); - - # If a particular day was passed in (eg, we want 3rd friday) - # then use that day for the calculations, otherwise, just use - # the day of the week of the original date (the date $dt). - if (defined($day)) { - $day = $daynames{$day}; - } else { - $day = $dt->day_of_week; - } - - if ($week <= 5) { - # count forwards - $nth_day->add( - days => ($day - $dow + 7) % 7, - weeks => $week - 1 - ); - } else { - # count backwards - $nth_day->subtract(days => ($day - $dow + 7) % 7); - - # 99: last week of month, 98: second last, etc. - for (my $i = 99 - $week; $i > 0; $i--) { - $nth_day->subtract(weeks => 1); - } - } - - # There is no nth "day" in the month! - return undef if ($dt->month != $nth_day->month); - - return $nth_day; -} - -# -# Internal utility function to match the various different patterns -# of month, week, and day -# -sub check_date { - my $dt = shift; - my $month = shift; - my $weekno = shift; - my $day = shift; - - # printf("check_date('%s', '%s', '%s')\n", $month, $weekno, $day || ''); - - if (!defined $day) { - # MMWW - return ( - ($dt->month == $month) - && ( - ($dt->week_of_month == $weekno) - || ( - $weekno >= 97 - && ($dt->week_of_month == - nth_week_of_month($dt, $weekno, $day)->week_of_month) - ) - ) - ); - } - - # simple cases first - if ($daynames{$day} != $dt->day_of_week) { - # if it's the wrong day of the week, rest doesn't matter - return 0; - } - - if (!defined $month) { - # WWdd - return ( - ($weekno == 0) # Every week - || ($dt->weekday_of_month == $weekno) # this week - || ( - ($weekno >= 97) - && ($dt->weekday_of_month == - nth_week_of_month($dt, $weekno, $day)->weekday_of_month) - ) - ); - } - - # MMWWdd - if ($month != $dt->month) { - # If it's the wrong month, then we're done - return 0; - } - - # It's the right day of the week - # It's the right month - - if (($weekno == 0) || ($weekno == $dt->weekday_of_month)) { - # If this matches, then we're counting from the beginning - # of the month and it matches and we're done. - return 1; - } - - # only case left is that the week number is counting from - # the end of the month: eg, second last wednesday - return ( - ($weekno >= 97) - && (nth_week_of_month($dt, $weekno, $day)->weekday_of_month == - $dt->weekday_of_month) - ); -} - -sub match_week { - my $pat = shift; - my @date = @_; - my $dt = DateTime->new( - year => $date[0], - month => $date[1], - day => $date[2] - ); - - if ($pat =~ m/^$weekpat$daypat$/) { - # WWdd: 03we = Third Wednesday - return check_date($dt, undef, $1, $2); - } elsif ($pat =~ m/^$monthpat$weekpat$daypat$/) { - # MMWWdd: 0599tu Last Tuesday in May XXX WRITE ME - return check_date($dt, $1, $2, $3); - } elsif ($pat =~ m/^$monthpat$weekpat$/) { - # MMWW: 1204: Fourth week in December XXX WRITE ME - return check_date($dt, $1, $2, undef); - } else { - carp "invalid week pattern '$pat'"; - return 0; - } -} - -# -# Use $pat to calcuate the date of the issue following $cur -# -sub subsequent_week { - my $pat = shift; - my @cur = @_; - my $candidate; - my $dt; - - # printf("# subsequent_week('%s', '%s', '%s', '%s')\n", $pat, @cur); - - $dt = DateTime->new( - year => $cur[0], - month => $cur[1], - day => $cur[2] - ); - - if ($pat =~ m/^$weekpat$daypat$/o) { - # WWdd: published on given weekday of given week of every month - my ($week, $day) = ($1, $2); - - # printf("# subsequent_week: matched /WWdd/: week='%s', day='%s'\n", - # $week, $day); - - if ($week eq '00') { - # Every week - $candidate = $dt->clone; - - if ($dt->day_of_week == $daynames{$day}) { - # Current is right day, next one is a week hence - $candidate->add(days => 7); - } else { - $candidate->add( - days => ($daynames{$day} - $dt->day_of_week + 7) % 7); - } - } else { - # 3rd Friday of the month (eg) - $candidate = nth_week_of_month($dt, $week, $day); - } - - if ($candidate <= $dt) { -# If the n'th week of the month happens on before the -# current issue, then the next issue is published next -# month, otherwise, it's published this month. -# This will never happen for the "00: every week" pattern -# printf("# subsequent_week: candidate (%s) occurs on or before current date (%s)\n", -# join('/', $candidate->year, $candidate->month, $candidate->day), -# join('/', $dt->year, $dt->month, $dt->day)); - $candidate->set(day => 1); - $candidate->add(months => 1); - $candidate = nth_week_of_month($candidate, $week, $day); - } - } elsif ($pat =~ m/^$monthpat$weekpat$daypat$/) { - # MMWWdd: published on given weekday of given week of given month - my ($month, $week, $day) = ($1, $2, $3); - -# printf("# subsequent_week: matched /MMWWdd/: month='%s', week='%s', day='%s'\n", -# $month, $week, $day); - - $candidate = DateTime->new( - year => $dt->year, - month => $month, - day => 1 - ); - $candidate = nth_week_of_month($candidate, $week, $day); - if ($candidate <= $dt) { - # We've missed it for this year, next one that matches - # will be next year - $candidate->add(years => 1)->set(day => 1); - $candidate = nth_week_of_month($candidate, $week, $day); - } - } elsif ($pat =~ m/^$monthpat$weekpat$/) { - # MMWW: published during given week of given month - my ($month, $week) = ($1, $2); - - $candidate = nth_week_of_month( - DateTime->new( - year => $dt->year, - month => $month, - day => 1 - ), - $week, 'th' - ); - if ($candidate <= $dt) { - # Already past the pattern date this year, move to next year - $candidate->add(years => 1)->set(day => 1); - $candidate = nth_week_of_month($candidate, $week, 'th'); - } - } else { - carp "invalid week pattern '$pat'"; - return undef; - } - - $cur[0] = $candidate->year; - $cur[1] = $candidate->month; - $cur[2] = $candidate->day; - - foreach my $i (0..$#cur) { - $cur[$i] = '0' . (0 + $cur[$i]) if $cur[$i] < 10; - } - - return @cur; -} - -sub match_month { - my $pat = shift; - my @date = @_; - - return ($pat eq $date[1]); -} - -sub subsequent_month { - my $pat = shift; - my @cur = @_; - - if ($cur[1] >= $pat) { - # Current date is on or after the patter date, so the next - # occurence is next year - $cur[0] += 1; - } - - # The year is right, just set the month to the pattern date. - $cur[1] = $pat; - - return @cur; -} - -sub match_season { - my $pat = shift; - my @date = @_; - - return ($pat eq $date[1]); -} - -sub subsequent_season { - my $pat = shift; - my @cur = @_; - -# printf("# subsequent_season: pat='%s', cur='%s'\n", $pat, join('/',@cur)); - - if (($pat < 21) || ($pat > 24)) { - carp "Unexpected season '$pat'"; - return undef; - } - - if ($cur[1] >= $pat) { - # current season is on or past pattern season in this year, - # advance to next year - $cur[0] += 1; - } - # Either we've advanced to the next year or the current season - # is before the pattern season in the current year. Either way, - # all that remains is to set the season properly - $cur[1] = $pat; - - return @cur; -} - -sub match_year { - my $pat = shift; - my @date = @_; - - # XXX WRITE ME - return 0; -} - -sub subsequent_year { - my $pat = shift; - my $cur = shift; - - # XXX WRITE ME - return undef; -} - -sub match_issue { - my $pat = shift; - my @date = @_; - - # We handle enumeration patterns separately. This just - # ensures that when we're processing chronological patterns - # we don't match an enumeration pattern. - return 0; -} - -sub subsequent_issue { - my $pat = shift; - my $cur = shift; - - # Issue generation is handled separately - return undef; -} - -my %dispatch = ( - d => \&match_day, - e => \&match_issue, # not really a "chron" code - w => \&match_week, - m => \&match_month, - s => \&match_season, - y => \&match_year, -); - -my %generators = ( - d => \&subsequent_day, - e => \&subsequent_issue, # not really a "chron" code - w => \&subsequent_week, - m => \&subsequent_month, - s => \&subsequent_season, - y => \&subsequent_year, -); - -sub dispatch { - my $chroncode = shift; - - return $dispatch{$chroncode}; -} - -sub generator { - my $chroncode = shift; - - return $generators{$chroncode}; -} - -my %increments = ( - a => {years => 1}, # annual - b => {months => 2}, # bimonthly - c => {days => 3}, # semiweekly - d => {days => 1}, # daily - e => {weeks => 2}, # biweekly - f => {months => 6}, # semiannual - g => {years => 2}, # biennial - h => {years => 3}, # triennial - i => {days => 2}, # three times / week - j => {days => 10}, # three times /month - # k => continuous - m => {months => 1}, # monthly - q => {months => 3}, # quarterly - s => {days => 15}, # semimonthly - t => {months => 4}, # three times / year - w => {weeks => 1}, # weekly - # x => completely irregular -); - -sub can_increment { - my $freq = shift; - - return exists $increments{$freq}; -} - -# TODO: add support for weeks as chron level? -sub incr_date { - my $freq = shift; - my $incr = $increments{$freq}; - my @new = @_; - - if (scalar(@new) == 1) { - # only a year is specified. Next date is easy - $new[0] += $incr->{years} || 1; - } elsif (scalar(@new) == 2) { - # Year and month or season - if ($new[1] > 20) { - # season - $new[1] += ($incr->{months} / 3) || 1; - if ($new[1] > 24) { - # carry - $new[0] += 1; - $new[1] -= 4; # 25 - 4 == 21 == Spring after Winter - } - } else { - # month - $new[1] += $incr->{months} || 1; - if ($new[1] > 12) { - # carry - $new[0] += 1; - $new[1] -= 12; - } - } - } elsif (scalar(@new) == 3) { - # Year, Month, Day: now it gets complicated. - - if ($new[2] =~ /^[0-9]+$/) { - # A single number for the day of month, relatively simple - my $dt = DateTime->new( - year => $new[0], - month => $new[1], - day => $new[2] - ); - $dt->add(%{$incr}); - $new[0] = $dt->year; - $new[1] = $dt->month; - $new[2] = $dt->day; - } - } else { - warn("Don't know how to cope with @new"); - } - - foreach my $i (0..$#new) { - $new[$i] = '0' . (0 + $new[$i]) if $new[$i] < 10; - } - - return @new; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm deleted file mode 100644 index efd6027ba2..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm +++ /dev/null @@ -1,793 +0,0 @@ -# MFHD::Holding provides some additional holdings logic to a MARC::Field -# object. In its current state it is primarily read-only, as direct changes -# to the underlying MARC::Field are not reflected in the MFHD logic layer, and -# only the 'increment', 'notes', and 'seqno' methods do updates to the -# MARC::Field layer. - -package MFHD::Holding; -use strict; -use integer; - -use Carp; -use DateTime; -use Data::Dumper; - -use base 'MARC::Field'; - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $seqno = shift; - my $self = shift; - my $caption = shift; - my $last_enum = undef; - - $self->{_mfhdh_SEQNO} = $seqno; - $self->{_mfhdh_CAPTION} = $caption; - $self->{_mfhdh_DESCR} = {}; - $self->{_mfhdh_COPY} = undef; - $self->{_mfhdh_BREAK} = undef; - $self->{_mfhdh_NOTES} = {}; - $self->{_mfhdh_NOTES}{public} = []; - $self->{_mfhdh_NOTES}{private} = []; - $self->{_mfhdh_COPYRIGHT} = []; - $self->{_mfhdh_COMPRESSED} = ($self->indicator(2) eq '0' || $self->indicator(2) eq '2') ? 1 : 0; - # TODO: full support for second indicators 2, 3, and 4 - $self->{_mfhdh_OPEN_ENDED} = 0; - - foreach my $subfield ($self->subfields) { - my ($key, $val) = @$subfield; - - if ($key =~ /[a-m]/) { - if (exists($self->{_mfhdh_FIELDS}->{$key})) { - carp("Duplicate, non-repeatable subfield '$key' found, ignoring"); - next; - } - if ($self->{_mfhdh_COMPRESSED}) { - $self->{_mfhdh_FIELDS}->{$key}{HOLDINGS} = [split(/\-/, $val)]; - } else { - $self->{_mfhdh_FIELDS}->{$key}{HOLDINGS} = [$val]; - } - if ($key =~ /[a-h]/) { - # Enumeration specific details of holdings - $self->{_mfhdh_FIELDS}->{$key}{UNIT} = undef; - $last_enum = $key; - } - } elsif ($key eq 'o') { - warn '$o specified prior to first enumeration' - unless defined($last_enum); - $self->{_mfhdh_FIELDS}->{$last_enum}->{UNIT} = $val; - $last_enum = undef; - } elsif ($key =~ /[npq]/) { - $self->{_mfhdh_DESCR}->{$key} = $val; - } elsif ($key eq 's') { - push @{$self->{_mfhdh_COPYRIGHT}}, $val; - } elsif ($key eq 't') { - $self->{_mfhdh_COPY} = $val; - } elsif ($key eq 'w') { - carp "Unrecognized break indicator '$val'" - unless $val =~ /^[gn]$/; - $self->{_mfhdh_BREAK} = $val; - } elsif ($key eq 'x') { - push @{$self->{_mfhdh_NOTES}{private}}, $val; - } elsif ($key eq 'z') { - push @{$self->{_mfhdh_NOTES}{public}}, $val; - } - } - - if ( $self->{_mfhdh_COMPRESSED} - && $self->{_mfhdh_FIELDS}{'a'}{HOLDINGS}[1] eq '') { - $self->{_mfhdh_OPEN_ENDED} = 1; - } - bless($self, $class); - return $self; -} - -# -# accessor to the object's field hash -# -# We are avoiding calling these elements 'subfields' because they are more -# than simply the MARC subfields, although in the current implementation they -# are indexed on the subfield key -# -# TODO: this accessor should probably be replaced with methods which hide the -# underlying structure of {_mfhdh_FIELDS} (see field_values for a start) -# -sub fields { - my $self = shift; - - return $self->{_mfhdh_FIELDS}; -} - -# -# Given a field key, returns an array ref of one (for single statements) -# or two (for compressed statements) values -# -# TODO: add setter functionality to replace direct {HOLDINGS} access in other -# methods. It also makes sense to override some of the MARC::Field setter -# methods (such as update()) to accomplish this level of encapsulation. -# -sub field_values { - my ($self, $key) = @_; - - if (exists $self->fields->{$key}) { - my @values = @{$self->fields->{$key}{HOLDINGS}}; - return \@values; - } else { - return undef; - } -} - -sub seqno { - my $self = shift; - - if (@_) { - $self->{_mfhdh_SEQNO} = $_[0]; - $self->update(8 => $self->caption->link_id . '.' . $_[0]); - } - - return $self->{_mfhdh_SEQNO}; -} - -# -# Optionally accepts a true/false value to set the 'compressed' attribute -# Returns 'compressed' attribute -# -sub is_compressed { - my $self = shift; - my $is_compressed = shift; - - if (defined($is_compressed)) { - if ($is_compressed) { - $self->{_mfhdh_COMPRESSED} = 1; - $self->update(ind2 => '0'); - } else { - $self->{_mfhdh_COMPRESSED} = 0; - $self->update(ind2 => '1'); - } - } - - return $self->{_mfhdh_COMPRESSED}; -} - -sub is_open_ended { - my $self = shift; - - return $self->{_mfhdh_OPEN_ENDED}; -} - -sub caption { - my $self = shift; - - return $self->{_mfhdh_CAPTION}; -} - -# -# notes: If called with no arguments, returns the public notes array ref. -# If called with a single argument, it returns either 'public' or -# 'private' notes based on the passed string. -# -# If called with more than one argument, it sets the proper note field, with -# type being the first argument and the note value(s) as the remaining -# argument(s). -# -# It is also optional to pass in an array ref of note values as the third -# argument rather than a list. -# -sub notes { - my $self = shift; - my $type = shift; - my @notes = @_; - - if (!$type) { - $type = 'public'; - } elsif ($type ne 'public' && $type ne 'private') { - carp("Notes being applied without specifying type"); - unshift(@notes, $type); - $type = 'public'; - } - - if (ref($notes[0])) { - $self->{_mfhdh_NOTES}{$type} = $notes[0]; - $self->_replace_note_subfields($type, @{$notes[0]}); - } elsif (@notes) { - if ($notes[0]) { - $self->{_mfhdh_NOTES}{$type} = \@notes; - } else { - $self->{_mfhdh_NOTES}{$type} = []; - } - $self->_replace_note_subfields($type, @notes); - } - - return $self->{_mfhdh_NOTES}{$type}; -} - -# -# utility function for 'notes' method -# -sub _replace_note_subfields { - my $self = shift; - my $type = shift; - my @notes = @_; - my %note_subfield_ids = ('public' => 'z', 'private' => 'x'); - - $self->delete_subfield(code => $note_subfield_ids{$type}); - - foreach my $note (@notes) { - $self->add_subfields($note_subfield_ids{$type} => $note); - } -} - -# -# return a simple subfields list (for easier revivification from database) -# -sub subfields_list { - my $self = shift; - my @subfields; - - foreach my $subfield ($self->subfields) { - push(@subfields, $subfield->[0], $subfield->[1]); - } - return @subfields; -} - -# -# Called by method 'format_part' for formatting the chronology portion of -# the holding statement -# -sub format_chron { - my $self = shift; - my $holdings = shift; - my $caption = $self->caption; - my @keys = @_; - my $str = ''; - my %month = ( - '01' => 'Jan.', - '02' => 'Feb.', - '03' => 'Mar.', - '04' => 'Apr.', - '05' => 'May ', - '06' => 'Jun.', - '07' => 'Jul.', - '08' => 'Aug.', - '09' => 'Sep.', - '10' => 'Oct.', - '11' => 'Nov.', - '12' => 'Dec.', - '21' => 'Spring', - '22' => 'Summer', - '23' => 'Autumn', - '24' => 'Winter' - ); - - foreach my $i (0..@keys) { - my $key = $keys[$i]; - my $capstr; - my $chron; - my $sep; - - last if !defined $caption->capstr($key); - - $capstr = $caption->capstr($key); - if (substr($capstr, 0, 1) eq '(') { - # a caption enclosed in parentheses is not displayed - $capstr = ''; - } - - # If this is the second level of chronology, then it's - # likely to be a month or season, so we should use the - # string name rather than the number given. - if (($i == 1)) { - # account for possible combined issue chronology - my @chron_parts = split('/', $holdings->{$key}); - for (my $i = 0; $i < @chron_parts; $i++) { - $chron_parts[$i] = $month{$chron_parts[$i]} if exists $month{$chron_parts[$i]}; - } - $chron = join('/', @chron_parts); - } else { - $chron = $holdings->{$key}; - } - - $str .= (($i == 0 || $str =~ /[. ]$/) ? '' : ':') . $capstr . $chron; - } - - return $str; -} - -# -# Called by method 'format' for each member of a possibly compressed holding -# -sub format_part { - my $self = shift; - my $holding_values = shift; - my $caption = $self->caption; - my $str = ''; - - if ($caption->type_of_unit) { - $str = $caption->type_of_unit . ' '; - } - - if ($caption->enumeration_is_chronology) { - # if issues are identified by chronology only, then the - # chronology data is stored in the enumeration subfields, - # so format those fields as if they were chronological. - $str = $self->format_chron($holding_values, 'a'..'f'); - } else { - # OK, there is enumeration data and maybe chronology - # data as well, format both parts appropriately - - # Enumerations - foreach my $key ('a'..'f') { - my $capstr; - my $chron; - my $sep; - - last if !defined $caption->capstr($key); - - $capstr = $caption->capstr($key); - if (substr($capstr, 0, 1) eq '(') { - # a caption enclosed in parentheses is not displayed - $capstr = ''; - } - $str .= - ($key eq 'a' ? '' : ':') . $capstr . $holding_values->{$key}; - } - - # Chronology - if (defined $caption->capstr('i')) { - $str .= '('; - $str .= $self->format_chron($holding_values, 'i'..'l'); - $str .= ')'; - } - - if ($caption->capstr('g')) { - # There's at least one level of alternative enumeration - $str .= '='; - foreach my $key ('g', 'h') { - $str .= - ($key eq 'g' ? '' : ':') - . $caption->capstr($key) - . $holding_values->{$key}; - } - - # This assumes that alternative chronology is only ever - # provided if there is an alternative enumeration. - if ($caption->capstr('m')) { - # Alternative Chronology - $str .= '('; - $str .= $caption->capstr('m') . $holding_values->{'m'}; - $str .= ')'; - } - } - } - - # Breaks in the sequence - if (defined($self->{_mfhdh_BREAK})) { - if ($self->{_mfhdh_BREAK} eq 'n') { - $str .= ' non-gap break'; - } elsif ($self->{_mfhdh_BREAK} eq 'g') { - $str .= ' gap'; - } else { - warn "unrecognized break indicator '$self->{_mfhdh_BREAK}'"; - } - } - - return $str; -} - -# -# Create and return a string which conforms to display standard Z39.71 -# -sub format { - my $self = shift; - my $subfields = $self->fields; - my %holding_start; - my %holding_end; - my $formatted; - - foreach my $key (keys %$subfields) { - ($holding_start{$key}, $holding_end{$key}) = - @{$self->field_values($key)}; - } - - if ($self->is_compressed) { - # deal with open-ended statements - my $formatted_end; - if ($self->is_open_ended) { - $formatted_end = ''; - } else { - $formatted_end = $self->format_part(\%holding_end); - } - $formatted = - $self->format_part(\%holding_start) . ' - ' . $formatted_end; - } else { - $formatted = $self->format_part(\%holding_start); - } - - # Public Note - if (@{$self->notes}) { - $formatted .= ' -- ' . join(', ', @{$self->notes}); - } - - return $formatted; -} - -# next: Given a holding statement, return a hash containing the -# enumeration values for the next issues, whether we hold it or not -# Just pass through to Caption::next -# -sub next { - my $self = shift; - my $caption = $self->caption; - - return $caption->next($self); -} - -# -# matches($pat): check to see if $self matches the enumeration hashref passed -# in as $pat, as returned by the 'next' method. e.g.: -# $holding2->matches($holding1->next) # true if $holding2 directly follows -# $holding1 -# -# Always returns false if $self is compressed -# -sub matches { - my $self = shift; - my $pat = shift; - - return 0 if $self->is_compressed; - - foreach my $key ('a'..'f') { - # If a subfield exists in $self but not in $pat, or vice versa - # or if the field has different values, then fail - if ( - defined($self->field_values($key)) != exists($pat->{$key}) - || (exists $pat->{$key} - && ($self->field_values($key)->[0] ne $pat->{$key})) - ) { - return 0; - } - } - return 1; -} - -# -# Check that all the fields in a holdings statement are -# included in the corresponding caption. -# -sub validate { - my $self = shift; - - foreach my $key (keys %{$self->fields}) { - if (!$self->caption || !$self->caption->capfield($key)) { - return 0; - } - } - return 1; -} - -# -# Replace a single holding with it's next prediction -# and return itself -# -sub increment { - my $self = shift; - - if ($self->is_open_ended) { - carp "Holding is open-ended, cannot increment"; - return $self; - } elsif ($self->is_compressed) { - carp "Incrementing a compressed holding is deprecated, use extend instead"; - return $self->extend; - } - - my $next = $self->next(); - - foreach my $key (keys %{$next}) { - $self->fields->{$key}{HOLDINGS}[0] = $next->{$key}; - } - - $self->seqno($self->seqno + 1); - $self->update(%{$next}); # update underlying subfields - return $self; -} - -# -# Extends a holding (compressing if needed) to include the next -# prediction and returns itself -# -sub extend { - my $self = shift; - - if ($self->is_open_ended) { - carp "Holding is open-ended, cannot extend"; - return $self; - } - - my $next = $self->next(); - - if (!$self->is_compressed) { - $self->is_compressed(1); # add compressed state - } - - foreach my $key (keys %{$next}) { - my @values = @{$self->field_values($key)}; - $values[1] = $next->{$key}; - $self->fields->{$key}{HOLDINGS} = \@values; - $next->{$key} = join('-', @values); - } - - $self->update(%{$next}); # update underlying subfields - return $self; -} - -# -# Turns a compressed holding into the singular form of the first member -# in the range -# -sub compressed_to_first { - my $self = shift; - - if (!$self->is_compressed) { - carp "Holding not compressed, cannot convert to first member"; - return $self; - } - - my %changes; - foreach my $key (keys %{$self->fields}) { - my @values = @{$self->field_values($key)}; - $self->fields->{$key}{HOLDINGS} = [$values[0]]; - $changes{$key} = $values[0]; - } - - $self->update(%changes); # update underlying subfields - $self->is_compressed(0); # remove compressed state - - return $self; -} - -# -# Turns a compressed holding into the singular form of the last member -# in the range -# -sub compressed_to_last { - my $self = shift; - - if (!$self->is_compressed) { - carp "Holding not compressed, cannot convert to last member"; - return $self; - } elsif ($self->is_open_ended) { - carp "Holding is open-ended, cannot convert to last member"; - return $self; - } - - my %changes; - foreach my $key (keys %{$self->fields}) { - my @values = @{$self->field_values($key)}; - $self->fields->{$key}{HOLDINGS} = [$values[1]]; - $changes{$key} = $values[1]; - } - - $self->update(%changes); # update underlying subfields - $self->is_compressed(0); # remove compressed state - - return $self; -} - -# -# Basic, working, unoptimized clone operation -# -sub clone { - my $self = shift; - - my $clone_field = $self->SUPER::clone(); - return new MFHD::Holding($self->seqno, $clone_field, $self->caption); -} - -# -# Turn a chronology instance into date(s) in YYYY-MM-DD format -# -# In list context it returns a list of start and (possibly undefined) -# end dates -# -# In scalar context, it returns a YYYY-MM-DD date string of either the -# single date or the (possibly undefined) end date of a compressed holding -# -sub chron_to_date { - my $self = shift; - my $caption = $self->caption; - - my @keys; - if ($caption->enumeration_is_chronology) { - @keys = ('a'..'f'); - } else { - @keys = ('i'..'m'); - } - - # @chron_start and @chron_end will hold the (year, month, day) values - # represented by the start and optional end of the chronology instance. - # Default to January 1 with a year of 0 as initial values. - my @chron_start = (0, 1, 1); - my @chron_end = (0, 1, 1); - my @chrons = (\@chron_start, \@chron_end); - foreach my $key (@keys) { - my $capstr = $caption->capstr($key); - last if !defined($capstr); - if ($capstr =~ /year/) { - ($chron_start[0], $chron_end[0]) = @{$self->field_values($key)}; - } elsif ($capstr =~ /month/) { - ($chron_start[1], $chron_end[1]) = @{$self->field_values($key)}; - } elsif ($capstr =~ /day/) { - ($chron_start[2], $chron_end[2]) = @{$self->field_values($key)}; - } elsif ($capstr =~ /season/) { - # chrons defined as season-only will use the astronomical season - # dates as a basic estimate. - my @seasons = @{$self->field_values($key)}; - for (my $i = 0; $i < @seasons; $i++) { - $seasons[$i] = &_uncombine($seasons[$i], 0); - if ($seasons[$i] == 21) { - $chrons[$i]->[1] = 3; - $chrons[$i]->[2] = 20; - } elsif ($seasons[$i] == 22) { - $chrons[$i]->[1] = 6; - $chrons[$i]->[2] = 21; - } elsif ($seasons[$i] == 23) { - $chrons[$i]->[1] = 9; - $chrons[$i]->[2] = 22; - } elsif ($seasons[$i] == 24) { - $chrons[$i]->[1] = 12; - $chrons[$i]->[2] = 21; - } - } - } - } - - my @dates; - foreach my $chron (@chrons) { - my $date = undef; - if ($chron->[0] != 0) { - $date = - &_uncombine($chron->[0], 0) . '-' - . sprintf('%02d', $chron->[1]) . '-' - . sprintf('%02d', $chron->[2]); - } - push(@dates, $date); - } - - if (wantarray()) { - return @dates; - } elsif ($self->is_compressed) { - return $dates[1]; - } else { - return $dates[0]; - } -} - -# -# utility function for uncombining instance parts -# -sub _uncombine { - my ($combo, $pos) = @_; - - if (ref($combo)) { - carp("Function '_uncombine' is not an instance method"); - return; - } - - my @parts = split('/', $combo); - return $parts[$pos]; -} - -# -# Overload string comparison operators -# -# We are not overloading '<=>' because '==' is used liberally in MARC::Record -# to compare field identity (i.e. is this the same exact Field object?), not value -# -# Other string operators are auto-generated from 'cmp' -# -# Please note that this comparison is based on what the holding represents, -# not whether it is strictly identical (e.g. the seqno and link may vary) -# -use overload ('cmp' => \&_compare, - 'fallback' => 1); -sub _compare { - my ($holding_1, $holding_2) = @_; - - # TODO: this needs some more consideration - # fall back to 'built-in' comparison - if (!UNIVERSAL::isa($holding_2, ref $holding_1)) { - if (defined $holding_2) { - carp("Use of non-holding in holding comparison operation"); - return ( "$holding_1" cmp "$holding_2" ); - } else { - carp("Use of undefined value in holding comparison operation"); - return 1; # similar to built-in, something is "greater than" nothing - } - } - - # special cases for compressed holdings - my ($holding_1_first, $holding_1_last, $holding_2_first, $holding_2_last, $found_compressed); - # 0 for no compressed, 1 for first compressed, 2 for second compressed, 3 for both compressed - $found_compressed = 0; - if ($holding_1->is_compressed) { - $holding_1_last = $holding_1->clone->compressed_to_last; - $found_compressed += 1; - } else { - $holding_1_first = $holding_1; - $holding_1_last = $holding_1; - } - if ($holding_2->is_compressed) { - $holding_2_first = $holding_2->clone->compressed_to_first; - $found_compressed += 2; - } else { - $holding_2_first = $holding_2; - $holding_2_last = $holding_2; - } - - if ($found_compressed) { - my $cmp = ($holding_1_last cmp $holding_2_first); # 1 ends before 2 starts - if ($cmp == -1) { - return -1; # 1 is fully lt - } elsif ($cmp == 0) { - carp("Overlapping holdings in comparison, lt and gt based on start value only"); - return -1; - } else { # check the opposite, 2 ends before 1 starts - # clone is expensive, wait until we need it (here) - if (!defined($holding_2_last)) { - $holding_2_last = $holding_2->clone->compressed_to_last; - } - if (!defined($holding_1_first)) { - $holding_1_first = $holding_1->clone->compressed_to_first; - } - $cmp = ($holding_2_last cmp $holding_1_first); - if ($cmp == -1) { - return 1; # 1 is fully gt - } elsif ($cmp == 0) { - carp("Overlapping holdings in comparison, lt and gt based on start value only"); - return 1; - } else { - $cmp = ($holding_1_first cmp $holding_2_first); - if (!$cmp) { # they are not equal - carp("Overlapping holdings in comparison, lt and gt based on start value only"); - return $cmp; - } elsif ($found_compressed == 1) { - carp("Compressed holding found with start equal to non-compressed holding"); - return 1; # compressed (first holding) is 'greater than' non-compressed - } elsif ($found_compressed == 2) { - carp("Compressed holding found with start equal to non-compressed holding"); - return -1; # compressed (second holding) is 'greater than' non-compressed - } else { # both holdings compressed, check for full equality - $cmp = ($holding_1_last cmp $holding_2_last); - if (!$cmp) { # they are not equal - carp("Compressed holdings in comparison have equal starts, lt and gt based on end value only"); - return $cmp; - } else { - return 0; # both are compressed, both ends are equal - } - } - } - } - } - - # start doing the actual comparison - my $result; - foreach my $key ('a'..'f') { - if (defined($holding_1->field_values($key))) { - if (!defined($holding_2->field_values($key))) { - return 1; # more details equals 'greater' (?) - } else { - $result = $holding_1->field_values($key)->[0] <=> $holding_2->field_values($key)->[0]; - } - } elsif (defined($holding_2->field_values($key))) { - return -1; # more details equals 'greater' (?) - } - - return $result if $result; - } - - # got through, return 0 for equal - return 0; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/Makefile b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/Makefile deleted file mode 100644 index 47f47e6507..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/Makefile +++ /dev/null @@ -1,2 +0,0 @@ -test: - perl -I../../../.. mfhd.t diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhd.t b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhd.t deleted file mode 100644 index 35d86cdecf..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhd.t +++ /dev/null @@ -1,60 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; -use Data::Dumper; -use Test::More 'no_plan'; - -use MARC::Record; -use OpenILS::Utils::MFHD; - -use testlib; - -my $testno = 1; - -sub right_answer { - my $holding = shift; - my $answer = {}; - - foreach my $subfield (split(/\|/, $holding->subfield('x'))) { - next unless $subfield; - - my ($key, $val) = unpack('aa*', $subfield); - $answer->{$key} = $val; - } - - return $answer; -} - - -my $rec; -my @captions; - -open(my $testdata, "new($rec); - - foreach my $cap (sort { $a->tag <=> $b->tag } $rec->field('85.')) { - my $htag; - my @holdings; - - ($htag = $cap->tag) =~ s/^85/86/; - @holdings = $rec->holdings($htag, $cap->subfield('8')); - - if (!ok(scalar @holdings, "holdings defined " . $cap->subfield('8'))) { - next; - } - - foreach my $field (@holdings) { - TODO: { - local $TODO = "unimplemented" - if ($field->subfield('z') =~ /^TODO/); - is_deeply($field->next, right_answer($field), - $field->subfield('8') . ': ' . $field->subfield('z')); - } - } - } -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhddata.txt b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhddata.txt deleted file mode 100644 index e3b4e1e942..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhddata.txt +++ /dev/null @@ -1,166 +0,0 @@ -245 00 $aMonthly, issue no. restarts, calendar change: Jan -853 20 $81$av.$bno.$u12$vr$i(year)$j(month)$wm$x01 -863 41 $81.1$a1$b6$i1990$j06$x|a1|b7|i1990|j07$zMiddle of year, middle of vol. -863 41 $81.2$a1$b11$i1990$j11$x|a1|b12|i1990|j12$zEnd of year, end of vol. -863 41 $81.3$a1$b12$i1990$j12$x|a2|b1|i1991|j01$zWrap at end of year/vol. - -245 00 $aMonthly, issue no. restarts, calendar change: Mar -853 20 $82$av.$bno.$u12$vr$i(year)$j(month)$wm$x03 -863 41 $82.1$a1$b6$i1990$j08$x|a1|b7|i1990|j09$zMiddle of year, middle of vol. -863 41 $82.2$a1$b10$i1990$j12$x|a1|b11|i1991|j01$zEnd of year, middle of vol. -863 41 $82.3$a1$b11$i1991$j01$x|a1|b12|i1991|j02$zMiddle of year, end of vol. -863 41 $82.3$a1$b12$i1991$j02$x|a2|b1|i1991|j03$zWrap vol in mid-year - -245 00 $aMonthly, issue no. continuous, calendar change: Jan -853 20 $83$av.$bno.$u12$vc$i(year)$j(month)$wm$x01 -863 41 $83.1$a1$b6$i1990$j06$x|a1|b7|i1990|j07$zMiddle of year, middle of vol. -863 41 $83.2$a1$b11$i1990$j11$x|a1|b12|i1990|j12$zEnd of year, end of vol. -863 41 $83.3$a1$b12$i1990$j12$x|a2|b13|i1991|j01$zwrap vol @ end of year - -245 00 $aMonthly, issue no. continuous, calendar change: Mar -853 20 $84$av.$bno.$u12$vc$i(year)$j(month)$wm$x03 -863 41 $84.1$a1$b6$i1990$j08$x|a1|b7|i1990|j09$zMiddle of year, middle of vol. -863 41 $84.2$a1$b10$i1990$j12$x|a1|b11|i1991|j01$zEnd of year, middle of vol. -863 41 $84.3$a1$b11$i1991$j01$x|a1|b12|i1991|j02$zMiddle of year, end of vol. -863 41 $84.4$a1$b12$i1991$j02$x|a2|b13|i1991|j03$zwrap vol mid-year - -245 00 $aMonthly, issue no. restarts, Calendar change: Jan, Jul -853 20 $85$av.$bno.$u6$vr$i(year)$j(month)$wm$x01,07 -863 41 $85.1$a1$b5$i1990$j05$x|a1|b6|i1990|j06$zMiddle of year, near end of vol. -863 41 $85.2$a1$b6$i1990$j06$x|a2|b1|i1990|j07$zMiddle of year, end of vol. -863 41 $85.3$a2$b6$i1990$j12$x|a3|b1|i1991|j01$zEnd of year, end of vol. - -245 00 $aMonthly, issue no. continuous, Calendar change: Jan, Jul -853 20 $86$av.$bno.$u6$vc$i(year)$j(month)$wm$x01,07 -863 41 $86.1$a1$b5$i1990$j05$x|a1|b6|i1990|j06$zMiddle of year, end of vol. -863 41 $86.2$a1$b6$i1990$j06$x|a2|b7|i1990|j07$zMiddle of year, end of vol. -863 41 $86.3$a2$b12$i1990$j12$x|a3|b13|i1991|j01$zEnd of year, end of vol. - -245 00 $aMonthly, issue no. restarts, Calendar change: Jan, Combined issue: Jan/Feb -853 20 $87$av.$bno.$u11$vr$i(year)$j(month)$wm$x01$ycm01/02 -863 41 $87.1$a1$b11$i1990$j12$x|a2|b1|i1991|j01/02$z End of year, end of vol. -863 41 $87.2$a2$b1$i1991$j01/02$x|a2|b2|i1991|j03$z Beginning of year, beginning of vol. - -245 00 $aMonthly, iss no. restarts, Calendar change: Jan, Combined iss: Nov/Dec -853 20 $88$av.$bno.$u11$vr$i(year)$j(month)$wm$x01$ycm11/12 -863 41 $88.1$a1$b10$i1990$j10$x|a1|b11|i1990|j11/12$z end of year, end of vol. -863 41 $88.2$a1$b11$i1990$j11/12$x|a2|b1|i1991|j01$z wrap vol at year end - -245 00 $aMonthly, iss no. restarts, Cal. change: Jan, Combined iss: Jan/Feb, Nov/Dec -853 20 $89$av.$bno.$u10$vr$i(year)$j(month)$wm$x01$ycm01/02,11/12 -863 41 $89.1$a1$b1$i1990$j01/02$x|a1|b2|i1990|j03$z beg. of year, beg. of vol. -863 41 $89.2$a1$b9$i1990$j10$x|a1|b10|i1990|j11/12$z end of year, end of vol. -863 41 $89.3$a1$b10$i1990$j11/12$x|a2|b1|i1991|j01/02$z zwrap vol at year end - -245 00 $aMonthly, iss no. restarts, Cal. change: Jan, Combined iss: May/Jun, Jul/Aug -853 20 $810$av.$bno.$u10$vr$i(year)$j(month)$wm$x01$ycm05/06,07/08 -863 41 $810.1$a1$b4$i1990$j04$x|a1|b5|i1990|j05/06$z next iss is combined. -863 41 $810.2$a1$b5$i1990$j05/06$x|a1|b6|i1990|j07/08$z combined to combined -863 41 $810.3$a1$b6$i1990$j07/08$x|a1|b7|i1990|j09$z combined to reg - -245 00 $aMonthly, issue no. restarts, Calendar change: Jan, Combined issue: 1/2 Jan/Feb -853 20 $811$av.$bno.$u12$vr$i(year)$j(month)$wm$x01$ycm01/02$yce21/2 -863 41 $811.1$a1$b12$i1990$j12$x|a2|b1/2|i1991|j01/02$znew vol at year end regular iss to combined -863 41 $811.2$a2$b1/2$i1991$j01/02$x|a2|b3|i1991|j03$zcombined iss to regular - -245 00 $aMonthly, iss no. restarts, Calendar change: Jan, Combined iss: 11/12 Nov/Dec -853 20 $812$av.$bno.$u12$vr$i(year)$j(month)$wm$x01$ycm11/12$yce211/12 -863 41 $812.1$a1$b10$i1990$j10$x|a1|b11/12|i1990|j11/12$zregular to combined iss -863 41 $812.2$a1$b11/12$i1990$j11/12$x|a2|b1|i1991|j01$zend of vol: combined to regular issue - -245 00 $aMonthly, iss no. restarts, Cal. change: Jan, Combined iss: 1/2 Jan/Feb, 11/12 Nov/Dec -853 20 $813$av.$bno.$u12$vr$i(year)$j(month)$wm$x01$ycm01/02,11/12$yce21/2,11/12 -863 41 $813.1$a1$b10$i1990$j10$x|a1|b11/12|i1990|j11/12$zend of vol regular to combined iss -863 41 $813.2$a1$b11/12$i1990$j11/12$x|a2|b1/2|i1991|j01/02$zwrap at volume end: combined to combined -863 41 $813.3$a2$b1/2$i1991$j01/02$x|a2|b3|i1991|j03$zbeginning of vol: combined to regular - -245 00 $aMonthly, iss no. restarts, Cal. change: Jan, Combined iss: 5/6 May/Jun, 7/8 Jul/Aug -853 20 $814$av.$bno.$u12$vr$i(year)$j(month)$wm$x01$ycm05/06,07/08$yce25/6,7/8 -863 41 $814.1$a1$b4$i1990$j04$x|a1|b5/6|i1990|j05/06$zmid year: reg to combined -863 41 $814.2$a1$b5/6$i1990$j05/06$x|a1|b7/8|i1990|j07/08$zmid year: combined to combined -863 41 $814.3$a1$b7/8$i1990$j07/08$x|a1|b9|i1990|j09$zmid year: combined to regular - -245 00 $aMonthly, iss no. restarts, Cal change: Jan, July issue omitted -853 20 $815$av.$bno.$u11$vr$i(year)$j(month)$wm$x01$yom07 -863 41 $815.1$a1$b6$i1990$j06$x|a1|b7|i1990|j08$zskip july issue - -245 00 $aQuarterly, chronology in enumeration fields -853 20 $816$a(year)$b(season)$wq$yps21,22,23,24 -863 41 $816.1$a2007$b21$x|a2007|b22$zChron in enum: simple case: quarterly in mid-volume -863 41 $816.2$a2007$b24$x|a2008|b21$zChron in enum: Roll over to new year - -245 00 $aFour issues a year, chronology in enum fields, combined Sum/Fall issue -853 20 $817$a(year)$b(season)$wq$ycs22/23 -863 41 $817.1$a2007$b21$x|a2007|b22/23$zChron in enum: Spring to Summer/Fall -863 41 $817.2$a2007$b22/23$x|a2007|b24$zChron in enum: Summer/Fall to Winter - -245 00 $aLibrary Journal: 20 times a year, semimonthly except Jan, Jul, Aug, Dec -853 20 $818$av.$bno.$u20$vr$i(year)$j(month)$k(day)$ws$x01$ypd01,15$yod0115,0715,0815,1215 -863 41 $818.1$a132$b20$i2007$j12$k1$x|a133|b1|i2008|j01|k01$zSkipping over missed date to beginning of next year/volume. -863 41 $818.2$a133$b1$i2008$j01$k01$x|a133|b2|i2008|j02|k01$zSkipping over missed date at beginning of year -863 41 $818.3$a133$b2$i2008$j02$k01$x|a133|b3|i2008|j02|k15$zPublished semimonthly, going from 1st to 15th -863 41 $818.4$a133$b3$i2008$j02$k15$x|a133|b4|i2008|j03|k01$zPublished semimonthly, going from 15th to 1st - -245 00 $aBimonthly: Feb, Apr, June, Aug, Oct, Dec -853 20 $819$av.$bno.$u6$vr$i(year)$j(month)$wb$x02$ypm02,04,06,08,10,12 -863 41 $819.1$a1$b3$i1990$j06$x|a1|b4|i1990|j08$zMiddle of year, middle of vol. -863 41 $819.2$a1$b5$i1990$j10$x|a1|b6|i1990|j12$zEnd of year, end of vol. -863 41 $819.3$a1$b6$i1990$j12$x|a2|b1|i1991|j02$zWrap at end of year/vol. - -245 00 $aBimonthly, published 5 times with combined summer issue: Feb, Apr, June/Aug, Oct, Dec -853 20 $820$av.$bno.$u5$vr$i(year)$j(month)$wb$x02$ypm02,04,10,12$ycm06/08 -863 41 $820.1$a1$b2$i1990$j04$x|a1|b3|i1990|j06/08$zFrom Apr to Jun/Aug -863 41 $820.2$a1$b3$i1990$j06/08$x|a1|b4|i1990|j10$zFrom Jun/Aug to Oct -863 41 $820.3$a1$b5$i1990$j12$x|a2|b1|i1991|j02$zWrap at end of year/vol. - -245 00 $aEconomist: pub. w on Sa, except combined iss on last two weeks of year -853 20 $821$av.$bno.$u12$vc$i(year)$j(month)$k(day)$ww$x01,04,07,10$ypdsa$yow1299 -863 41 $821.1$a100$b1200$i2008$j12$k06$x|a100|b1201|i2008|j12|k13$zwithin vol. -863 41 $821.2$a100$b1201$i2008$j12$k13$x|a100|b1202|i2008|j12|k20$zwithin vol. combined iss. -863 41 $821.3$a100$b1202$i2008$j12$k20$x|a101|b1203|i2009|j01|k03$zvolume change over omitted iss. - -245 00 $aMFHD example: monthly, pub. 2nd Wed of month except in April: 2nd Thu; May:1st Wednesday. -853 20 $822$av.$bno.$u12$vr$i(year)$j(month)$k(day)$wm$x01$ypw02we$ypw0402th,0501we$yow0402we,0502we -863 41 $822.1$a1$b2$i2009$j02$k11$x|a1|b3|i2009|j03|k11$zpublished on 2nd Wed in Mar -863 41 $822.2$a1$b3$i2009$j03$k11$x|a1|b4|i2009|j04|k09$zpublished on 2nd Thu in Apr -863 41 $822.3$a1$b4$i2009$j04$k09$x|a1|b5|i2009|j05|k06$zpublished on 1st Wed in May -863 41 $822.4$a2$b4$i2013$j04$k11$x|a2|b5|i2013|j05|k01$zpublished on Wed May 1st - -245 00 $aMFHD example: pub. every Mon, Thu, except on New Years, July 4, Labor Day, Thanksgiving, Christmas -853 20 $823$av.$bno.$uvar$vr$i(year)$j(month)$k(day)$wc$x07$ypw00mo,00th$yod0101,0704,1225$yow0901mo,1104th -863 41 $823.1$a1$b100$i2009$j02$k02$x|a1|b101|i2009|j02|k05$znormal: Mon to Thu -863 41 $823.2$a1$b101$i2009$j02$k05$x|a1|b102|i2009|j02|k09$znormal: Thu to Mon -863 41 $823.3$a1$b150$i2009$j06$k29$x|a2|b151|i2009|j07|k02$znormal: calendar change -863 41 $823.4$a2$b180$i2009$j09$k03$x|a2|b181|i2009|j09|k10$zSkip Labor Day -863 41 $823.5$a2$b200$i2009$j11$k23$x|a2|b201|i2009|j11|k30$zSkip (US) Thanksgiving - -# -# According to the specification and the examples at -# http://www.loc.gov/marc/chrono_patterns.html it is possible to -# document a combined issue in a $yp publication regularity definition, -# like this: $yps21,22/23,24 -245 00 $aCombined date documented in publication pattern rather than combined pattern -853 20 $824$av.$bno.$u3$vr$i(year)$j(season)$wq$x21$yps21,22/23,24 -863 41 $824.1$a1$b1$i2009$j21$x|a1|b2|i2009|j22/23$zSpring to Summer/Fall -863 41 $824.2$a1$b2$i2009$j22/23$x|a1|b3|i2009|j24$zSummer/Fall to Winter - -# Item is published 6 times/year whose enumeration "skips" numbers -# at the second level using only odd numbers that restart -# at the turn of the calendar year. -# (From www.loc.gov/marc/chrono_patterns.html) -245 00 $aFunky enumeration -853 20 $825$av.$bno.$u6$vr$i(year)$j(month)$wb$ype21,3,5,7,9,11 -863 41 $825.1$a1$b1$i1990$j01$x|a1|b3|i1990|j03$zJan to Mar -863 41 $825.2$a1$b11$i1990$j11$x|a2|b1|i1991|j01$zNov to Jan, year & vol wrap - - -# Monthly, one volume per year, issue numbering restarts in January -# Annual supplement published in September, annual index published in -# February -245 00 $aSupplements and Indexes: Oh My -853 20 $826$av.$bno.$u12$vr$i(year)$j(month)$wm -854 20 $827$av.$i(year)$j(month)$wa$ypm09$oSupplement -855 20 $828$av.$i(year)$j(month)$ypm02$oIndex -863 41 $826.1$a1$b1$i1990$j01$x|a1|b2|i1990|j02$znormal issue -864 41 $827.1$a1$i1990$j09$x|a2|i1991|j09$zAnnual supplement -865 41 $828.1$a1$i1990$j02$x|a2|i1991|j02$zAnnual Index diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/testlib.pm b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/testlib.pm deleted file mode 100644 index 9953a569d1..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/testlib.pm +++ /dev/null @@ -1,69 +0,0 @@ -package testlib; - -use strict; -use warnings; - -use base 'Exporter'; - -our @EXPORT_OK = qw(load_MARC_rec); - -use Data::Dumper; - -use MARC::Record; - -sub load_MARC_rec { - my $fh = shift; - my $testno = shift; - my $rec; - my $line; - my $marc = undef; - - # skim to beginning of record (a non-blank, non comment line) - while ($line = <$fh>) { - chomp $line; - last if (!($line =~ /^\s*$/) && !($line =~ /^#/)); - } - - return undef if !$line; - - $marc = MARC::Record->new(); - carp('No record created!') unless $marc; - - $marc->leader('01119nas 22003134a 4500'); - $marc->append_fields( - MARC::Field->new('008', '970701c18439999enkwr p 0 a0eng ')); - $marc->append_fields( - MARC::Field->new('035', '', '', a => sprintf('%04d', $testno))); - - while ($line) { - next if $line =~ /^#/; # allow embedded comments - - return $marc if $line =~ /^\s*$/; - - my ($fieldno, $indicators, $rest) = split(/ /, $line, 3); - my @inds = unpack('aa', $indicators); - my $field; - my @subfields; - - @subfields = (); - foreach my $subfield (split(/\$/, $rest)) { - next unless $subfield; - - my ($key, $val) = unpack('aa*', $subfield); - push @subfields, $key, $val; - } - - $field = MARC::Field->new( - $fieldno, $inds[0], $inds[1], - @subfields - ); - - $marc->append_fields($field); - - $line = <$fh>; - chomp $line if $line; - } - return $marc; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHDParser.pm b/Open-ILS/src/perlmods/OpenILS/Utils/MFHDParser.pm deleted file mode 100644 index 7a191dd3e0..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHDParser.pm +++ /dev/null @@ -1,306 +0,0 @@ -package OpenILS::Utils::MFHDParser; -use strict; -use warnings; - -use OpenSRF::EX qw/:try/; -use Time::HiRes qw(time); -use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::SettingsClient; -use OpenSRF::Utils::Logger qw/$logger/; - -use OpenILS::Utils::MFHD; -use MARC::File::XML (BinaryEncoding => 'utf8'); -use Data::Dumper; - -sub new { return bless({}, shift()); } - -=head1 Subroutines - -=over - -=item * format_textual_holdings($field) - -=back - -Returns concatenated subfields $a with $z for textual holdings (866-868) - -=cut - -sub format_textual_holdings { - my ($self, $field) = @_; - my $holdings; - my $public_note; - - $holdings = $field->subfield('a'); - if (!$holdings) { - return undef; - } - - $public_note = $field->subfield('z'); - if ($public_note) { - return "$holdings -- $public_note"; - } - return $holdings; -} - -=over - -=item * mfhd_to_hash($mfhd_xml) - -=back - -Returns a Perl hash containing fields of interest from the MFHD record - -=cut - -sub mfhd_to_hash { - my ($self, $mfhd_xml) = @_; - - my $marc; - my $mfhd; - - my $location = ''; - my $basic_holdings = []; - my $supplement_holdings = []; - my $index_holdings = []; - my $basic_holdings_add = []; - my $supplement_holdings_add = []; - my $index_holdings_add = []; - my $online = []; # Laurentian extension to MFHD standard - my $missing = []; # Laurentian extension to MFHD standard - my $incomplete = []; # Laurentian extension to MFHD standard - - try { - $marc = MARC::Record->new_from_xml($mfhd_xml); - } - otherwise { - $logger->error("Failed to convert MFHD XML to MARC: " . shift()); - $logger->error("Failed MFHD XML: $mfhd_xml"); - }; - - if (!$marc) { - return undef; - } - - try { - $mfhd = MFHD->new($marc); - } - otherwise { - $logger->error("Failed to parse MFHD: " . shift()); - $logger->error("Failed MFHD XML: $mfhd_xml"); - }; - - if (!$mfhd) { - return undef; - } - - try { - foreach my $field ($marc->field('852')) { - foreach my $subfield_ref ($field->subfields) { - my ($subfield, $data) = @$subfield_ref; - $location .= $data . " -- "; - } - } - } - otherwise { - $logger->error("MFHD location parsing error: " . shift()); - }; - - $location =~ s/ -- $//; - - # TODO: for now, we will assume that textual holdings are in addition to the - # computable holdings (that is, they have link IDs greater than the 85X fields) - # or that they fully replace the computable holdings (checking for link ID '0'). - # Eventually this may be handled better by format_holdings() in MFHD.pm - my %skip_computable; - try { - foreach my $field ($marc->field('866')) { - my $textual_holdings = $self->format_textual_holdings($field); - if ($textual_holdings) { - push @$basic_holdings_add, $textual_holdings; - if ($field->subfield('8') eq '0') { - $skip_computable{'basic'} = 1; # link ID 0 trumps computable fields - } - } - } - foreach my $field ($marc->field('867')) { - my $textual_holdings = $self->format_textual_holdings($field); - if ($textual_holdings) { - push @$supplement_holdings_add, $textual_holdings; - if ($field->subfield('8') eq '0') { - $skip_computable{'supplement'} = 1; # link ID 0 trumps computable fields - } - } - } - foreach my $field ($marc->field('868')) { - my $textual_holdings = $self->format_textual_holdings($field); - if ($textual_holdings) { - push @$index_holdings_add, $textual_holdings; - if ($field->subfield('8') eq '0') { - $skip_computable{'index'} = 1; # link ID 0 trumps computable fields - } - } - } - - if (!exists($skip_computable{'basic'})) { - foreach my $cap_id ($mfhd->caption_link_ids('853')) { - my @holdings = $mfhd->holdings('863', $cap_id); - next unless scalar @holdings; - foreach (@holdings) { - push @$basic_holdings, $_->format(); - } - } - if (!@$basic_holdings) { # no computed holdings found - $basic_holdings = $basic_holdings_add; - $basic_holdings_add = []; - } - } else { # textual are non additional, but primary - $basic_holdings = $basic_holdings_add; - $basic_holdings_add = []; - } - - if (!exists($skip_computable{'supplement'})) { - foreach my $cap_id ($mfhd->caption_link_ids('854')) { - my @supplements = $mfhd->holdings('864', $cap_id); - next unless scalar @supplements; - foreach (@supplements) { - push @$supplement_holdings, $_->format(); - } - } - if (!@$supplement_holdings) { # no computed holdings found - $supplement_holdings = $supplement_holdings_add; - $supplement_holdings_add = []; - } - } else { # textual are non additional, but primary - $supplement_holdings = $supplement_holdings_add; - $supplement_holdings_add = []; - } - - if (!exists($skip_computable{'index'})) { - foreach my $cap_id ($mfhd->caption_link_ids('855')) { - my @indexes = $mfhd->holdings('865', $cap_id); - next unless scalar @indexes; - foreach (@indexes) { - push @$index_holdings, $_->format(); - } - } - if (!@$index_holdings) { # no computed holdings found - $index_holdings = $index_holdings_add; - $index_holdings_add = []; - } - } else { # textual are non additional, but primary - $index_holdings = $index_holdings_add; - $index_holdings_add = []; - } - - # Laurentian extensions - foreach my $field ($marc->field('530')) { - my $online_stmt = $self->format_textual_holdings($field); - if ($online_stmt) { - push @$online, $online_stmt; - } - } - - foreach my $field ($marc->field('590')) { - my $missing_stmt = $self->format_textual_holdings($field); - if ($missing_stmt) { - push @$missing, $missing_stmt; - } - } - - foreach my $field ($marc->field('591')) { - my $incomplete_stmt = $self->format_textual_holdings($field); - if ($incomplete_stmt) { - push @$incomplete, $incomplete_stmt; - } - } - } - otherwise { - $logger->error("MFHD statement parsing error: " . shift()); - }; - - return { - location => $location, - basic_holdings => $basic_holdings, - basic_holdings_add => $basic_holdings_add, - supplement_holdings => $supplement_holdings, - supplement_holdings_add => $supplement_holdings_add, - index_holdings => $index_holdings, - index_holdings_add => $index_holdings_add, - missing => $missing, - incomplete => $incomplete, - online => $online - }; -} - -=over - -=item * init_holdings_virtual_record() - -=back - -Initialize the serial virtual record (svr) instance - -=cut - -sub init_holdings_virtual_record { - my $record = Fieldmapper::serial::virtual_record->new; - $record->sre_id(); - $record->location(); - $record->owning_lib(); - $record->basic_holdings([]); - $record->basic_holdings_add([]); - $record->supplement_holdings([]); - $record->supplement_holdings_add([]); - $record->index_holdings([]); - $record->index_holdings_add([]); - $record->online([]); - $record->missing([]); - $record->incomplete([]); - return $record; -} - -=over - -=item * init_holdings_virtual_record($mfhd) - -=back - -Given an MFHD record, return a populated svr instance - -=cut - -sub generate_svr { - my ($self, $id, $mfhd, $owning_lib) = @_; - - if (!$mfhd) { - return undef; - } - - my $record = init_holdings_virtual_record(); - my $holdings = $self->mfhd_to_hash($mfhd); - - $record->sre_id($id); - $record->owning_lib($owning_lib); - - if (!$holdings) { - return $record; - } - - $record->location($holdings->{location}); - $record->basic_holdings($holdings->{basic_holdings}); - $record->basic_holdings_add($holdings->{basic_holdings_add}); - $record->supplement_holdings($holdings->{supplement_holdings}); - $record->supplement_holdings_add($holdings->{supplement_holdings_add}); - $record->index_holdings($holdings->{index_holdings}); - $record->index_holdings_add($holdings->{index_holdings_add}); - $record->online($holdings->{online}); - $record->missing($holdings->{missing}); - $record->incomplete($holdings->{incomplete}); - - return $record; -} - -1; - -# vim: ts=4:sw=4:noet diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/ModsParser.pm b/Open-ILS/src/perlmods/OpenILS/Utils/ModsParser.pm deleted file mode 100644 index d77d07d579..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/ModsParser.pm +++ /dev/null @@ -1,478 +0,0 @@ -package OpenILS::Utils::ModsParser; -use strict; use warnings; - -use OpenSRF::EX qw/:try/; -use XML::LibXML; -use XML::LibXSLT; -use Time::HiRes qw(time); -use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::SettingsClient; -use OpenSRF::Utils::Logger qw/$logger/; -use Data::Dumper; - -my $parser = XML::LibXML->new(); -my $xslt = XML::LibXSLT->new(); -my $mods_sheet; - -# ---------------------------------------------------------------------------------------- -# XPATH for extracting info from a MODS doc -my $isbn_xpath = "//mods:mods/mods:identifier[\@type='isbn']"; -my $resource_xpath = "//mods:mods/mods:typeOfResource"; -my $pub_xpath = "//mods:mods/mods:originInfo//mods:dateIssued[\@encoding='marc']|" . - "//mods:mods/mods:originInfo//mods:dateIssued[1]"; -my $tcn_xpath = "//mods:mods/mods:recordInfo/mods:recordIdentifier"; -my $publisher_xpath = "//mods:mods/mods:originInfo//mods:publisher[1]"; -my $edition_xpath = "//mods:mods/mods:originInfo//mods:edition[1]"; -my $abstract_xpath = "//mods:mods/mods:abstract"; -my $related_xpath = ""; -my $online_loc_xpath = "//mods:location/mods:url"; -my $physical_desc = "(//mods:mods/mods:physicalDescription/mods:form|//mods:mods/mods:physicalDescription/mods:extent|". - "//mods:mods/mods:physicalDescription/mods:reformattingQuality|//mods:mods/mods:physicalDescription/mods:internetMediaType|". - "//mods:mods/mods:physicalDescription/mods:digitalOrigin)"; -my $toc_xpath = "//mods:tableOfContents"; - -my $xpathset = { - - title => { - abbreviated => - "//mods:mods/mods:titleInfo[mods:title and (\@type='abbreviated')]", - translated => - "//mods:mods/mods:titleInfo[mods:title and (\@type='translated')]", - uniform => - "//mods:mods/mods:titleInfo[mods:title and (\@type='uniform')]", - proper => - "//mods:mods/mods:titleInfo[mods:title and not (\@type)]", - any => - "//mods:mods/mods:titleInfo", - }, - - author => { - corporate => - "//mods:mods/mods:name[\@type='corporate']/*[local-name()='namePart']". - "[../mods:role/mods:text[text()='creator']". - " or ../mods:role/mods:roleTerm[". - " \@type='text'". - " and \@authority='marcrelator'". - " and text()='creator']". - "][1]", - personal => - "//mods:mods/mods:name[\@type='personal']/*[local-name()='namePart']". - "[../mods:role/mods:text[text()='creator']". - " or ../mods:role/mods:roleTerm[". - " \@type='text'". - " and \@authority='marcrelator'". - " and text()='creator']". - "][1]", - conference => - "//mods:mods/mods:name[\@type='conference']/*[local-name()='namePart']". - "[../mods:role/mods:text[text()='creator']". - " or ../mods:role/mods:roleTerm[". - " \@type='text'". - " and \@authority='marcrelator'". - " and text()='creator']". - "][1]", - other => - "//mods:mods/mods:name[\@type='personal']/*[local-name()='namePart']", - any => - "//mods:mods/mods:name/*[local-name()='namePart'][1]", - }, - - subject => { - - topic => - "//mods:mods/mods:subject/*[". - " local-name()='geographic'". - " or local-name()='name'". - " or local-name()='temporal'". - " or local-name()='topic'". - "]/parent::mods:subject", - -# geographic => -# "//mods:mods/*[local-name()='subject']/*[local-name()='geographic']", -# name => -# "//mods:mods/*[local-name()='subject']/*[local-name()='name']", -# temporal => -# "//mods:mods/*[local-name()='subject']/*[local-name()='temporal']", -# topic => -# "//mods:mods/*[local-name()='subject']/*[local-name()='topic']", - }, - #keyword => { keyword => "//mods:mods/*[not(local-name()='originInfo')]", }, - - series => { - series => "//mods:mods/mods:relatedItem[\@type='series']/mods:titleInfo" - } -}; -# ---------------------------------------------------------------------------------------- - - - -sub new { return bless( {}, shift() ); } - -sub get_field_value { - - my( $self, $mods, $xpath, $type) = @_; - - my @string; - - my $root = $mods->documentElement; - $root->setNamespace( "http://www.loc.gov/mods/v3", "mods", 1 ); - - try { - # grab the set of matching nodes - my @nodes = $root->findnodes( $xpath ); - for my $value (@nodes) { - - # grab all children of the node - my @children = $value->childNodes(); - my @child_text; - for my $child (@children) { - # MODS strips the punctuation from 245abc, which often - # results in "title subtitle" rather than "title : subtitle"; - # this hack gets it back for us - if ($type && $type eq 'title' && $child->nodeName =~ m/subTitle/) { - push(@child_text, " : "); - } - next unless( $child->nodeType != 3 ); - - if($child->childNodes) { - my @a; - for my $c (@{$child->childNodes}){ - push @a, $c->textContent; - } - push(@child_text, join(' ', @a)); - - } else { - push(@child_text, $child->textContent); - } - - } - if(@child_text) { - push(@string, \@child_text); - } - - if( !@child_text ) { - push(@string, $value->textContent ); - } - } - } otherwise { - $logger->info("MODS-izing failure: ".shift()); - $logger->info("Failed MODS xml: ".$root->toString); - $logger->info("Failed MODS xpath: $xpath"); - }; - return @string; -} - -=head -sub _modsdoc_to_values { - my( $self, $mods ) = @_; - my $data = {}; - for my $class (keys %$xpathset) { - $data->{$class} = {}; - for my $type(keys %{$xpathset->{$class}}) { - my @value = $self->get_field_value( $mods, $xpathset->{$class}->{$type} ); - if( $class eq "subject" ) { - push( @{$data->{$class}->{$type}}, @value ); - } else { - $data->{$class}->{$type} = $value[0]; - } - } - } - return $data; -} -=cut - -sub modsdoc_to_values { - my( $self, $mods ) = @_; - my $data = {}; - - { - my $class = "subject"; - $data->{$class} = {}; - for my $type(keys %{$xpathset->{$class}}) { - my @value = $self->get_field_value( $mods, $xpathset->{$class}->{$type} ); - for my $arr (@value) { - push( @{$data->{$class}->{$type}}, $arr); - } - } - } - - { - my $class = "title"; - $data->{$class} = {}; - for my $type(keys %{$xpathset->{$class}}) { - my @value = $self->get_field_value( $mods, $xpathset->{$class}->{$type}, "title" ); - for my $arr (@value) { - if( ref($arr) ) { - $data->{$class}->{$type} = shift @$arr; - - my $t = lc($data->{$class}->{$type}); - if($t and $t =~ /^l[eoa]s|l[ae]|el|the|un[ae]?|an?\s?$/o ) { - my $val = shift @$arr || ""; - $data->{$class}->{$type} .= " $val" if $data->{$class}->{$type}; - $data->{$class}->{$type} = " $val" unless $data->{$class}->{$type}; - } - - for my $t (@$arr) { - $data->{$class}->{$type} .= " $t"; - } - } else { - $data->{$class}->{$type} = $arr; - } - } - $data->{$class}->{$type} =~ s/\s+/ /go if ($data->{$class}->{$type}); - } - } - - { - my $class = "author"; - $data->{$class} = {}; - for my $type(keys %{$xpathset->{$class}}) { - my @value = $self->get_field_value( $mods, $xpathset->{$class}->{$type} ); - $data->{$class}->{$type} = $value[0]; - } - } - - { - my $class = "series"; - $data->{$class} = {}; - for my $type(keys %{$xpathset->{$class}}) { - my @value = $self->get_field_value( $mods, $xpathset->{$class}->{$type} ); - for my $arr (@value) { - if( ref($arr) ) { - push(@{$data->{$class}->{$type}}, join(" ", @$arr)); - } else { - push( @{$data->{$class}->{$type}}, $arr ); - } - } - } - - } - - return $data; -} - - - - -# --------------------------------------------------------------------------- -# Grabs the data 'we want' from the MODS doc and returns it in hash form -# --------------------------------------------------------------------------- -sub mods_values_to_mods_slim { - my( $self, $modsperl ) = @_; - - my $title = ""; - my $author = ""; - my $subject = []; - my $series = []; - - my $tmp = $modsperl->{title}; - - - if(!$tmp) { $title = ""; } - else { - ($title = $tmp->{proper}) || - ($title = $tmp->{translated}) || - ($title = $tmp->{abbreviated}) || - ($title = $tmp->{uniform}) || - ($title = $tmp->{any}); - } - - $tmp = $modsperl->{author}; - if(!$tmp) { $author = ""; } - else { - ($author = $tmp->{personal}) || - ($author = $tmp->{corporate}) || - ($author = $tmp->{conference}) || - ($author = $tmp->{other}) || - ($author = $tmp->{any}); - } - - $tmp = $modsperl->{subject}; - if(!$tmp) { $subject = {}; } - else { - for my $key( keys %{$tmp}) { - push(@$subject, @{$tmp->{$key}}) if ($tmp->{$key}); - } - my $subh = {}; - for my $s (@$subject) { - if(defined($subh->{$s})) { $subh->{$s->[0]}++ } else { $subh->{$s->[0]} = 1;} - } - $subject = $subh - } - - $tmp = $modsperl->{'series'}; - if(!$tmp) { $series = []; } - else { $series = $tmp->{'series'}; } - - - return { series => $series, title => $title, - author => $author, subject => $subject }; -} - - - -# --------------------------------------------------------------------------- -# Initializes a MARC -> Unified MODS batch process -# --------------------------------------------------------------------------- - -sub start_mods_batch { - - my( $self, $master_doc ) = @_; - - if(!$master_doc) { - $self->{master_doc} = undef; - return; - } - - if(!$mods_sheet) { - my $xslt_doc = $parser->parse_file( - OpenSRF::Utils::SettingsClient->new->config_value(dirs => 'xsl') . "/MARC21slim2MODS32.xsl"); - $mods_sheet = $xslt->parse_stylesheet( $xslt_doc ); - } - - - my $xmldoc = $parser->parse_string($master_doc); - my $mods = $mods_sheet->transform($xmldoc); - - $self->{master_doc} = $self->modsdoc_to_values( $mods ); - $self->{master_doc} = $self->mods_values_to_mods_slim( $self->{master_doc} ); - - ($self->{master_doc}->{isbn}) = - $self->get_field_value( $mods, $isbn_xpath ); - - $self->{master_doc}->{type_of_resource} = - [ $self->get_field_value( $mods, $resource_xpath ) ]; - - ($self->{master_doc}->{tcn}) = - $self->get_field_value( $mods, $tcn_xpath ); - - ($self->{master_doc}->{pubdate}) = - $self->get_field_value( $mods, $pub_xpath ); - - ($self->{master_doc}->{publisher}) = - $self->get_field_value( $mods, $publisher_xpath ); - - ($self->{master_doc}->{edition}) = - $self->get_field_value( $mods, $edition_xpath ); - - - -# ------------------------------ - # holds an array of [ link, title, link, title, ... ] - $self->{master_doc}->{online_loc} = []; - for my $url ($mods->findnodes($online_loc_xpath)) { - push(@{$self->{master_doc}->{online_loc}}, $url->textContent); - push(@{$self->{master_doc}->{online_loc}}, $url->getAttribute('displayLabel') || ''); - push(@{$self->{master_doc}->{online_loc}}, $url->getAttribute('note') || ''); - } - - ($self->{master_doc}->{synopsis}) = - $self->get_field_value( $mods, $abstract_xpath ); - - $self->{master_doc}->{physical_description} = []; - push(@{$self->{master_doc}->{physical_description}}, - $self->get_field_value( $mods, $physical_desc ) ); - $self->{master_doc}->{physical_description} = - join( ' ', @{$self->{master_doc}->{physical_description}}); - - ($self->{master_doc}->{toc}) = $self->get_field_value($mods, $toc_xpath); - -} - - - -# --------------------------------------------------------------------------- -# Takes a MARCXML string and adds it to the growing MODS doc -# --------------------------------------------------------------------------- -sub push_mods_batch { - my( $self, $marcxml ) = @_; - - my $xmldoc = $parser->parse_string($marcxml); - my $mods = $mods_sheet->transform($xmldoc); - - my $xmlperl = $self->modsdoc_to_values( $mods ); - $xmlperl = $self->mods_values_to_mods_slim( $xmlperl ); - - # for backwards compatibility, remove the array part when all is decided - if(ref($xmlperl->{subject}) eq 'ARRAY' ) { - for my $subject( @{$xmlperl->{subject}} ) { - push @{$self->{master_doc}->{subject}}, $subject; - } - } else { - for my $subject ( keys %{$xmlperl->{subject}} ) { - my $s = $self->{master_doc}->{subject}; - if(defined($s->{$subject})) { $s->{$subject}++; } else { $s->{$subject} = 1; } - } - } - - push( @{$self->{master_doc}->{type_of_resource}}, - $self->get_field_value( $mods, $resource_xpath )); - - if(!($self->{master_doc}->{isbn}) ) { - ($self->{master_doc}->{isbn}) = - $self->get_field_value( $mods, $isbn_xpath ); - } -} - - -# --------------------------------------------------------------------------- -# Completes a MARC -> Unified MODS batch process and returns the perl hash -# --------------------------------------------------------------------------- -sub init_virtual_record { - my $record = Fieldmapper::metabib::virtual_record->new; - $record->subject([]); - $record->types_of_resource([]); - $record->call_numbers([]); - return $record; -} - -sub finish_mods_batch { - my $self = shift; - - return undef unless $self->{master_doc}; - - my $perl = $self->{master_doc}; - my $record = init_virtual_record(); - - # turn the hash into a fieldmapper object - #(my $title = $perl->{title}) =~ s/\[.*?\]//og; - #(my $author = $perl->{author}) =~ s/\(.*?\)//og; - my $title = $perl->{title}; - my $author = $perl->{author}; - - my @series; - for my $s (@{$perl->{series}}) { - push @series, (split( /\s*;/, $s ))[0]; - } - - # uniquify the types of resource - my $rtypes = $perl->{type_of_resource}; - my %hash = map { ($_ => 1) } @$rtypes; - $rtypes = [ keys %hash ]; - - $record->title($title); - $record->author($author); - - $record->doc_id($perl->{doc_id}); - $record->isbn($perl->{isbn}); - $record->pubdate($perl->{pubdate}); - $record->publisher($perl->{publisher}); - $record->tcn($perl->{tcn}); - - $record->edition($perl->{edition}); - - $record->subject($perl->{subject}); - $record->types_of_resource($rtypes); - $record->series(\@series); - - $record->online_loc($perl->{online_loc}); - $record->synopsis($perl->{synopsis}); - $record->physical_description($perl->{physical_description}); - $record->toc($perl->{toc}); - - $self->{master_doc} = undef; - return $record; -} - - - diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/Normalize.pm b/Open-ILS/src/perlmods/OpenILS/Utils/Normalize.pm deleted file mode 100644 index d71503c5e1..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/Normalize.pm +++ /dev/null @@ -1,70 +0,0 @@ -package OpenILS::Utils::Normalize; -use strict; -use warnings; -use Unicode::Normalize; -use Encode; - -use Exporter 'import'; -our @EXPORT_OK = qw( naco_normalize ); - -sub naco_normalize { - - my $str = decode_utf8(shift); - my $sf = shift; - - # Apply NACO normalization to input string; based on - # http://www.loc.gov/catdir/pcc/naco/SCA_PccNormalization_Final_revised.pdf - # - # Note that unlike a strict reading of the NACO normalization rules, - # output is returned as lowercase instead of uppercase for compatibility - # with previous versions of the Evergreen naco_normalize routine. - - # Convert to upper-case first; even though final output will be lowercase, doing this will - # ensure that the German eszett (ß) and certain ligatures (ff, fi, ffl, etc.) will be handled correctly. - # If there are any bugs in Perl's implementation of upcasing, they will be passed through here. - $str = uc $str; - - # remove non-filing strings - $str =~ s/\x{0098}.*?\x{009C}//g; - - $str = NFKD($str); - - # additional substitutions - 3.6. - $str =~ s/\x{00C6}/AE/g; - $str =~ s/\x{00DE}/TH/g; - $str =~ s/\x{0152}/OE/g; - $str =~ tr/\x{0110}\x{00D0}\x{00D8}\x{0141}\x{2113}\x{02BB}\x{02BC}]['/DDOLl/d; - - # transformations based on Unicode category codes - $str =~ s/[\p{Cc}\p{Cf}\p{Co}\p{Cs}\p{Lm}\p{Mc}\p{Me}\p{Mn}]//g; - - if ($sf && $sf =~ /^a/o) { - my $commapos = index($str, ','); - if ($commapos > -1) { - if ($commapos != length($str) - 1) { - $str =~ s/,/\x07/; # preserve first comma - } - } - } - - # since we've stripped out the control characters, we can now - # use a few as placeholders temporarily - $str =~ tr/+&@\x{266D}\x{266F}#/\x01\x02\x03\x04\x05\x06/; - $str =~ s/[\p{Pc}\p{Pd}\p{Pe}\p{Pf}\p{Pi}\p{Po}\p{Ps}\p{Sk}\p{Sm}\p{So}\p{Zl}\p{Zp}\p{Zs}]/ /g; - $str =~ tr/\x01\x02\x03\x04\x05\x06\x07/+&@\x{266D}\x{266F}#,/; - - # decimal digits - $str =~ tr/\x{0660}-\x{0669}\x{06F0}-\x{06F9}\x{07C0}-\x{07C9}\x{0966}-\x{096F}\x{09E6}-\x{09EF}\x{0A66}-\x{0A6F}\x{0AE6}-\x{0AEF}\x{0B66}-\x{0B6F}\x{0BE6}-\x{0BEF}\x{0C66}-\x{0C6F}\x{0CE6}-\x{0CEF}\x{0D66}-\x{0D6F}\x{0E50}-\x{0E59}\x{0ED0}-\x{0ED9}\x{0F20}-\x{0F29}\x{1040}-\x{1049}\x{1090}-\x{1099}\x{17E0}-\x{17E9}\x{1810}-\x{1819}\x{1946}-\x{194F}\x{19D0}-\x{19D9}\x{1A80}-\x{1A89}\x{1A90}-\x{1A99}\x{1B50}-\x{1B59}\x{1BB0}-\x{1BB9}\x{1C40}-\x{1C49}\x{1C50}-\x{1C59}\x{A620}-\x{A629}\x{A8D0}-\x{A8D9}\x{A900}-\x{A909}\x{A9D0}-\x{A9D9}\x{AA50}-\x{AA59}\x{ABF0}-\x{ABF9}\x{FF10}-\x{FF19}/0-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-9/; - - # intentionally skipping step 8 of the NACO algorithm; if the string - # gets normalized away, that's fine. - - # leading and trailing spaces - $str =~ s/\s+/ /g; - $str =~ s/^\s+//; - $str =~ s/\s+$//g; - - return lc $str; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/OfflineStore.pm b/Open-ILS/src/perlmods/OpenILS/Utils/OfflineStore.pm deleted file mode 100644 index 5bf0141cdb..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/OfflineStore.pm +++ /dev/null @@ -1,114 +0,0 @@ -package OpenILS::Utils::OfflineStore; -use strict; use warnings; - -use UNIVERSAL::require; -if ('Class::DBI::Frozen::301'->use) { - use parent 'Class::DBI::Frozen::301'; -} elsif ('Class::DBI'->use) { - use parent 'Class::DBI'; -} else { - die $@; -} - -use DBI; -use OpenSRF::Utils::Config; - -our ($_dsn,$_u,$_p); -sub DBFile { - my $class = shift; - my $dsn = shift; - my $u = shift; - my $p = shift; - if ($dsn) { - $_dsn = $dsn; - $_u = $u; - $_p = $p; - } - return $_dsn; -} - -our $_dbh; -sub db_Main { - my $self = shift; - return $_dbh if ($_dbh); - - $_dbh = DBI->connect($_dsn,$_u,$_p, - { - RootClass => 'DBIx::ContextualFetch' - } - ); - - return $_dbh; -} - - -sub disconnect { - $_dbh->disconnect; - $_dbh = undef; -} - - -package OpenILS::Utils::OfflineStore::Session; -use parent 'OpenILS::Utils::OfflineStore'; - -sub _create_table { - my $self = shift; - $self->db_Main->do( <<" SQL" ); - -CREATE TABLE session ( - key TEXT UNIQUE PRIMARY KEY, - org INTEGER NOT NULL, - description TEXT, - creator INTEGER NOT NULL, - create_time INTEGER NOT NULL, - in_process INTEGER NOT NULL DEFAULT 0, - start_time INTEGER, - end_time INTEGER, - num_complete INTEGER NOT NULL DEFAULT 0 -); -CREATE INDEX IF NOT EXISTS session_pkey ON session (key); -CREATE INDEX IF NOT EXISTS session_org ON session (org); -CREATE INDEX IF NOT EXISTS session_creation ON session (create_time); - - SQL -} - -__PACKAGE__->table('offline.session'); -__PACKAGE__->columns( Essential => qw/key org description - creator create_time in_process start_time end_time num_complete/); -__PACKAGE__->has_many(scripts => 'OpenILS::Utils::OfflineStore::Script'); - - -package OpenILS::Utils::OfflineStore::Script; -use parent 'OpenILS::Utils::OfflineStore'; - -sub _create_table { - my $self = shift; - $self->db_Main->do( <<" SQL" ); - -CREATE TABLE script ( - id INTEGER UNIQUE PRIMARY KEY AUTOINCREMENT, - session TEXT NOT NULL, - requestor INTEGER NOT NULL, - create_time INTEGER NOT NULL, - workstation TEXT NOT NULL, - logfile TEXT NOT NULL, - time_delta INTEGER NOT NULL DEFAULT 0, - count INTEGER NOT NULL DEFAULT 0 -); -CREATE INDEX IF NOT EXISTS script_pkey ON script (id); -CREATE INDEX IF NOT EXISTS script_ws ON script (workstation); -CREATE INDEX IF NOT EXISTS script_session ON script (session); - - SQL -} - -__PACKAGE__->table('offline.script'); -__PACKAGE__->columns( Essential => qw/id session requestor create_time workstation logfile time_delta count/); -__PACKAGE__->has_a(session => 'OpenILS::Utils::OfflineStore::Session'); -__PACKAGE__->sequence(qw/offline.script_id_seq/); - - - - - diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/Penalty.pm b/Open-ILS/src/perlmods/OpenILS/Utils/Penalty.pm deleted file mode 100644 index f259345da4..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/Penalty.pm +++ /dev/null @@ -1,124 +0,0 @@ -package OpenILS::Utils::Penalty; -use strict; use warnings; -use DateTime; -use Data::Dumper; -use OpenSRF::EX qw(:try); -use OpenSRF::Utils::Cache; -use OpenSRF::Utils qw/:datetime/; -use OpenILS::Application::AppUtils; -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Utils::CStoreEditor qw/:funcs/; -use OpenILS::Utils::Fieldmapper; -use OpenILS::Const qw/:const/; -my $U = "OpenILS::Application::AppUtils"; - - -# calculate and update the well-known penalties -sub calculate_penalties { - my($class, $e, $user_id, $context_org) = @_; - - my $commit = 0; - unless($e) { - $e = new_editor(xact =>1); - $commit = 1; - } - - my $penalties = $e->json_query({from => ['actor.calculate_system_penalties',$user_id, $context_org]}); - - my $user = $e->retrieve_actor_user( $user_id ); - my @existing_penalties = grep { defined $_->{id} } @$penalties; - my @wanted_penalties = grep { !defined $_->{id} } @$penalties; - my @trigger_events; - - my %csp; - for my $pen_obj (@wanted_penalties) { - - my $pen = Fieldmapper::actor::user_standing_penalty->new; - $pen->$_($pen_obj->{$_}) for keys %$pen_obj; - - # let's see if this penalty is accounted for already - my ($existing) = grep { - $_->{org_unit} == $pen_obj->{org_unit} and - $_->{standing_penalty} == $pen_obj->{standing_penalty} - } @existing_penalties; - - if($existing) { - # we have one of these already. Leave it be, but remove it from the - # existing set so it's not deleted in the subsequent loop - @existing_penalties = grep { $_->{id} ne $existing->{id} } @existing_penalties; - - } else { - - # this is a new penalty - $e->create_actor_user_standing_penalty($pen) or return $e->die_event; - - my $csp_obj = $csp{$pen->standing_penalty} || - $e->retrieve_config_standing_penalty( $pen->standing_penalty ); - - # cache for later - $csp{$pen->standing_penalty} = $csp_obj; - - push(@trigger_events, ['penalty.' . $csp_obj->name, $pen, $pen->org_unit]); - } - } - - # at this point, any penalties remaining in the existing - # penalty set are unaccounted for and should be removed - for my $pen_obj (@existing_penalties) { - my $pen = Fieldmapper::actor::user_standing_penalty->new; - $pen->$_($pen_obj->{$_}) for keys %$pen_obj; - $e->delete_actor_user_standing_penalty($pen) or return $e->die_event; - } - - $e->commit if $commit; - - $U->create_events_for_hook($$_[0], $$_[1], $$_[2]) for @trigger_events; - return undef; -} - -# any penalties whose block_list has an item from @fatal_mask will be sorted -# into the fatal_penalties set. Others will be sorted into the info_penalties set -sub retrieve_penalties { - my($class, $e, $user_id, $context_org, @fatal_mask) = @_; - - my(@info, @fatal); - my $penalties = $class->retrieve_usr_penalties($e, $user_id, $context_org); - - for my $p (@$penalties) { - my $pushed = 0; - if($p->standing_penalty->block_list) { - for my $m (@fatal_mask) { - if($p->standing_penalty->block_list =~ /$m/) { - push(@fatal, $p->standing_penalty); - $pushed = 1; - last; - } - } - } - push(@info, $p->standing_penalty) unless $pushed; - } - - return {fatal_penalties => \@fatal, info_penalties => \@info}; -} - - -# Returns a list of actor_user_standing_penalty objects -sub retrieve_usr_penalties { - my($class, $e, $user_id, $context_org) = @_; - - return $e->search_actor_user_standing_penalty([ - { - usr => $user_id, - org_unit => $U->get_org_ancestors($context_org), - '-or' => [ - {stop_date => undef}, - {stop_date => {'>' => 'now'}} - ], - }, - {flesh => 1, flesh_fields => {ausp => ['standing_penalty']}} - ]); -} - -1; - - diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/PermitHold.pm b/Open-ILS/src/perlmods/OpenILS/Utils/PermitHold.pm deleted file mode 100644 index 47a561aea8..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/PermitHold.pm +++ /dev/null @@ -1,254 +0,0 @@ -package OpenILS::Utils::PermitHold; -use strict; use warnings; -use Data::Dumper; -use OpenSRF::Utils; -use OpenSRF::Utils::SettingsClient; -use OpenILS::Utils::ScriptRunner; -use OpenILS::Application::AppUtils; -use DateTime::Format::ISO8601; -use OpenILS::Application::Circ::ScriptBuilder; -use OpenSRF::Utils::Logger qw(:logger); -use OpenILS::Event; -use OpenILS::Utils::CStoreEditor qw/:funcs/; -my $U = "OpenILS::Application::AppUtils"; - -my $script; # - the permit script -my $script_libs; # - extra script libs -my $legacy_script_support; - -# mental note: open-ils.storage.biblio.record_entry.ranged_tree - - -# params within a hash are: copy, patron, -# requestor, request_lib, title, title_descriptor -sub permit_copy_hold { - my $params = shift; - my @allevents; - - unless(defined $legacy_script_support) { - my $conf = OpenSRF::Utils::SettingsClient->new; - $legacy_script_support = $conf->config_value( - apps => 'open-ils.circ' => app_settings => 'legacy_script_support'); - $legacy_script_support = ($legacy_script_support and - $legacy_script_support =~ /true/i) ? 1 : 0; - } - - return indb_hold_permit($params) unless $legacy_script_support; - - my $ctx = { - patron_id => $$params{patron_id}, - patron => $$params{patron}, - copy => $$params{copy}, - requestor => $$params{requestor}, - title => $$params{title}, - volume => $$params{volume}, - flesh_age_protect => 1, - _direct => { - requestLib => $$params{request_lib}, - pickupLib => $$params{pickup_lib}, - newHold => $$params{new_hold}, - } - }; - - my $runner = OpenILS::Application::Circ::ScriptBuilder->build($ctx); - - my $ets = $ctx->{_events}; - - # -------------------------------------------------------------- - # Strip the expired event since holds are still allowed to be - # captured on expired patrons. - # -------------------------------------------------------------- - if( $ets and @$ets ) { - $ets = [ grep { $_->{textcode} ne 'PATRON_ACCOUNT_EXPIRED' } @$ets ]; - } else { $ets = []; } - - if( @$ets ) { - push( @allevents, @$ets); - - # -------------------------------------------------------------- - # If scriptbuilder returned any events, then the script context - # is undefined and should not be used - # -------------------------------------------------------------- - - } else { - - # check the various holdable flags - push( @allevents, OpenILS::Event->new('ITEM_NOT_HOLDABLE') ) - unless $U->is_true($ctx->{copy}->holdable); - - push( @allevents, OpenILS::Event->new('ITEM_NOT_HOLDABLE') ) - unless $U->is_true($ctx->{copy}->location->holdable); - - push( @allevents, OpenILS::Event->new('ITEM_NOT_HOLDABLE') ) - unless $U->is_true($ctx->{copy}->status->holdable); - - my $evt; - - # grab the data safely - my $rlib = ref($$params{request_lib}) ? $$params{request_lib}->id : $$params{request_lib}; - my $olib = ref($ctx->{volume}) ? $ctx->{volume}->owning_lib : -1; - my $rid = ref($ctx->{requestor}) ? $ctx->{requestor}->id : -2; - my $pid = ($params->{patron}) ? $params->{patron}->id : $params->{patron_id}; - - if( ($rid ne $pid) and ($olib eq $rlib) ) { - $logger->info("Item owning lib $olib is the same as the request lib. No age_protection will be checked"); - } else { - $logger->info("item owning lib = $olib, request lib = $rlib, requestor=$rid, patron=$pid. checking age_protection"); - $evt = check_age_protect($ctx->{patron}, $ctx->{copy}); - push( @allevents, $evt ) if $evt; - } - - $logger->debug("Running permit_copy_hold on copy " . $$params{copy}->id); - - load_scripts($runner); - my $result = $runner->run or - throw OpenSRF::EX::ERROR ("Hold Copy Permit Script Died: $@"); - - # -------------------------------------------------------------- - # Extract and uniquify the event list - # -------------------------------------------------------------- - my $events = $result->{events}; - $logger->debug("circ_permit_hold for user $pid returned events: [@$events]"); - - push( @allevents, OpenILS::Event->new($_)) for @$events; - } - - my %hash = map { ($_->{ilsevent} => $_) } @allevents; - @allevents = values %hash; - - $runner->cleanup; - - return \@allevents if $$params{show_event_list}; - return 1 unless @allevents; - return 0; -} - - -sub load_scripts { - my $runner = shift; - - if(!$script) { - my $conf = OpenSRF::Utils::SettingsClient->new; - my @pfx = ( "apps", "open-ils.circ","app_settings" ); - my $libs = $conf->config_value(@pfx, 'script_path'); - $script = $conf->config_value(@pfx, 'scripts', 'circ_permit_hold'); - $script_libs = (ref($libs)) ? $libs : [$libs]; - } - - $runner->add_path($_) for(@$script_libs); - $runner->load($script); -} - - -sub check_age_protect { - my( $patron, $copy ) = @_; - - return undef unless $copy and $copy->age_protect and $patron; - - my $hou = (ref $patron->home_ou) ? $patron->home_ou->id : $patron->home_ou; - - my $prox = $U->storagereq( - 'open-ils.storage.asset.copy.proximity', $copy->id, $hou ); - - # If this copy is within the appropriate proximity, - # age protect does not apply - return undef if $prox <= $copy->age_protect->prox; - - my $protection_list = $U->storagereq( - 'open-ils.storage.direct.config.rules.age_hold_protect.search_where.atomic', - { age => { '>=' => $copy->age_protect->age }, - prox => { '>=' => $copy->age_protect->prox }, - }, - { order_by => 'age' } - ); - - # Now, now many seconds old is this copy - my $create_date = DateTime::Format::ISO8601 - ->new - ->parse_datetime( OpenSRF::Utils::cleanse_ISO8601($copy->create_date) ) - ->epoch; - - my $age = time - $create_date; - - for my $protection ( @$protection_list ) { - - $logger->info("analyzing age protect ".$protection->name); - - # age protect does not apply if within the proximity - last if $prox <= $protection->prox; - - # How many seconds old does the copy have to be to escape age protection - my $interval = OpenSRF::Utils::interval_to_seconds($protection->age); - - $logger->info("age_protect interval=$interval, create_date=$create_date, age=$age"); - - if( $interval > $age ) { - # if age of the item is less than the protection interval, - # the item falls within the age protect range - $logger->info("age_protect prevents copy from having a hold placed on it: ".$copy->id); - return OpenILS::Event->new('ITEM_AGE_PROTECTED', copy => $copy->id ); - } - } - - return undef; -} - -my $LEGACY_HOLD_EVENT_MAP = { - 'config.hold_matrix_test.holdable' => 'ITEM_NOT_HOLDABLE', - 'transit_range' => 'ITEM_NOT_HOLDABLE', - 'no_matchpoint' => 'NO_POLICY_MATCHPOINT', - 'config.hold_matrix_test.max_holds' => 'MAX_HOLDS', - 'config.rule_age_hold_protect.prox' => 'ITEM_AGE_PROTECTED' -}; - -sub indb_hold_permit { - my $params = shift; - - my $function = $$params{retarget} ? 'action.hold_retarget_permit_test' : 'action.hold_request_permit_test'; - my $patron_id = - ref($$params{patron}) ? $$params{patron}->id : $$params{patron_id}; - my $request_lib = - ref($$params{request_lib}) ? $$params{request_lib}->id : $$params{request_lib}; - - my $HOLD_TEST = { - from => [ - $function, - $$params{pickup_lib}, - $request_lib, - $$params{copy}->id, - $patron_id, - $$params{requestor}->id - ] - }; - - my $e = new_editor(xact=>1); - my $results = $e->json_query($HOLD_TEST); - $e->rollback; - - unless($$params{show_event_list}) { - return 1 if $U->is_true($results->[0]->{success}); - return 0; - } - - return [ - new OpenILS::Event( - "NO_POLICY_MATCHPOINT", - "payload" => {"fail_part" => "no_matchpoint"} - ) - ] unless @$results; - - return [] if $U->is_true($results->[0]->{success}); - - return [ - map { - my $event = new OpenILS::Event( - $LEGACY_HOLD_EVENT_MAP->{$_->{"fail_part"}} || $_->{"fail_part"} - ); - $event->{"payload"} = {"fail_part" => $_->{"fail_part"}}; - $event; - } @$results - ]; -} - - -23; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/RemoteAccount.pm b/Open-ILS/src/perlmods/OpenILS/Utils/RemoteAccount.pm deleted file mode 100644 index d8c399ca62..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/RemoteAccount.pm +++ /dev/null @@ -1,713 +0,0 @@ -package OpenILS::Utils::RemoteAccount; - -# use OpenSRF::Utils::SettingsClient; -use OpenSRF::Utils::Logger qw/:logger/; - -use Data::Dumper; -use Net::FTP; -use Net::SSH2; -use File::Temp; -use File::Basename; -use File::Spec; -use Text::Glob qw( match_glob glob_to_regex ); -# use Error; - -$Data::Dumper::Indent = 0; - -use strict; -use warnings; - -use Carp; - -our $AUTOLOAD; - -our %keyfiles = (); - -my %fields = ( - account_object => undef, - remote_host => undef, - remote_user => undef, - remote_password => undef, - remote_account => undef, - remote_file => undef, - remote_path => undef, # not really doing anything with this... yet. - ssh_privatekey => undef, - ssh_publickey => undef, - type => undef, - port => undef, - content => undef, - local_file => undef, - tempfile => undef, - error => undef, - single_ext => undef, - specific => 0, - debug => 0, -); - - -=head1 NAME - -OpenILS::Utils::RemoteAccount - Encapsulate FTP, SFTP and SSH file transactions for Evergreen - -=head1 DESCRIPTION - -The Remote Account module attempts to transfer a file to/from a remote server. -Either Net::FTP or Net::SSH2 is used. - -=head1 PARAMETERS - -All information is expected to be supplied by the caller via parameters: - ~ remote_host (required) - ~ remote_user - ~ remote_password - ~ remote_account - ~ ssh_privatekey - ~ ssh_publickey - ~ type (FTP, SFTP or SCP -- default FTP) - ~ port - ~ debug - -Note: none of the parameters are actually required, except remote_host. -That is because remote_user, remote_password and remote_account can all be -extrapolated from other sources, as the Net::FTP docs describe: - - If no arguments are given then Net::FTP uses the Net::Netrc package - to lookup the login information for the connected host. - - If no information is found then a login of anonymous is used. - - If no password is given and the login is anonymous then anonymous@ - will be used for password. - -Note that specifying a password will require you to specify a user. -Similarly, specifying an account requires both user and password. -That is, there are no assumed defaults when the latter arguments are used. - -=head2 SSH KEYS: - -The use of ssh keys is preferred. Explicit specification of connection type will prevent -multiple attempts to the same server. Therefore, using the type parameter is also recommended. - -If the type is not explicit, we attempt to use SSH keys where they are specified or otherwise found -in the runtime environment. If only one key is specified, we attempt to derive -the corresponding filename based on the ssh-keygen defaults. If either key is -specified, but both are not found (and readable) then the result is failure. If -no key or type is specified, but keys are found, the key-based connections will be attempted, -but failure will be non-fatal. - -=cut - -sub plausible_dirs { - # returns plausible locations of a .ssh subdir where SSH keys might be stashed - # NOTE: these would need to be properly genericized w/ Makefile vars - # in order to support Debian packaging and multiple EG's on one box. - # Until that happens, we just rely on $HOME - - my @bases = ( - # '/openils/conf', # __EG_CONFIG_DIR__ - ); - ($ENV{HOME}) and unshift @bases, $ENV{HOME}; - - return grep {-d $_} map {"$_/.ssh"} @bases; -} - -sub local_keyfiles { - # populates %keyfiles hash - # %keyfiles maps SSH_PRIVATEKEY => SSH_PUBLICKEY - my $self = shift; - my $force = (@_ ? shift : 0); - return %keyfiles if (%keyfiles and not $force); # caching - $logger->info("Checking for SSH keyfiles" . ($force ? ' (ignoring cache)' : '')); - %keyfiles = (); # reset to empty - my @dirs = plausible_dirs(); - $logger->debug(scalar(@dirs) . " plausible dirs: " . join(', ', @dirs)); - foreach my $dir (@dirs) { - foreach my $key (qw/rsa dsa/) { - my $private = "$dir/id_$key"; - my $public = "$dir/id_$key.pub"; - unless (-r $private) { - $logger->debug("Key '$private' cannot be read: $!"); - next; - } - unless (-r $public) { - $logger->debug("Key '$public' cannot be read: $!"); - next; - } - $keyfiles{$private} = $public; - } - } - return %keyfiles; -} - -sub param_keys { - my $self = shift; - my %keys = (); - if ($self->ssh_publickey and not $self->ssh_privatekey) { - my $private = $self->ssh_publickey; - unless ($private and $private =~ s/\.pub$// and -r $self->ssh_privatekey) { # try to guess missing private key name - $logger->error("No ssh_privatekey specified or found to pair with " . $self->ssh_publickey); - return; - } - $self->ssh_privatekey($private); - } - if ($self->ssh_privatekey and not $self->ssh_publickey) { - my $pub = $self->ssh_privatekey . '.pub'; # guess missing public key name - unless (-r $pub) { - $logger->error("No ssh_publickey specified or found to pair with " . $self->ssh_privatekey); - return; - } - $self->ssh_publickey($pub); - } - - # so now, we have either both ssh_p*keys params or neither - foreach (qw/ssh_publickey ssh_privatekey/) { - unless (-r $self->{$_}) { - $logger->error("$_ '" . $self->{$_} . "' cannot be read: $!"); - return; # quit w/ error if we fail on any user-specified key - } - } - $keys{$self->ssh_privatekey} = $self->ssh_publickey; - return %keys; -} - -sub new_tempfile { - my $self = shift; - my $text = shift || $self->content || ''; - my $tmp = File::Temp->new(); # magical self-destructing tempfile - # print $tmp "THIS IS TEXT\n"; - print $tmp $text or $logger->error($self->_error("could not write to tempfile '$tmp'")); - close $tmp; - $self->tempfile($tmp); # save the object - $self->local_file($tmp->filename); # save the filename - $logger->info(_pkg("using tempfile $tmp")); - return $self->local_file; # return the filename -} - -sub outbound_file { - my $self = shift; - my $params = shift; - - unless (defined $self->content or $self->local_file) { # content can be emptystring - $logger->error($self->_error("No content or local_file specified -- nothing to send")); - return; - } - - # tricky subtlety: we want to use the most recently specified options - # with priority order: filename, content, old filename, old content. - # - # The $params->{x} will already match $self->x after the secondary init, - # so the checks using $params below are for whether the value was specified NOW (e.g. via put()) or not. - # - # if we got a new local_file value, we use it - # else if the content is new to this call, build a new tempfile w/ it, - # else use existing local_file, - # else build new tempfile w/ content already specified via new() - - return $params->{local_file} || ( - (defined $params->{content}) ? - $self->new_tempfile($self->content) : # $self->content is same value as $params->{content} - ($self->local_file || $self->new_tempfile($self->content)) - ); -} - -sub key_check { - my $self = shift; - my $params = shift; - - return if ($params->{type} and $params->{type} eq 'FTP'); # Forget it, user specified regular FTP - return if ( $self->type and $self->type eq 'FTP'); # Forget it, user specified regular FTP - - if ($self->ssh_publickey || $self->ssh_privatekey) { - $self->specific(1); - return $self->param_keys(); # we got one or both params, but they didn't pan out - } - return local_keyfiles(); # optional "force" arg could be used here to empty cache -} - - -# TOP LEVEL methods -# TODO: delete for both FTP and SSH2 - -sub get { - my $self = shift; - my $params = shift; - if (! ref $params) { - $params = {remote_file => $params} ; - } - - $self->init($params); # secondary init - - $self->{get_args} = [$self->remote_file]; # same for scp_put and FTP put - push @{$self->{get_args}}, $self->local_file if defined $self->local_file; - - # $self->content($content); - - if ($self->type eq "FTP") { - return $self->get_ftp(@{$self->{get_args}}); - } else { - my %keys = $self->key_check($params); - return $self->get_ssh2(\%keys, @{$self->{get_args}}); - } -} - -sub put { - my $self = shift; - my $params = shift; - if (! ref $params) { - $params = {local_file => $params} ; - } - - $self->init($params); # secondary init - - my $local_file = $self->outbound_file($params) or return; - - $self->{put_args} = [$local_file]; # same for scp_put and FTP put - if (defined $self->remote_path and not defined $self->remote_file) { - my $rpath = $self->remote_path; - my $fname = basename($local_file); - if ($rpath =~ /^(.*)\*+(.*)$/) { # if the path has an asterisk in it, like './incoming/*.tst' - my $head = $1; - my $tail = $2; - if ($tail =~ /\//) { - $logger->warn($self->_error("remote path '$rpath' has dir slashes AFTER an asterisk. Cannot determine target dir")); - return; - } - if ($self->single_ext) { - $tail =~ /\./ and $fname =~ s/\./_/g; # if dot in tail, replace dots in fname (w/ _) - } - $self->remote_file($head . $fname . $tail); - } else { - $self->remote_file($rpath . '/' . $fname); # if we know just the dir - } - } - - if (defined $self->remote_file) { - push @{$self->{put_args}}, $self->remote_file; # user can specify remote_file name, optionally - } - - if ($self->type eq "FTP") { - return $self->put_ftp(@{$self->{put_args}}); - } else { - my %keys = $self->key_check($params); - $self->put_ssh2(\%keys, @{$self->{put_args}}) and return $self->remote_file; - } -} - -sub ls { - my $self = shift; - my $params = shift; - my @targets = @_; - if (! ref $params) { - unshift @targets, ($params || '.'); # If it was just a string, it's the first target, else default pwd - delete $self->{remote_file}; # overriding any target in the object previously. - $params = {}; # make params a normal hashref again - } else { - if ($params->{remote_file} and @_) { - $logger->warn($self->_error("Ignoring ls parameter remote_file for subsequent args")); - delete $params->{remote_file}; - } - $self->init($params); # secondary init - $self->remote_file and (! @targets) and push @targets, $self->remote_file; # if remote_file is there, and there's nothing else, use it - delete $self->{remote_file}; - } - - $self->{ls_args} = \@targets; - - if ($self->type eq "FTP") { - return $self->ls_ftp(@targets); - } else { - my %keys = $self->key_check($params); - # $logger->info("*** calling ls_ssh2(keys, '" . join("', '", (scalar(@targets) ? map {defined $_ ? $_ : '' } @targets : ())) . "') with ssh keys"); - return $self->ls_ssh2(\%keys, @targets); - } -} - -# Checks if the filename part of a pathname has one or more glob characters -# We split out the filename portion of the path -# Detect glob or no glob. -# returns: directory, regex for matching filenames -sub glob_parse { - my $self = shift; - my $path = shift or return; - my ($vol, $dir, $file) = File::Spec->splitpath($path); # we don't care about attempted globs in mid-filepath - my $front = $vol ? File::Spec->catdir($vol, $dir) : $dir; - $file =~ /\*/ and return ($front, glob_to_regex($file)); - $file =~ /\?/ and return ($front, glob_to_regex($file)); - $logger->debug("No glob detected in '$path'"); - return; -} - - -# Internal Mechanics - -sub _ssh2 { - my $self = shift; - $self->{ssh2} and return $self->{ssh2}; # caching - my $keys = shift; - - my $ssh2 = Net::SSH2->new(); - unless($ssh2->connect($self->remote_host)) { - $logger->warn($self->error("SSH2 connect FAILED: $! " . join(" ", $ssh2->error))); - return; # we cannot connect - } - - my $success = 0; - my @privates = keys %$keys; - my $count = scalar @privates; - - if ($count) { - foreach (@privates) { - if ($self->auth_ssh2($ssh2,$self->auth_ssh2_args($_,$keys->{$_}))) { - $success++; - last; - } - } - unless ($success) { - $logger->error( - $self->error( - "All ($count) keypair(s) FAILED for " . $self->remote_host - ) - ); - return; - } - } else { - $logger->error( - $self->error("Login FAILED for " . $self->remote_host) - ) unless $self->auth_ssh2($ssh2, $self->auth_ssh2_args); - } - return $self->{ssh2} = $ssh2; -} - -sub auth_ssh2 { - my $self = shift; - my $ssh2 = shift; - my %auth_args = @_; - $ssh2 or return; - - my $host = $auth_args{hostname} || 'UNKNOWN'; - my $key = $auth_args{privatekey} || 'UNKNOWN'; - my $msg = "ssh2->auth by keypair for $host using $key"; - if ($ssh2->auth(%auth_args)) { - $logger->info("Successful $msg"); - return 1; - } - - if ($self->specific) { - $logger->error($self->error("Aborting. FAILED $msg: " . ($ssh2->error || ''))); - } else { - $logger->warn($self->error("Unsuccessful keypair: FAILED $msg: " . ($ssh2->error || ''))); - } - return; -} - -sub auth_ssh2_args { - my $self = shift; - my %auth_args = ( - privatekey => shift, - publickey => shift, - rank => [qw/ publickey hostbased password /], - ); - $self->remote_user and $auth_args{username} = $self->remote_user ; - $self->remote_password and $auth_args{password} = $self->remote_password; - $self->remote_host and $auth_args{hostname} = $self->remote_host ; - return %auth_args; -} - -sub put_ssh2 { - my $self = shift; - my $keys = shift; # could have many keypairs here - unless (@_) { - $logger->error($self->_error("put_ssh2 called without target: nothing to put!")); - return; - } - - $logger->info("*** attempting put (" . join(", ", @_) . ") with ssh keys"); - my $ssh2 = $self->_ssh2($keys) or return; - my $res; - if ($res = $ssh2->scp_put( @_ )) { - $logger->info(_pkg("successfully sent", $self->remote_host, join(' --> ', @_ ))); - return $res; - } - $logger->error($self->_error(sprintf "put with keys to %s failed with error: $!", $self->remote_host)); - return; -} - -sub get_ssh2 { - my $self = shift; - my $keys = shift; # could have many keypairs here - unless (@_) { - $logger->error($self->_error("get_ssh2 called without target: nothing to get!")); - return; - } - - $logger->info("*** get args: " . Dumper(\@_)); - $logger->info("*** attempting get (" . join(", ", map {$_ =~ /\S/ ? $_ : '*Object'} map {defined($_) ? $_ : '*Object'} @_) . ") with ssh keys"); - my $ssh2 = $self->_ssh2($keys) or return; - my $res; - if ($res = $ssh2->scp_get( @_ )) { - $logger->info(_pkg("successfully got", $self->remote_host, join(' --> ', @_ ))); - return $res; - } - $logger->error($self->_error(sprintf "get with keys from %s failed with error: $!", $self->remote_host)); - return; -} - -sub ls_ssh2 { - my $self = shift; - my @list = $self->ls_ssh2_full(@_); - @list and return sort map {$_->{slash_path}} @list; -# @list and return sort grep {$_->{name} !~ /./ and {$_->{name} !~ /./ } map {$_->{slash_path}} @list; -} - -sub ls_ssh2_full { - my $self = shift; - my $keys = shift; # could have many keypairs here - my @targets = grep {defined} @_; - - $logger->info("*** attempting ls ('" . join("', '", @targets) . "') with ssh keys"); - my $ssh2 = $self->_ssh2($keys) or return; - my $sftp = $ssh2->sftp or return; - - my @list = (); - foreach my $target (@targets) { - my ($dir, $file); - my ($dirpath, $regex) = $self->glob_parse($target); - $dir = $sftp->opendir($dirpath || $target); # Try to open it like a directory - unless ($dir) { - $file = $sftp->stat($target); # Otherwise, check it like a file - if ($file) { - $file->{slash_path} = $self->_slash_path($target, $file->{name}); # it was a file, not a dir. That's OK. - push @list, $file; - } else { - $logger->warn($self->_error("sftp->opendir($target) failed: " . $sftp->error)); - } - next; - } - my @pool = (); - while ($file = $dir->read()) { - $file->{slash_path} = $self->_slash_path($target, $file->{name}); - push @pool, $file; - } - if ($regex) { - my $count = scalar(@pool); - @pool = grep {$_->{name} =~ /$regex/} @pool; - $logger->info("SSH ls: Glob regex($regex) matches " . scalar(@pool) . " of $count files"); - } # else { $logger->info("SSH ls: No Glob regex in '$target'. Just a regular ls"); } - push @list, @pool; - } - return @list; - -} - -sub _slash_path { - my $self = shift; - my $dir = shift || '.'; - my $file = shift || ''; - my ($dirpath, $regex) = $self->glob_parse($dir); - $dir = $dirpath if $dirpath; - return $dir . ($dir =~ /\/$/ ? '' : '/') . $file; -} - -sub _ftp { - my $self = shift; - my %options = (); - $self->{ftp} and return $self->{ftp}; # caching - foreach (qw/debug port/) { - $options{ucfirst($_)} = $self->{$_} if $self->{$_}; - } - - my $ftp = new Net::FTP($self->remote_host, %options); - unless ($ftp) { - $logger->error( - $self->_error( - "new Net::FTP('" . $self->remote_host . ", ...) FAILED: $@" - ) - ); - return; - } - - my @login_args = (); - foreach (qw/remote_user remote_password remote_account/) { - $self->{$_} or last; - push @login_args, $self->{$_}; - } - my $login_ok = 0; - eval { $login_ok = $ftp->login(@login_args) }; - if ($@ or !$login_ok) { - $logger->error( - $self->_error( - "failed login to", $self->remote_host, "w/ args(" . - join(',', @login_args) . ") : $@" - ) - ); # XXX later, maybe keep passwords out of the logs? - return; - } - return $self->{ftp} = $ftp; -} - -sub put_ftp { - my $self = shift; - my $filename; - - eval { $filename = $self->_ftp->put(@{$self->{put_args}}) }; - if ($@ or not $filename) { - $logger->error( - $self->_error( - "put to", $self->remote_host, "failed with error: $@" - ) - ); - return; - } - - $self->remote_file($filename); - $logger->info( - _pkg( - "successfully sent", $self->remote_host, $self->local_file, '-->', - $filename - ) - ); - return $filename; -} - -sub get_ftp { - my $self = shift; - my $filename; - - eval { $filename = $self->_ftp->get(@{$self->{get_args}}) }; - if ($@ or not $filename) { - $logger->error( - $self->_error( - "get from", $self->remote_host, "failed with error: $@" - ) - ); - return; - } - - $self->local_file($filename); - $logger->info( - _pkg( - "successfully retrieved $filename <--", $self->remote_host . '/' . - $self->remote_file - ) - ); - return $self->local_file; -} - -sub ls_ftp { # returns full path like: dir/path/file.ext - my $self = shift; - my @list; - - foreach (@_) { - my @part; - my ($dirpath, $regex) = $self->glob_parse($_); - my $dirtarget = $dirpath || $_; - $dirtarget =~ s/\/+$//; - eval { @part = $self->_ftp->ls($dirtarget) }; # this ls returns relative/path/filenames. defer filename glob filtering for below. - if ($@) { - $logger->error( - $self->_error( - "ls from", $self->remote_host, "failed with error: $@" - ) - ); - next; - } - if ($dirtarget and $dirtarget ne '.' and $dirtarget ne './' and - $self->_ftp->is_dir($dirtarget)) { - foreach my $file (@part) { # we ensure full(er) path - $file =~ /^$dirtarget\// and next; - $logger->debug("ls_ftp: prepending $dirtarget/ to $file"); - $file = File::Spec->catdir($dirtarget, $file); - } - } - if ($regex) { - my $count = scalar(@part); - # @part = grep {my @a = split('/',$_); scalar(@a) ? /$regex/ : ($a[-1] =~ /$regex/)} @part; - my @bulk = @part; - @part = grep { - my ($vol, $dir, $file) = File::Spec->splitpath($_); - $file =~ /$regex/ - } @part; - $logger->info("FTP ls: Glob regex($regex) matches " . scalar(@part) . " of $count files"); - } # else {$logger->info("FTP ls: No Glob regex in '$_'. Just a regular ls");} - push @list, @part; - } - return @list; -} - -sub delete_ftp { # XXX not yet used - $_[0]->_ftp->delete($_[1]); -} - -sub _pkg { # Not OO - return __PACKAGE__ . ' : ' unless @_; - return __PACKAGE__ . ' : ' . join(' ', @_); -} - -sub _error { - my $self = shift; - return _pkg($self->error(join(' ',@_))); -} - -sub init { - my $self = shift; - my $params = shift; - my @required = @_; # qw(remote_host) ; # nothing required now - - if ($params->{account_object}) { # if we got passed an object, we initialize off that first - $self->{remote_host } = $params->{account_object}->host; - $self->{remote_user } = $params->{account_object}->username; - $self->{remote_password} = $params->{account_object}->password; - $self->{remote_account } = $params->{account_object}->account; - $self->{remote_path } = $params->{account_object}->path; # not really the same as remote_file, maybe expand on this later - } - - foreach (keys %{$self->{_permitted}}) { - $self->{$_} = $params->{$_} if defined $params->{$_}; # possibly override settings from object - } - - foreach (@required) { - unless ($self->{$_}) { - $logger->error("Required parameter $_ not specified"); - return; - } - } - return $self; -} - -sub new { - my ($class, %args) = @_; - my $self = { _permitted => \%fields, %fields }; - - bless $self, $class; - - $self->init(\%args); # or croak "Initialization error caused by bad args"; - return $self; -} - -sub DESTROY { - # in order to create, we must first ... - my $self = shift; - $self->{ssh2} and $self->{ssh2}->disconnect(); # let the other end know we're done. - $self->{ftp} and $self->{ftp}->quit(); # let the other end know we're done. -} - -sub AUTOLOAD { - my $self = shift; - my $class = ref($self) or croak "AUTOLOAD error: $self is not an object"; - my $name = $AUTOLOAD; - - $name =~ s/.*://; # strip leading package stuff - - unless (exists $self->{_permitted}->{$name}) { - croak "AUTOLOAD error: Cannot access '$name' field of class '$class'"; - } - - if (@_) { - return $self->{$name} = shift; - } else { - return $self->{$name}; - } -} - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/ScriptRunner.pm b/Open-ILS/src/perlmods/OpenILS/Utils/ScriptRunner.pm deleted file mode 100644 index 72265f6f67..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/ScriptRunner.pm +++ /dev/null @@ -1,599 +0,0 @@ -package OpenILS::Utils::ScriptRunner; -use strict; use warnings; -use OpenSRF::Utils::Logger qw(:logger); -use OpenSRF::EX qw(:try); -use OpenSRF::Utils::JSON; -use JavaScript::SpiderMonkey; -use LWP::UserAgent; -use XML::LibXML; -use Time::HiRes qw/time/; -use vars qw/%_paths/; - -sub DESTROY { - my $self = shift; - $logger->info("script_runner: destroying self: $self"); -} - -sub cleanup { - my $runner = shift; - $logger->info("script_runner: destroying context..."); - $runner->context->destroy; - delete($$runner{$_}) for (keys %$runner); -} - -sub new { - my $class = shift; - my %params = @_; - $class = ref($class) || $class; - $params{paths} ||= []; - $params{reset_count} ||= 0; - - my $self = bless { file => $params{file}, - libs => $params{libs}, - reset_count => $params{reset_count}, - _runs => 0, - _path => {%_paths} } => $class; - - $self->add_path($_) for @{$params{paths}}; - return $self->init; -} - -sub context { - my( $self, $context ) = @_; - $self->{ctx} = $context if $context; - return $self->{ctx}; -} - -sub init { - my $self = shift; - $self->context( new JavaScript::SpiderMonkey ); - $self->context->init(); - - $self->{_runs} = 0; - - # eating our own dog food with insert - $self->insert(log_stdout => sub { print "@_\n"; } ); - $self->insert(log_stderr => sub { warn "@_\n"; } ); - $self->insert(log_activity => sub { $logger->activity("script_runner: @_"); return 1;} ); - $self->insert(log_error => sub { $logger->error("script_runner: @_"); return 1;} ); - $self->insert(log_warn => sub { $logger->warn("script_runner: @_"); return 1;} ); - $self->insert(log_info => sub { $logger->info("script_runner: @_"); return 1;} ); - $self->insert(log_debug => sub { $logger->debug("script_runner: @_"); return 1;} ); - $self->insert(log_internal => sub { $logger->internal("script_runner: @_"); return 1;} ); - $self->insert(debug => sub { $logger->debug("script_runner: @_"); return 1;} ); - $self->insert(alert => sub { $logger->warn("script_runner: @_"); return 1;} ); - $self->insert(load_lib => sub { $self->load_lib(@_); return 1;}); - - # OpenSRF support functions - $self->insert( - _OILS_FUNC_jsonopensrfrequest_send => - sub { $self->_jsonopensrfrequest_send(@_); } - ); - $self->insert( - _OILS_FUNC_jsonopensrfrequest_connect => - sub { $self->_jsonopensrfrequest_connect(@_); } - ); - $self->insert( - _OILS_FUNC_jsonopensrfrequest_disconnect => - sub { $self->_jsonopensrfrequest_disconnect(@_); } - ); - $self->insert( - _OILS_FUNC_jsonopensrfrequest_finish => - sub { $self->_jsonopensrfrequest_finish(@_); } - ); - - # XML support functions - $self->insert( - _OILS_FUNC_xmlhttprequest_send => - sub { $self->_xmlhttprequest_send(@_); } - ); - $self->insert( - _OILS_FUNC_xml_parse_string => - sub { $self->_parse_xml_string(@_); } - ); - - while ( my $e = shift @{$self->{_env}} ) { - $self->insert( @$e{ qw/key value readonly/ } => 1 ); - } - - while ( my $e = shift @{$self->{_methods}} ) { - $self->insert_method( @$e{ qw/key name meth/ } => 1 ); - } - - $self->load_lib($_) for @{$self->{libs}}; - - return $self; -} - -sub refresh_context { - my $self = shift; - $logger->debug("Refreshing JavaScript Context..."); - $self->context->destroy; - $logger->debug("Context destroyed"); - $self->{_loaded} = {}; - $logger->debug("Loaded scripts removed"); - $self->init; - $logger->debug("New Context initialized"); - return $self; -} - -sub load { - my( $self, $filename ) = @_; - $self->{file} = $filename; -} - -sub runs { shift()->{_runs} } - -sub reset_count { - my $self = shift; - my $count = shift; - - $self->{reset_count} = $count if ($count); - return $self->{reset_count}; -} - -sub run { - my $self = shift; - my $file = shift(); - - my $_real = 0; - if(!$file) { - $_real = 1; - $file = $self->{file}; - } - - $self->refresh_context - if ($self->reset_count && $self->runs > $self->reset_count); - - $self->{_runs}++ if ($_real); - - $file = $self->_find_file($file); - $logger->debug("full script file path: $file"); - - if( ! open(F, $file) ) { - $logger->error("Error opening script file: $file"); - return 0; - } - - my $js = $self->context; - - my $res = ''; - { local $/ = undef; - - $self->insert('environment.result' => {}); - - my $content = ; - #print ( "full script is [$content]" ); - - my $s = time(); - if( !$js || !$content || !$js->eval($content) ) { - $logger->error("$file Eval failed: $@"); - return 0; - } - $logger->debug("eval of $file took ". sprintf('%0.3f', time - $s) . " seconds"); - - if ($_real) { - $self->insert('__' => {'OILS_RESULT' => ''}); - $js->eval("__.OILS_RESULT = js2JSON(environment.result);"); - $res = $self->retrieve('__.OILS_RESULT'); - } - } - - close(F); - $logger->debug( "script result is [$res]" ); - return OpenSRF::Utils::JSON->JSON2perl( $res ); -} - -sub remove_path { - my( $self, $path ) = @_; - if (ref($self)) { - if ($self->{_path}{$path}) { - $self->{_path}{$path} = 0; - } - return $self->{_path}{$path}; - } else { - if ($_paths{$path}) { - $_paths{$path} = 0; - } - return $_paths{$path}; - } -} - -sub add_path { - my( $self, $path ) = @_; - if (ref($self)) { - if (!$self->{_path}{$path}) { - $self->{_path}{$path} = 1; - } - } else { - if (!$_paths{$path}) { - $_paths{$path} = 1; - } - } - return $self; -} - -sub _find_file { - my $self = shift; - my $file = shift; - for my $p ( keys %{ $self->{_path} } ) { - next unless ($self->{_path}{$p}); - my $full = join('/',$p,$file); - return $full if (-e $full); - } -} - -sub load_lib { - my( $self, $file ) = @_; - - my @paths = keys %{$self->{_path}}; - $logger->debug("script_runner: Loading lib file $file : paths=[@paths]"); - - push @{ $self->{libs} }, $file - if (! grep {$_ eq $file} @{ $self->{libs} }); - - if (!$self->{_loaded}{$file}) { - $self->run( $file ); - $self->{_loaded}{$file} = 1; - } - return $self->{_loaded}{$file}; -} - -sub _js_prop_name { - my $name = shift; - $name =~ s/^.*\.//o; - return $name; -} - -sub retrieve { - my( $self, $key ) = @_; - return $self->context->property_get($key); -} - -sub insert_method { - my( $self, $obj_key, $meth_name, $sub, $stop) = @_; - - push @{$self->{_methods}}, { key => $obj_key => name => $meth_name, meth => $sub } unless ($stop); - - my $obj = $self->context->object_by_path( $obj_key ); - $self->context->function_set( $meth_name, $sub, $obj ) if $obj; -} - - -sub insert { - my( $self, $key, $val, $RO, $stop ) = @_; - return unless defined($key); - - push @{$self->{_env}}, { key => $key => value => $val, readonly => $RO } unless ($stop); - - if (ref($val) =~ /^Fieldmapper/o) { - $self->insert_fm($key, $val, $RO); - } elsif (ref($val) and $val =~ /ARRAY/o) { - $self->insert_array($key, $val, $RO); - } elsif (ref($val) and $val =~ /HASH/o) { - $self->insert_hash($key, $val, $RO); - } elsif (ref($val) and $val =~ /CODE/o) { - $self->context->function_set( $key, $val ); - } elsif (!ref($val)) { - if( defined($val) ) { - $self->context->property_by_path( - $key, $val, - ( !$RO ? (sub { $val }, sub { my( $k, $v ) = @_; $val = $v; }) : () ) - ); - } else { - $self->context->property_by_path($key, ""); - } - - } else { - return 0; - } - - return 1; -} - -sub insert_fm { - - my( $self, $key, $fm, $RO ) = @_; - my $ctx = $self->context; - return undef unless ($ctx and $key and $fm); - my $o = $ctx->object_by_path($key); - - for my $f ( $fm->properties ) { - my $val = $fm->$f(); - if (ref $val) { - $self->insert("$key.$f", $val); - } else { - $ctx->property_by_path( - "$key.$f", - $val, - ( !$RO ? - (sub { - my $k = _js_prop_name(shift()); - $fm->$k(); - }, - sub { - my $k = _js_prop_name(shift()); - $fm->ischanged(1); - $fm->$k(@_); - }) : - () - ) - ); - } - } -} - -sub insert_hash { - - my( $self, $key, $hash, $RO ) = @_; - my $ctx = $self->context; - return undef unless ($ctx and $key and $hash); - $ctx->object_by_path($key); - - for my $k ( keys %$hash ) { - my $v = $hash->{$k}; - if (ref $v) { - $self->insert("$key.$k", $v); - } else { - $ctx->property_by_path( - "$key.$k", $v, - ( !$RO ? - (sub { $hash->{_js_prop_name(shift())} }, - sub { - my( $hashkey, $val ) = @_; - $hash->{_js_prop_name($hashkey)} = $val; - }) : - () - ) - ); - } - } -} - -my $__array_id = 0; -sub insert_array { - - my( $self, $key, $array ) = @_; - my $ctx = $self->context; - return undef unless ($ctx and $key and $array); - - my $a = $ctx->array_by_path($key); - - my $ind = 0; - for my $v ( @$array ) { - if (ref $v) { - my $tmp_index = $__array_id++; - my $elobj = $ctx->object_by_path('__tmp_arr_el'.$tmp_index); - $self->insert('__tmp_arr_el'.$tmp_index, $v); - $ctx->array_set_element_as_object( $a, $ind, $elobj ); - } else { - $ctx->array_set_element( $a, $ind, $v ) if defined($v); - } - $ind++; - } -} - -sub _xmlhttprequest_send { - my $self = shift; - my $id = shift; - my $method = shift; - my $url = shift; - my $blocking = shift; - my $headerlist = shift; - my $data = shift; - - my $ctx = $self->context; - - # just so perl has access to it... - $ctx->object_by_path('__xmlhttpreq_hash.id'.$id); - - my $headers = new HTTP::Headers; - my @lines = split(/\n/so, $headerlist); - for my $line (@lines) { - if ($line =~ /^(.+?)|(.+)$/o) { - $headers->header($1 => $2); - } - } - - my $ua = LWP::UserAgent->new; - $ua->agent("OpenILS/0.1"); - - my $req = HTTP::Request->new($method => $url => $headers => $data); - my $res = $ua->request($req); - - if ($res->is_success) { - - $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.responseText', $res->content); - $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.readyState', 4); - $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.statusText', $res->status_line); - $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.status', $res->code); - - } - -} - -our %_jsonopensrfrequest_cache = (); - -sub _jsonopensrfrequest_connect { - my $self = shift; - my $id = shift; - my $service = shift; - - my $ctx = $self->context; - $ctx->object_by_path('__jsonopensrfreq_hash.id'.$id); - - my $ses = $_jsonopensrfrequest_cache{$id} || - do { $_jsonopensrfrequest_cache{$id} = OpenSRF::AppSession->create($service) }; - - if($ses->connect) { - $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.connected', 1); - } else { - $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.connected', 0); - } -} - -sub _jsonopensrfrequest_disconnect { - my $self = shift; - my $id = shift; - - my $ctx = $self->context; - $ctx->object_by_path('__jsonopensrfreq_hash.id'.$id); - - my $ses = $_jsonopensrfrequest_cache{$id}; - return unless $ses; - - $ses->disconnect; -} - -sub _jsonopensrfrequest_finish { - my $self = shift; - my $id = shift; - - my $ctx = $self->context; - $ctx->object_by_path('__jsonopensrfreq_hash.id'.$id); - - my $ses = $_jsonopensrfrequest_cache{$id}; - return unless $ses; - - $ses->finish; - delete $_jsonopensrfrequest_cache{$id}; -} - -sub _jsonopensrfrequest_send { - my $self = shift; - my $id = shift; - my $service = shift; - my $method = shift; - my $blocking = shift; - my $params = shift; - - my @p = @{ OpenSRF::Utils::JSON->JSON2perl($params) }; - - my $ctx = $self->context; - - # just so perl has access to it... - $ctx->object_by_path('__jsonopensrfreq_hash.id'.$id); - - my $ses = $_jsonopensrfrequest_cache{$id} || - do { $_jsonopensrfrequest_cache{$id} = OpenSRF::AppSession->create($service) }; - my $req = $ses->request($method,@p); - - $req->wait_complete; - if (!$req->failed) { - my $res = $req->recv->content; - - $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.responseText', OpenSRF::Utils::JSON->perl2JSON($res)); - $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.readyState', 4); - $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.statusText', 'OK'); - $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.status', '200'); - - } else { - $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.responseText', ''); - $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.readyState', 4); - $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.statusText', $req->failed->status ); - $ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.status', $req->failed->statusCode ); - } - - $req->finish; - -} - -sub _parse_xml_string { - my $self = shift; - my $string = shift; - my $key = shift; - - - my $doc; - my $s = 0; - try { - $doc = XML::LibXML->new->parse_string( $string ); - $s = 1; - } catch Error with { - my $e = shift; - warn "Could not parse document: $e\n"; - }; - return unless ($s); - - _JS_DOM($self->context, $key, $doc); -} - -sub _JS_DOM { - my $ctx = shift; - my $key = shift; - my $node = shift; - - if ($node->nodeType == 9) { - $node = $node->documentElement; - - my $n = $node->nodeName; - my $ns = $node->namespaceURI; - $ns =~ s/'/\'/gso if ($ns); - $ns = "'$ns'" if ($ns); - $ns = 'null' unless ($ns); - $n =~ s/'/\'/gso; - - #warn("$key = DOMImplementation().createDocument($ns,'$n');"); - $ctx->eval("$key = new DOMImplementation().createDocument($ns,'$n');"); - - $key = $key.'.documentElement'; - } - - for my $a ($node->attributes) { - my $n = $a->nodeName; - my $v = $a->value; - $n =~ s/'/\'/gso; - $v =~ s/'/\'/gso; - #warn("$key.setAttribute('$n','$v');"); - $ctx->eval("$key.setAttribute('$n','$v');"); - - } - - my $k = 0; - for my $c ($node->childNodes) { - if ($c->nodeType == 1) { - my $n = $c->nodeName; - my $ns = $node->namespaceURI; - - $n =~ s/'/\'/gso; - $ns =~ s/'/\'/gso if ($ns); - $ns = "'$ns'" if ($ns); - $ns = 'null' unless ($ns); - - #warn("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));"); - $ctx->eval("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));"); - _JS_DOM($ctx, "$key.childNodes.item($k)",$c); - - } elsif ($c->nodeType == 3) { - my $n = $c->data; - $n =~ s/'/\'/gso; - #warn("$key.appendChild($key.ownerDocument.createTextNode('$n'));"); - #warn("path is $key.item($k);"); - $ctx->eval("$key.appendChild($key.ownerDocument.createTextNode('$n'));"); - - } elsif ($c->nodeType == 4) { - my $n = $c->data; - $n =~ s/'/\'/gso; - #warn("$key.appendChild($key.ownerDocument.createCDATASection('$n'));"); - $ctx->eval("$key.appendChild($key.ownerDocument.createCDATASection('$n'));"); - - } elsif ($c->nodeType == 8) { - my $n = $c->data; - $n =~ s/'/\'/gso; - #warn("$key.appendChild($key.ownerDocument.createComment('$n'));"); - $ctx->eval("$key.appendChild($key.ownerDocument.createComment('$n'));"); - - } else { - warn "ACK! I don't know how to handle node type ".$c->nodeType; - } - - - $k++; - } - - return 1; -} - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/SpiderMonkey.pm b/Open-ILS/src/perlmods/OpenILS/Utils/SpiderMonkey.pm deleted file mode 100644 index 88d0a96beb..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/SpiderMonkey.pm +++ /dev/null @@ -1,401 +0,0 @@ -package OpenILS::Utils::SpiderMonkey; -use strict; use warnings; -use OpenSRF::Utils::Logger qw(:logger); -use OpenSRF::EX qw(:try); -use OpenILS::Utils::ScriptRunner; -use base 'OpenILS::Utils::ScriptRunner'; -use JavaScript::SpiderMonkey; -use LWP::UserAgent; -use XML::LibXML; -use Time::HiRes qw/time/; -use vars qw/%_paths/; - -sub new { - my ( $class, %params ) = @_; - $class = ref($class) || $class; - $params{paths} ||= []; - - my $self = { file => $params{file}, libs => $params{libs}, _path => {%_paths} }; - bless( $self, $class ); - - $self->add_path($_) for @{$params{paths}}; - return $self; -} - -sub context { - my( $self, $context ) = @_; - $self->{ctx} = $context if $context; - return $self->{ctx}; -} - -sub init { - my $self = shift; - my $js = JavaScript::SpiderMonkey->new(); - $js->init(); - - $js->function_set(perl_print => sub { print "@_\n"; } ); - $js->function_set(perl_warn => sub { warn @_; } ); - $js->function_set(log_activity => sub { $logger->activity(@_); return 1;} ); - $js->function_set(log_error => sub { $logger->error(@_); return 1;} ); - $js->function_set(log_warn => sub { $logger->warn(@_); return 1;} ); - $js->function_set(log_info => sub { $logger->info(@_); return 1;} ); - $js->function_set(log_debug => sub { $logger->debug(@_); return 1;} ); - $js->function_set(log_internal => sub { $logger->internal(@_); return 1;} ); - $js->function_set(debug => sub { $logger->debug(@_); return 1;} ); - $js->function_set(alert => sub { $logger->warn(@_); return 1;} ); - - $js->function_set(load_lib => sub { $self->load_lib(@_); }); - - # XML support functions - $js->function_set( - _OILS_FUNC_xmlhttprequest_send => sub { $self->_xmlhttprequest_send(@_); }); - $js->function_set( - _OILS_FUNC_xml_parse_string => sub { $self->_parse_xml_string(@_); }); - - $self->context($js); - $self->load_lib($_) for @{$self->{libs}}; - - return $self; -} - - -sub load { - my( $self, $filename ) = @_; - $self->{file} = $filename; -} - -sub run { - my $self = shift; - my $file = shift() || $self->{file}; - my $js = $self->context; - - $file = $self->_find_file($file); - - if( ! open(F, $file) ) { - $logger->error("Error opening script file: $file"); - return 0; - } - - { local $/ = undef; - my $content = ; - my $s = time(); - if( !$js || !$content || !$js->eval($content) ) { - $logger->error("$file Eval failed: $@"); - return 0; - } - $logger->debug("eval of $file took ". sprintf('%0.3f', time - $s) . " seconds"); - } - - close(F); - return 1; -} - -sub remove_path { - my( $self, $path ) = @_; - if (ref($self)) { - if ($self->{_path}{$path}) { - $self->{_path}{$path} = 0; - } - return $self->{_path}{$path}; - } else { - if ($_paths{$path}) { - $_paths{$path} = 0; - } - return $_paths{$path}; - } -} - -sub add_path { - my( $self, $path ) = @_; - if (ref($self)) { - if (!$self->{_path}{$path}) { - $self->{_path}{$path} = 1; - } - } else { - if (!$_paths{$path}) { - $_paths{$path} = 1; - } - } - return $self; -} - -sub _find_file { - my $self = shift; - my $file = shift; - for my $p ( keys %{ $self->{_path} } ) { - next unless ($self->{_path}{$p}); - my $full = join('/',$p,$file); - return $full if (-e $full); - } -} - -sub load_lib { - my( $self, $file ) = @_; - if (!$self->{_loaded}{$file} && $self->run( $file )) { - $self->{_loaded}{$file} = 1; - } - return $self->{_loaded}{$file}; -} - -sub _js_prop_name { - my $name = shift; - $name =~ s/^.*\.//o; - return $name; -} - -sub retrieve { - my( $self, $key ) = @_; - return $self->context->property_get($key); -} - -sub insert_method { - my( $self, $obj_key, $meth_name, $sub ) = @_; - my $obj = $self->context->object_by_path( $obj_key ); - $self->context->function_set( $meth_name, $sub, $obj ) if $obj; -} - - -sub insert { - my( $self, $key, $val ) = @_; - return unless defined($key); - - if (ref($val) =~ /^Fieldmapper/o) { - $self->insert_fm($key, $val); - } elsif (ref($val) and $val =~ /ARRAY/o) { - $self->insert_array($key, $val); - } elsif (ref($val) and $val =~ /HASH/o) { - $self->insert_hash($key, $val); - } elsif (ref($val) and $val =~ /CODE/o) { - $self->context->function_set( $key, $val ); - } elsif (!ref($val)) { - if( defined($val) ) { - $self->context->property_by_path( - $key, $val, - sub { $val }, - sub { my( $k, $v ) = @_; $val = $v; } - ); - } else { - $self->context->property_by_path($key); - } - - } else { - return 0; - } - - return 1; -} - -sub insert_fm { - - my( $self, $key, $fm ) = @_; - my $ctx = $self->context; - return undef unless ($ctx and $key and $fm); - my $o = $ctx->object_by_path($key); - - for my $f ( $fm->properties ) { - my $val = $fm->$f(); - if (ref $val) { - $self->insert("$key.$f", $val); - } else { - $ctx->property_by_path( - "$key.$f", - $val, - sub { - my $k = _js_prop_name(shift()); - $fm->$k(); - }, - - sub { - my $k = _js_prop_name(shift()); - $fm->ischanged(1); - $fm->$k(@_); - } - ); - } - } -} - -sub insert_hash { - - my( $self, $key, $hash ) = @_; - my $ctx = $self->context; - return undef unless ($ctx and $key and $hash); - $ctx->object_by_path($key); - - for my $k ( keys %$hash ) { - my $v = $hash->{$k}; - if (ref $v) { - $self->insert("$key.$k", $v); - } else { - $ctx->property_by_path( - "$key.$k", $v, - sub { $hash->{_js_prop_name(shift())} }, - sub { - my( $key, $val ) = @_; - $hash->{_js_prop_name($key)} = $val; } - ); - } - } -} - -my $__array_id = 0; -sub insert_array { - - my( $self, $key, $array ) = @_; - my $ctx = $self->context; - return undef unless ($ctx and $key and $array); - - my $a = $ctx->array_by_path($key); - - my $ind = 0; - for my $v ( @$array ) { - if (ref $v) { - my $elobj = $ctx->object_by_path('__tmp_arr_el'.$__array_id); - $self->insert('__tmp_arr_el'.$__array_id, $v); - $ctx->array_set_element_as_object( $a, $ind, $elobj ); - $__array_id++; - } else { - $ctx->array_set_element( $a, $ind, $v ) if defined($v); - } - $ind++; - } -} - -sub _xmlhttprequest_send { - my $self = shift; - my $id = shift; - my $method = shift; - my $url = shift; - my $blocking = shift; - my $headerlist = shift; - my $data = shift; - - my $ctx = $self->context; - - # just so perl has access to it... - $ctx->object_by_path('__xmlhttpreq_hash.id'.$id); - - my $headers = new HTTP::Headers; - my @lines = split(/\n/so, $headerlist); - for my $line (@lines) { - if ($line =~ /^(.+?)|(.+)$/o) { - $headers->header($1 => $2); - } - } - - my $ua = LWP::UserAgent->new; - $ua->agent("OpenILS/0.1"); - - my $req = HTTP::Request->new($method => $url => $headers => $data); - my $res = $ua->request($req); - - if ($res->is_success) { - - $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.responseText', $res->content); - $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.readyState', 4); - $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.statusText', $res->status_line); - $ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.status', $res->code); - - } - -} - -sub _parse_xml_string { - my $self = shift; - my $string = shift; - my $key = shift; - - - my $doc; - my $s = 0; - try { - $doc = XML::LibXML->new->parse_string( $string ); - $s = 1; - } catch Error with { - my $e = shift; - warn "Could not parse document: $e\n"; - }; - return unless ($s); - - _JS_DOM($self->context, $key, $doc); -} - -sub _JS_DOM { - my $ctx = shift; - my $key = shift; - my $node = shift; - - if ($node->nodeType == 9) { - $node = $node->documentElement; - - my $n = $node->nodeName; - my $ns = $node->namespaceURI; - $ns =~ s/'/\'/gso if ($ns); - $ns = "'$ns'" if ($ns); - $ns = 'null' unless ($ns); - $n =~ s/'/\'/gso; - - #warn("$key = DOMImplementation().createDocument($ns,'$n');"); - $ctx->eval("$key = new DOMImplementation().createDocument($ns,'$n');"); - - $key = $key.'.documentElement'; - } - - for my $a ($node->attributes) { - my $n = $a->nodeName; - my $v = $a->value; - $n =~ s/'/\'/gso; - $v =~ s/'/\'/gso; - #warn("$key.setAttribute('$n','$v');"); - $ctx->eval("$key.setAttribute('$n','$v');"); - - } - - my $k = 0; - for my $c ($node->childNodes) { - if ($c->nodeType == 1) { - my $n = $c->nodeName; - my $ns = $node->namespaceURI; - - $n =~ s/'/\'/gso; - $ns =~ s/'/\'/gso if ($ns); - $ns = "'$ns'" if ($ns); - $ns = 'null' unless ($ns); - - #warn("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));"); - $ctx->eval("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));"); - _JS_DOM($ctx, "$key.childNodes.item($k)",$c); - - } elsif ($c->nodeType == 3) { - my $n = $c->data; - $n =~ s/'/\'/gso; - #warn("$key.appendChild($key.ownerDocument.createTextNode('$n'));"); - #warn("path is $key.item($k);"); - $ctx->eval("$key.appendChild($key.ownerDocument.createTextNode('$n'));"); - - } elsif ($c->nodeType == 4) { - my $n = $c->data; - $n =~ s/'/\'/gso; - #warn("$key.appendChild($key.ownerDocument.createCDATASection('$n'));"); - $ctx->eval("$key.appendChild($key.ownerDocument.createCDATASection('$n'));"); - - } elsif ($c->nodeType == 8) { - my $n = $c->data; - $n =~ s/'/\'/gso; - #warn("$key.appendChild($key.ownerDocument.createComment('$n'));"); - $ctx->eval("$key.appendChild($key.ownerDocument.createComment('$n'));"); - - } else { - warn "ACK! I don't know how to handle node type ".$c->nodeType; - } - - - $k++; - } - - return 1; -} - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/ZClient.pm b/Open-ILS/src/perlmods/OpenILS/Utils/ZClient.pm deleted file mode 100644 index 10080de1a3..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/Utils/ZClient.pm +++ /dev/null @@ -1,169 +0,0 @@ -package OpenILS::Utils::ZClient; -use UNIVERSAL::require; - -sub DESTROY {}; - -use overload 'bool' => sub { return $_[0]->{connection} ? 1 : 0 }; - -sub EVENT_NONE { 0 } -sub EVENT_CONNECT { 1 } -sub EVENT_SEND_DATA { 2 } -sub EVENT_RECV_DATA { 3 } -sub EVENT_TIMEOUT { 4 } -sub EVENT_UNKNOWN { 5 } -sub EVENT_SEND_APDU { 6 } -sub EVENT_RECV_APDU { 7 } -sub EVENT_RECV_RECORD { 8 } -sub EVENT_RECV_SEARCH { 9 } -sub EVENT_END { 10 } - -our $conn_class = 'ZOOM::Connection'; -our $imp_class = 'ZOOM'; -our $AUTOLOAD; - -# Detect the installed z client, prefering ZOOM. -if (!$imp_class->use()) { - - $imp_class = 'Net::Z3950'; # Try Net::Z3950 - if ($imp_class->use()) { - - # Tell 'new' how to build the connection - $conn_class = 'Net::Z3950::Connection'; - - } else { - die "Cannot load a z39.50 client implementation! Please install either ZOOM or Net::Z3950.\n"; - } -} - -# 'new' is called thusly: -# my $conn = OpenILS::Utils::ZClient->new( $host, $port, databaseName => $db, user => $username ) - -sub new { - my $class = shift(); - my @args = @_; - - if ($class ne __PACKAGE__) { # NOT called OO-ishly - # put the first param back if called like OpenILS::Utils::ZClient::new() - unshift @args, $class; - } - - return bless { connection => $conn_class->new(@_) } => __PACKAGE__; -} - -sub search { - my $self = shift; - my $r = $imp_class eq 'Net::Z3950' ? - $self->{connection}->search( @_ ) : - $self->{connection}->search_pqf( @_ ); - - return OpenILS::Utils::ZClient::ResultSet->new( $r ); -} - -sub event { - my $list = shift; - if ($imp_class eq 'Net::Z3950') { - if (defined $$list[0]{_async_index}) { - return 0 if ($$list[0]{_async_index} == @$list); - return ++$$list[0]{_async_index}; - } else { - return $$list[0]{_async_index} = 1; - } - } - - return ZOOM::event([map { ($_->{connection}) } @$list]); -} - -*{__PACKAGE__ . '::search_pqf'} = \&search; - -sub AUTOLOAD { - my $self = shift; - - my $method = $AUTOLOAD; - $method =~ s/.*://; # strip fully-qualified portion - - return $self->{connection}->$method( @_ ); -} - -#------------------------------------------------------------------------------- -package OpenILS::Utils::ZClient::ResultSet; - -sub DESTROY {}; -our $AUTOLOAD; - -sub new { - my $class = shift; - my @args = @_; - - if ($class ne __PACKAGE__) { # NOT called OO-ishly - # put the first param back if called like OpenILS::Utils::ZClient::ResultSet::new() - unshift @args, $class; - } - - - return bless { result => $args[0] } => __PACKAGE__; -} - -sub record { - my $self = shift; - my $offset = shift; - my $r = $imp_class eq 'Net::Z3950' ? - $self->{result}->record( ++$offset ) : - $self->{result}->record( $offset ); - - return OpenILS::Utils::ZClient::Record->new( $r ); -} - -sub last_event { - my $self = shift; - return OpenILS::Utils::ZClient::EVENT_END() if ($imp_class eq 'Net::Z3950'); - $self->{result}->last_event(); -} - -sub AUTOLOAD { - my $self = shift; - - my $method = $AUTOLOAD; - $method =~ s/.*://; # strip fully-qualified portion - - return $self->{result}->$method( @_ ); -} - -#------------------------------------------------------------------------------- -package OpenILS::Utils::ZClient::Record; - -sub DESTROY {}; -our $AUTOLOAD; - -sub new { - my $class = shift; - my @args = @_; - - if ($class ne __PACKAGE__) { # NOT called OO-ishly - # put the first param back if called like OpenILS::Utils::ZClient::ResultSet::new() - unshift @args, $class; - } - - - return bless { record => shift() } => __PACKAGE__; -} - -sub rawdata { - my $self = shift; - return $OpenILS::Utils::ZClient::imp_class eq 'Net::Z3950' ? - $self->{record}->rawdata( @_ ) : - $self->{record}->raw( @_ ); -} - -*{__PACKAGE__ . '::raw'} = \&rawdata; - -sub AUTOLOAD { - my $self = shift; - - my $method = $AUTOLOAD; - $method =~ s/.*://; # strip fully-qualified portion - - return $self->{record}->$method( @_ ); -} - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/AddedContent.pm b/Open-ILS/src/perlmods/OpenILS/WWW/AddedContent.pm deleted file mode 100644 index f4c816b2dc..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/AddedContent.pm +++ /dev/null @@ -1,202 +0,0 @@ -package OpenILS::WWW::AddedContent; -use strict; use warnings; - -use lib qw(/usr/lib/perl5/Bundle/); - -use CGI; -use Apache2::Log; -use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log); -use APR::Const -compile => qw(:error SUCCESS); -use Apache2::RequestRec (); -use Apache2::RequestIO (); -use Apache2::RequestUtil; -use Data::Dumper; -use UNIVERSAL::require; - -use OpenSRF::EX qw(:try); -use OpenSRF::Utils::Cache; -use OpenSRF::System; -use OpenSRF::Utils::Logger qw/$logger/; - -use LWP::UserAgent; -use MIME::Base64; - -my $AC = __PACKAGE__; - - -# set the bootstrap config when this module is loaded -my $bs_config; - -sub import { - my $self = shift; - $bs_config = shift; -} - - -my $handler; # added content handler class handle -my $cache; # memcache handle -my $net_timeout; # max seconds to wait for a response from the added content vendor -my $max_errors; # max consecutive lookup failures before added content is temporarily disabled -my $error_countdown; # current consecutive errors countdown - -# number of seconds to wait before next lookup -# is attempted after lookups have been disabled -my $error_retry_timeout; - - -sub child_init { - - OpenSRF::System->bootstrap_client( config_file => $bs_config ); - $cache = OpenSRF::Utils::Cache->new; - - my $sclient = OpenSRF::Utils::SettingsClient->new(); - my $ac_data = $sclient->config_value("added_content"); - - return unless $ac_data; - my $ac_handler = $ac_data->{module}; - return unless $ac_handler; - - $net_timeout = $ac_data->{timeout} || 1; - $error_countdown = $max_errors = $ac_data->{max_errors} || 10; - $error_retry_timeout = $ac_data->{retry_timeout} || 600; - - $logger->debug("Attempting to load Added Content handler: $ac_handler"); - - $ac_handler->use; - - if($@) { - $logger->error("Unable to load Added Content handler [$ac_handler]: $@"); - return; - } - - $handler = $ac_handler->new($ac_data); - $logger->debug("added content loaded handler: $handler"); -} - - -sub handler { - - my $r = shift; - return Apache2::Const::DECLINED if (-e $r->filename); - - my $cgi = CGI->new; - my $path = $r->path_info; - my $res; - - my( undef, $type, $format, $key ) = split(/\//, $r->path_info); - - child_init() unless $handler; - - return Apache2::Const::NOT_FOUND unless $handler and $type and $format and $key; - - my $err; - my $data; - my $method = "${type}_${format}"; - - return Apache2::Const::NOT_FOUND unless $handler->can($method); - return $res if defined($res = $AC->serve_from_cache($type, $format, $key)); - return Apache2::Const::NOT_FOUND unless $AC->lookups_enabled; - - try { - $data = $handler->$method($key); - } catch Error with { - $err = shift; - decr_error_countdown(); - $logger->debug("added content handler failed: $method($key) => $err"); - }; - - return Apache2::Const::NOT_FOUND if $err; - - if(!$data) { - # if the AC lookup found no corresponding data, cache that information - $logger->debug("added content handler returned no results $method($key)") unless $data; - $AC->cache_result($type, $format, $key, {nocontent=>1}); - return Apache2::Const::NOT_FOUND; - } - - $AC->print_content($data); - $AC->cache_result($type, $format, $key, $data); - - reset_error_countdown(); - return Apache2::Const::OK; -} - -sub print_content { - my($class, $data, $from_cache) = @_; - return Apache2::Const::NOT_FOUND if $data->{nocontent}; - - my $ct = $data->{content_type}; - my $content = $data->{content}; - print "Content-type: $ct\n\n"; - - if($data->{binary}) { - binmode STDOUT; - # if it hasn't been cached yet, it's still in binary form - print( ($from_cache) ? decode_base64($content) : $content ); - } else { - print $content; - } - - - return Apache2::Const::OK; -} - - - - -# returns an HTPP::Response object -sub get_url { - my( $self, $url ) = @_; - - $logger->info("added content getting [timeout=$net_timeout, errors_remaining=$error_countdown] URL = $url"); - my $agent = LWP::UserAgent->new(timeout => $net_timeout); - - my $res = $agent->get($url); - $logger->info("added content request returned with code " . $res->code); - die "added content request failed: " . $res->status_line ."\n" unless $res->is_success; - - return $res; -} - -sub lookups_enabled { - if( $cache->get_cache('ac.no_lookup') ) { - $logger->info("added content lookup disabled"); - return undef; - } - return 1; -} - -sub disable_lookups { - $cache->put_cache('ac.no_lookup', 1, $error_retry_timeout); -} - -sub decr_error_countdown { - $error_countdown--; - if($error_countdown < 1) { - $logger->warn("added content error count exhausted. Disabling lookups for $error_retry_timeout seconds"); - $AC->disable_lookups; - } -} - -sub reset_error_countdown { - $error_countdown = $max_errors; -} - -sub cache_result { - my($class, $type, $format, $key, $data) = @_; - $logger->debug("caching $type/$format/$key"); - $data->{content} = encode_base64($data->{content}) if $data->{binary}; - return $cache->put_cache("ac.$type.$format.$key", $data); -} - -sub serve_from_cache { - my($class, $type, $format, $key) = @_; - my $data = $cache->get_cache("ac.$type.$format.$key"); - return undef unless $data; - $logger->debug("serving $type/$format/$key from cache"); - return $class->print_content($data, 1); -} - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/AddedContent/Amazon.pm b/Open-ILS/src/perlmods/OpenILS/WWW/AddedContent/Amazon.pm deleted file mode 100644 index 77c6bef531..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/AddedContent/Amazon.pm +++ /dev/null @@ -1,75 +0,0 @@ -package OpenILS::WWW::AddedContent::Amazon; -use strict; use warnings; -use OpenSRF::Utils::Logger qw/$logger/; -use OpenSRF::Utils::SettingsParser; -use OpenILS::WWW::AddedContent; -use OpenSRF::Utils::JSON; -use OpenSRF::EX qw/:try/; -use XML::LibXML; - -my $AC = 'OpenILS::WWW::AddedContent'; - -sub new { - my( $class, $args ) = @_; - $class = ref $class || $class; - return bless($args, $class); -} - -sub base_url { - my $self = shift; - return $self->{base_url}; -} - -sub userid { - my $self = shift; - return $self->{userid}; -} - - -# -------------------------------------------------------------------------- -sub jacket_small { - my( $self, $key ) = @_; - return $self->send_img( - $self->fetch_response('_SCMZZZZZZZ_.jpg', $key)); -} - -sub jacket_medium { - my( $self, $key ) = @_; - return $self->send_img( - $self->fetch_response('_SCMZZZZZZZ_.jpg', $key)); - -} -sub jacket_large { - my( $self, $key ) = @_; - return $self->send_img( - $self->fetch_response('_SCZZZZZZZ_.jpg', $key)); -} - -# -------------------------------------------------------------------------- - -sub send_img { - my($self, $response) = @_; - return { - content_type => $response->header('Content-type'), - content => $response->content, - binary => 1 - }; -} - -# returns the raw content returned from the URL fetch -sub fetch_content { - my( $self, $page, $key ) = @_; - return $self->fetch_response($page, $key)->content; -} - -# returns the HTTP response object from the URL fetch -sub fetch_response { - my( $self, $page, $key ) = @_; - my $uname = $self->userid; - my $url = $self->base_url . "$key.01.$page"; - return $AC->get_url($url); -} - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/AddedContent/ContentCafe.pm b/Open-ILS/src/perlmods/OpenILS/WWW/AddedContent/ContentCafe.pm deleted file mode 100644 index c6e7f4ff8f..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/AddedContent/ContentCafe.pm +++ /dev/null @@ -1,299 +0,0 @@ -package OpenILS::WWW::AddedContent::ContentCafe; -use strict; use warnings; -use OpenSRF::Utils::Logger qw/$logger/; -use OpenSRF::Utils::SettingsParser; -use OpenSRF::Utils::JSON; -use OpenSRF::EX qw/:try/; -use OpenILS::WWW::AddedContent; -use XML::LibXML; -use MIME::Base64; - -my $AC = 'OpenILS::WWW::AddedContent'; - -my $base_url = 'http://contentcafe2.btol.com/ContentCafe/ContentCafe.asmx/Single'; -my $cover_base_url = 'http://contentcafe2.btol.com/ContentCafe/Jacket.aspx'; - -sub new { - my( $class, $args ) = @_; - $class = ref $class || $class; - return bless($args, $class); -} - -sub userid { - my $self = shift; - return $self->{ContentCafe}->{userid}; -} - -sub password { - my $self = shift; - return $self->{ContentCafe}->{password}; -} - -sub return_behavior_on_no_jacket_image { - my $self = shift; - return $self->{ContentCafe}->{return_behavior_on_no_jacket_image}; -} - -# -------------------------------------------------------------------------- -sub jacket_small { - my( $self, $key ) = @_; - return $self->send_img( - $self->fetch_cover_response('S', $key)); -} - -sub jacket_medium { - my( $self, $key ) = @_; - return $self->send_img( - $self->fetch_cover_response('M', $key)); - -} -sub jacket_large { - my( $self, $key ) = @_; - return $self->send_img( - $self->fetch_cover_response('L', $key)); -} - -# -------------------------------------------------------------------------- - -sub toc_html { - my( $self, $key ) = @_; - my $xml = $self->fetch_content('TocDetail', $key); - my $doc = XML::LibXML->new->parse_string($xml); - $doc->documentElement->setNamespace('http://ContentCafe2.btol.com', 'cc'); - my $html = ''; - my @nodes = $doc->findnodes('//cc:Toc'); - return 0 if (scalar(@nodes) < 1); - foreach my $node ( @nodes ) { - $html .= $node->textContent . '

'; - } - return $self->send_html($html); -} - -sub toc_xml { - my( $self, $key ) = @_; - return $self->send_xml( - $self->fetch_content('TocDetail', $key)); -} - -sub toc_json { - my( $self, $key ) = @_; - return $self->send_json( - $self->fetch_content('TocDetail', $key)); -} - -# -------------------------------------------------------------------------- - -sub anotes_html { - my( $self, $key ) = @_; - my $xml = $self->fetch_content('BiographyDetail', $key); - my $doc = XML::LibXML->new->parse_string($xml); - $doc->documentElement->setNamespace('http://ContentCafe2.btol.com', 'cc'); - my $html = ''; - my @nodes = $doc->findnodes('//cc:Biography'); - return 0 if (scalar(@nodes) < 1); - foreach my $node ( @nodes ) { - $html .= '

' . $node->textContent . '

'; - } - return $self->send_html($html); -} - -sub anotes_xml { - my( $self, $key ) = @_; - return $self->send_xml( - $self->fetch_content('BiographyDetail', $key)); -} - -sub anotes_json { - my( $self, $key ) = @_; - return $self->send_json( - $self->fetch_content('BiographyDetail', $key)); -} - - -# -------------------------------------------------------------------------- - -sub excerpt_html { - my( $self, $key ) = @_; - my $xml = $self->fetch_content('ExcerptDetail', $key); - my $doc = XML::LibXML->new->parse_string($xml); - $doc->documentElement->setNamespace('http://ContentCafe2.btol.com', 'cc'); - my $html = ''; - my @nodes = $doc->findnodes('//cc:Excerpt'); - return 0 if (scalar(@nodes) < 1); - foreach my $node ( @nodes ) { - $html .= $node->textContent; - } - return $self->send_html($html); -} - -sub excerpt_xml { - my( $self, $key ) = @_; - return $self->send_xml( - $self->fetch_content('ExcerptDetail', $key)); -} - -sub excerpt_json { - my( $self, $key ) = @_; - return $self->send_json( - $self->fetch_content('ExcerptDetail', $key)); -} - -# -------------------------------------------------------------------------- - -sub reviews_html { - my( $self, $key ) = @_; - my $xml = $self->fetch_content('ReviewDetail', $key); - my $doc = XML::LibXML->new->parse_string($xml); - $doc->documentElement->setNamespace('http://ContentCafe2.btol.com', 'cc'); - my $html = '
    '; - my @nodes = $doc->findnodes('//cc:ReviewItem'); - return 0 if (scalar(@nodes) < 1); - foreach my $node ( @nodes ) { - my @s_nodes = $node->findnodes('./cc:Supplier'); - my @p_nodes = $node->findnodes('./cc:Publication'); - my @i_nodes = $node->findnodes('./cc:Issue'); - my @r_nodes = $node->findnodes('./cc:Review'); - $html .= '
  • ' . (scalar(@p_nodes) ? $p_nodes[0]->textContent : '') . ''; - if (scalar(@i_nodes) && scalar(@p_nodes)) { $html .= ' : '; } - $html .= (scalar(@i_nodes) ? $i_nodes[0]->textContent : '') . '
    '; - $html .= (scalar(@r_nodes) ? $r_nodes[0]->textContent : '') . '
    • '; - } - $html .= '
'; - return $self->send_html($html); -} - -sub reviews_xml { - my( $self, $key ) = @_; - return $self->send_xml( - $self->fetch_content('ReviewDetail', $key)); -} - -sub reviews_json { - my( $self, $key ) = @_; - return $self->send_json( - $self->fetch_content('ReviewDetail', $key)); -} - -# -------------------------------------------------------------------------- - -sub summary_html { - my( $self, $key ) = @_; - my $xml = $self->fetch_content('AnnotationDetail', $key); - my $doc = XML::LibXML->new->parse_string($xml); - $doc->documentElement->setNamespace('http://ContentCafe2.btol.com', 'cc'); - my $html = '
    '; - my @nodes = $doc->findnodes('//cc:AnnotationItem'); - return 0 if (scalar(@nodes) < 1); - foreach my $node ( @nodes ) { - my @s_nodes = $node->findnodes('./cc:Supplier'); - my @a_nodes = $node->findnodes('./cc:Annotation'); - $html .= '
  • ' . (scalar(@s_nodes) ? $s_nodes[0]->textContent : '') . '
    '; - $html .= (scalar(@a_nodes) ? $a_nodes[0]->textContent : '') . '
    • '; - } - $html .= '
'; - return $self->send_html($html); -} - -sub summary_xml { - my( $self, $key ) = @_; - return $self->send_xml( - $self->fetch_content('AnnotationDetail', $key)); -} - -sub summary_json { - my( $self, $key ) = @_; - return $self->send_json( - $self->fetch_content('AnnotationDetail', $key)); -} - - -# -------------------------------------------------------------------------- - - -sub data_exists { - my( $self, $data ) = @_; - return 0 if $data =~ m/error<\/title>/iog; - return 1; -} - - -sub send_json { - my( $self, $xml ) = @_; - return 0 unless $self->data_exists($xml); - my $doc; - - try { - $doc = XML::LibXML->new->parse_string($xml); - } catch Error with { - my $err = shift; - $logger->error("added content XML parser error: $err\n\n$xml"); - $doc = undef; - }; - - return 0 unless $doc; - my $perl = OpenSRF::Utils::SettingsParser::XML2perl($doc->documentElement); - my $json = OpenSRF::Utils::JSON->perl2JSON($perl); - return { content_type => 'text/plain', content => $json }; -} - -sub send_xml { - my( $self, $xml ) = @_; - return 0 unless $self->data_exists($xml); - return { content_type => 'application/xml', content => $xml }; -} - -sub send_html { - my( $self, $content ) = @_; - return 0 unless $self->data_exists($content); - - # Hide anything that might contain a link since it will be broken - my $HTML = <<" HTML"; - <div> - <style type='text/css'> - div.ac input, div.ac a[href],div.ac img, div.ac button { display: none; visibility: hidden } - </style> - <div class='ac'> - $content - </div> - </div> - HTML - - return { content_type => 'text/html', content => $HTML }; -} - -sub send_img { - my($self, $response) = @_; - return { - content_type => $response->header('Content-type'), - content => $response->content, - binary => 1 - }; -} - -# returns the raw content returned from the URL fetch -sub fetch_content { - my( $self, $contentType, $key ) = @_; - return $self->fetch_response($contentType, $key)->content; -} - -# returns the HTTP response object from the URL fetch -sub fetch_response { - my( $self, $contentType, $key ) = @_; - my $userid = $self->userid; - my $password = $self->password; - my $url = $base_url . "?UserID=$userid&Password=$password&Key=$key&Content=$contentType"; - return $AC->get_url($url); -} - -# returns the HTTP response object from the URL fetch -sub fetch_cover_response { - my( $self, $size, $key ) = @_; - my $userid = $self->userid; - my $password = $self->password; - my $return = $self->return_behavior_on_no_jacket_image; - my $url = $cover_base_url . "?UserID=$userid&Password=$password&Return=$return&Type=$size&Value=$key"; - return $AC->get_url($url); -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/AddedContent/OpenLibrary.pm b/Open-ILS/src/perlmods/OpenILS/WWW/AddedContent/OpenLibrary.pm deleted file mode 100644 index 634fdc7560..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/AddedContent/OpenLibrary.pm +++ /dev/null @@ -1,185 +0,0 @@ -# --------------------------------------------------------------- -# Copyright (C) 2009 David Christensen <david.a.christensen@gmail.com> -# Copyright (C) 2009 Dan Scott <dscott@laurentian.ca> -# -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# --------------------------------------------------------------- - -package OpenILS::WWW::AddedContent::OpenLibrary; -use strict; use warnings; -use OpenSRF::Utils::Logger qw/$logger/; -use OpenSRF::Utils::SettingsParser; -use OpenILS::WWW::AddedContent; -use OpenSRF::Utils::JSON; -use OpenSRF::EX qw/:try/; -use Data::Dumper; - -# Edit the <added_content> section of /openils/conf/opensrf.xml -# Change <module> to: -# <module>OpenILS::WWW::AddedContent::OpenLibrary</module> - -my $AC = 'OpenILS::WWW::AddedContent'; - -# These URLs are always the same for OpenLibrary, so there's no advantage to -# pulling from opensrf.xml; we hardcode them here -my $base_url = 'http://openlibrary.org/api/books?details=true&bibkeys=ISBN:'; -my $cover_base_url = 'http://covers.openlibrary.org/b/isbn/'; - -sub new { - my( $class, $args ) = @_; - $class = ref $class || $class; - return bless($args, $class); -} - -# -------------------------------------------------------------------------- -sub jacket_small { - my( $self, $key ) = @_; - return $self->send_img( - $self->fetch_cover_response('-S.jpg', $key)); -} - -sub jacket_medium { - my( $self, $key ) = @_; - return $self->send_img( - $self->fetch_cover_response('-M.jpg', $key)); - -} -sub jacket_large { - my( $self, $key ) = @_; - return $self->send_img( - $self->fetch_cover_response('-L.jpg', $key)); -} - -# -------------------------------------------------------------------------- - -=head1 - -OpenLibrary returns a JSON hash of zero or more book responses matching our -request. Each response may contain a table of contents within the details -section of the response. - -For now, we check only the first response in the hash for a table of -contents, and if we find a table of contents, we transform it to a simple -HTML table. - -=cut - -sub toc_html { - my( $self, $key ) = @_; - my $book_details_json = $self->fetch_response($key)->content(); - - - # Trim the "var _OlBookInfo = " declaration that makes this - # invalid JSON - $book_details_json =~ s/^.+?({.*?});$/$1/s; - - $logger->debug("$key: " . $book_details_json); - - my $toc_html; - - my $book_details = OpenSRF::Utils::JSON->JSON2perl($book_details_json); - my $book_key = (keys %$book_details)[0]; - - # We didn't find a matching book; short-circuit our response - if (!$book_key) { - $logger->debug("$key: no found book"); - return 0; - } - - my $toc_json = $book_details->{$book_key}->{details}->{table_of_contents}; - - # No table of contents is available for this book; short-circuit - if (!$toc_json or !scalar(@$toc_json)) { - $logger->debug("$key: no TOC"); - return 0; - } - - # Build a basic HTML table containing the section number, section title, - # and page number. Some rows may not contain section numbers, we should - # protect against empty page numbers too. - foreach my $chapter (@$toc_json) { - my $label = $chapter->{label}; - if ($label) { - $label .= '. '; - } - my $title = $chapter->{title} || ''; - my $page_number = $chapter->{pagenum} || ''; - - $toc_html .= '<tr>' . - "<td style='text-align: right;'>$label</td>" . - "<td style='text-align: left; padding-right: 2em;'>$title</td>" . - "<td style='text-align: right;'>$page_number</td>" . - "</tr>\n"; - } - - $logger->debug("$key: $toc_html"); - $self->send_html("<table>$toc_html</table>"); -} - -sub toc_json { - my( $self, $key ) = @_; - my $toc = $self->send_json( - $self->fetch_response($key) - ); -} - -sub send_img { - my($self, $response) = @_; - return { - content_type => $response->header('Content-type'), - content => $response->content, - binary => 1 - }; -} - -sub send_json { - my( $self, $content ) = @_; - return 0 unless $content; - - return { content_type => 'text/plain', content => $content }; -} - -sub send_html { - my( $self, $content ) = @_; - return 0 unless $content; - - # Hide anything that might contain a link since it will be broken - my $HTML = <<" HTML"; - <div> - <style type='text/css'> - div.ac input, div.ac a[href],div.ac img, div.ac button { display: none; visibility: hidden } - </style> - <div class='ac'> - $content - </div> - </div> - HTML - - return { content_type => 'text/html', content => $HTML }; -} - -# returns the HTTP response object from the URL fetch -sub fetch_response { - my( $self, $key ) = @_; - my $url = $base_url . "$key"; - my $response = $AC->get_url($url); - return $response; -} - -# returns the HTTP response object from the URL fetch -sub fetch_cover_response { - my( $self, $size, $key ) = @_; - my $url = $cover_base_url . "$key$size"; - return $AC->get_url($url); -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/AddedContent/Syndetic.pm b/Open-ILS/src/perlmods/OpenILS/WWW/AddedContent/Syndetic.pm deleted file mode 100644 index 6ae2a5ab64..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/AddedContent/Syndetic.pm +++ /dev/null @@ -1,262 +0,0 @@ -package OpenILS::WWW::AddedContent::Syndetic; -use strict; use warnings; -use OpenSRF::Utils::Logger qw/$logger/; -use OpenSRF::Utils::SettingsParser; -use OpenSRF::Utils::JSON; -use OpenSRF::EX qw/:try/; -use OpenILS::WWW::AddedContent; -use XML::LibXML; -use MIME::Base64; - -my $AC = 'OpenILS::WWW::AddedContent'; - - -sub new { - my( $class, $args ) = @_; - $class = ref $class || $class; - return bless($args, $class); -} - -sub base_url { - my $self = shift; - return $self->{base_url}; -} - -sub userid { - my $self = shift; - return $self->{userid}; -} - - -# -------------------------------------------------------------------------- -sub jacket_small { - my( $self, $key ) = @_; - return $self->send_img( - $self->fetch_response('sc.gif', $key, 1)); -} - -sub jacket_medium { - my( $self, $key ) = @_; - return $self->send_img( - $self->fetch_response('mc.gif', $key, 1)); - -} -sub jacket_large { - my( $self, $key ) = @_; - return $self->send_img( - $self->fetch_response('lc.gif', $key, 1)); -} - -# -------------------------------------------------------------------------- - -sub toc_html { - my( $self, $key ) = @_; - return $self->send_html( - $self->fetch_content('toc.html', $key)); -} - -sub toc_xml { - my( $self, $key ) = @_; - return $self->send_xml( - $self->fetch_content('toc.xml', $key)); -} - -sub toc_json { - my( $self, $key ) = @_; - return $self->send_json( - $self->fetch_content('toc.xml', $key)); -} - -# -------------------------------------------------------------------------- - -sub anotes_html { - my( $self, $key ) = @_; - return $self->send_html( - $self->fetch_content('anotes.html', $key)); -} - -sub anotes_xml { - my( $self, $key ) = @_; - return $self->send_xml( - $self->fetch_content('anotes.xml', $key)); -} - -sub anotes_json { - my( $self, $key ) = @_; - return $self->send_json( - $self->fetch_content('anotes.xml', $key)); -} - - -# -------------------------------------------------------------------------- - -sub excerpt_html { - my( $self, $key ) = @_; - return $self->send_html( - $self->fetch_content('dbchapter.html', $key)); -} - -sub excerpt_xml { - my( $self, $key ) = @_; - return $self->send_xml( - $self->fetch_content('dbchapter.xml', $key)); -} - -sub excerpt_json { - my( $self, $key ) = @_; - return $self->send_json( - $self->fetch_content('dbchapter.xml', $key)); -} - -# -------------------------------------------------------------------------- - -sub reviews_html { - my( $self, $key ) = @_; - - my %reviews; - - $reviews{ljreview} = $self->fetch_content('ljreview.html', $key); - $reviews{pwreview} = $self->fetch_content('pwreview.html', $key); - $reviews{slreview} = $self->fetch_content('slreview.html', $key); - $reviews{chreview} = $self->fetch_content('chreview.html', $key); - $reviews{blreview} = $self->fetch_content('blreview.html', $key); - $reviews{hbreview} = $self->fetch_content('hbreview.html', $key); - $reviews{kirkreview} = $self->fetch_content('kirkreview.html', $key); - - for(keys %reviews) { - if( ! $self->data_exists($reviews{$_}) ) { - delete $reviews{$_}; - next; - } - $reviews{$_} =~ s/<!.*?>//og; # Strip any doctype declarations - } - - return 0 if scalar(keys %reviews) == 0; - - #my $html = "<div>"; - my $html; - $html .= $reviews{$_} for keys %reviews; - #$html .= "</div>"; - - return $self->send_html($html); -} - -# we have to aggregate the reviews -sub reviews_xml { - my( $self, $key ) = @_; - my %reviews; - - $reviews{ljreview} = $self->fetch_content('ljreview.xml', $key); - $reviews{pwreview} = $self->fetch_content('pwreview.xml', $key); - $reviews{slreview} = $self->fetch_content('slreview.xml', $key); - $reviews{chreview} = $self->fetch_content('chreview.xml', $key); - $reviews{blreview} = $self->fetch_content('blreview.xml', $key); - $reviews{hbreview} = $self->fetch_content('hbreview.xml', $key); - $reviews{kirkreview} = $self->fetch_content('kirkreview.xml', $key); - - for(keys %reviews) { - if( ! $self->data_exists($reviews{$_}) ) { - delete $reviews{$_}; - next; - } - # Strip the xml and doctype declarations - $reviews{$_} =~ s/<\?xml.*?>//og; - $reviews{$_} =~ s/<!.*?>//og; - } - - return 0 if scalar(keys %reviews) == 0; - - my $xml = "<reviews>"; - $xml .= $reviews{$_} for keys %reviews; - $xml .= "</reviews>"; - - return $self->send_xml($xml); -} - - -sub reviews_json { - my( $self, $key ) = @_; - return $self->send_json( - $self->fetch_content('dbchapter.xml', $key)); -} - -# -------------------------------------------------------------------------- - - -sub data_exists { - my( $self, $data ) = @_; - return 0 if $data =~ m/<title>error<\/title>/iog; - return 1; -} - - -sub send_json { - my( $self, $xml ) = @_; - return 0 unless $self->data_exists($xml); - my $doc; - - try { - $doc = XML::LibXML->new->parse_string($xml); - } catch Error with { - my $err = shift; - $logger->error("added content XML parser error: $err\n\n$xml"); - $doc = undef; - }; - - return 0 unless $doc; - my $perl = OpenSRF::Utils::SettingsParser::XML2perl($doc->documentElement); - my $json = OpenSRF::Utils::JSON->perl2JSON($perl); - return { content_type => 'text/plain', content => $json }; -} - -sub send_xml { - my( $self, $xml ) = @_; - return 0 unless $self->data_exists($xml); - return { content_type => 'application/xml', content => $xml }; -} - -sub send_html { - my( $self, $content ) = @_; - return 0 unless $self->data_exists($content); - - # Hide anything that might contain a link since it will be broken - my $HTML = <<" HTML"; - <div> - <style type='text/css'> - div.ac input, div.ac a[href],div.ac img, div.ac button { display: none; visibility: hidden } - </style> - <div class='ac'> - $content - </div> - </div> - HTML - - return { content_type => 'text/html', content => $HTML }; -} - -sub send_img { - my($self, $response) = @_; - return { - content_type => $response->header('Content-type'), - content => $response->content, - binary => 1 - }; -} - -# returns the raw content returned from the URL fetch -sub fetch_content { - my( $self, $page, $key ) = @_; - return $self->fetch_response($page, $key)->content; -} - -# returns the HTTP response object from the URL fetch -sub fetch_response { - my( $self, $page, $key, $notype ) = @_; - my $uname = $self->userid; - my $url = $self->base_url . "?isbn=$key/$page&client=$uname" . (($notype) ? '' : "&type=rw12"); - return $AC->get_url($url); -} - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/BadDebt.pm b/Open-ILS/src/perlmods/OpenILS/WWW/BadDebt.pm deleted file mode 100644 index cb7c322d69..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/BadDebt.pm +++ /dev/null @@ -1,215 +0,0 @@ -package OpenILS::WWW::BadDebt; -use strict; -use warnings; -use bytes; - -use Apache2::Log; -use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log); -use APR::Const -compile => qw(:error SUCCESS); -use APR::Table; - -use Apache2::RequestRec (); -use Apache2::RequestIO (); -use Apache2::RequestUtil; -use CGI; - -use OpenSRF::EX qw(:try); -use OpenSRF::System; -use OpenSRF::AppSession; -use XML::LibXML; -use XML::LibXSLT; - -use Encode; -use Unicode::Normalize; -use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::Logger qw/$logger/; - -use UNIVERSAL::require; - -# set the bootstrap config when this module is loaded -my $bootstrap; - -sub import { - my $self = shift; - $bootstrap = shift; -} - - -sub child_init { - OpenSRF::System->bootstrap_client( config_file => $bootstrap ); -} - -sub handler { - my $r = shift; - my $cgi = new CGI; - my $auth_ses = $cgi->cookie('ses') || $cgi->param('ses'); - - # find some IDs ... - my @xacts; - - my $user = verify_login($auth_ses); - return 403 unless $user; - - my $mark_bad = $cgi->param('action') eq 'unmark' ? 'f' : 't'; - my $format = $cgi->param('format') || 'csv'; - - my $file = $cgi->param('idfile'); - if ($file) { - my $col = $cgi->param('idcolumn') || 0; - my $csv = new Text::CSV; - - while (<$file>) { - $csv->parse($_); - my @data = $csv->fields; - my $id = $data[$col]; - $id =~ s/\D+//o; - next unless ($id); - push @xacts, $id; - } - } - - if (!@xacts) { # try pathinfo - my $path_rec = $cgi->path_info(); - if ($path_rec) { - @xacts = map { $_ ? ($_) : () } split '/', $path_rec; - } - } - - return 404 unless @xacts; - - my @lines; - - my ($yr,$mon,$day) = (localtime())[5,4,3]; $yr += 1900; - my $date = sprintf('%d-%02d-%02d',$yr,$mon,$day); - - my @header = ( '"Transaction ID"', '"Message"', '"Amount Owed"', '"Transaction Start Date"', '"User Barcode"' ); - - my $cstore = OpenSRF::AppSession->create('open-ils.cstore'); - my $actor = OpenSRF::AppSession->create('open-ils.actor'); - - $cstore->connect(); - $cstore->request('open-ils.cstore.transaction.begin')->gather(1); - - for my $xact ( @xacts ) { - try { - - my $x = $cstore->request('open-ils.cstore.direct.money.billable_xact.retrieve' => $xact)->gather(1); - my $s = $cstore->request('open-ils.cstore.direct.money.billable_xact_summary.retrieve' => $xact)->gather(1); - my $u = $cstore->request('open-ils.cstore.direct.actor.usr.retrieve' => $s->usr)->gather(1); - my $c = $cstore->request('open-ils.cstore.direct.actor.card.retrieve' => $u->card)->gather(1); - my $w; - - if ($s->xact_type eq 'circulation') { - $w = $cstore->request('open-ils.cstore.direct.action.circulation.retrieve' => $xact)->gather(1)->circ_lib : - } elsif ($s->xact_type eq 'grocery') { - $w = $cstore->request('open-ils.cstore.direct.money.grocery.retrieve' => $xact)->gather(1)->billing_location; - } elsif ($s->xact_type eq 'reservation') { - $w = $cstore->request('open-ils.cstore.direct.booking.reservation.retrieve' => $xact)->gather(1)->pickup_lib; - } else { - die; - } - - my $failures = $actor->request('open-ils.actor.user.perm.check', $auth_ses, $user->id, $w, ['MARK_BAD_DEBT'])->gather(1); - - if (@$failures) { - push @lines, [ $xact, '"Permission Failure"', '""', '""', '""' ]; - } else { - $x->unrecovered($mark_bad); - my $result = $cstore->request('open-ils.cstore.direct.money.billable_xact.update' => $x)->gather(1); - if ($result != $x->id) { - push @lines, [ $xact, '"Update Failure"', '""', '""', '""' ]; - } else { - my $amount = $s->balance_owed; - my $start = $s->xact_start; - my $barcode = $c->barcode; - - if ( $mark_bad eq 't' ) { - push @lines, [ $xact, '"Marked Bad Debt"', $amount, "\"$start\"", "\"$barcode\"" ]; - } else { - push @lines, [ $xact, '"Unmarked Bad Debt"', $amount, "\"$start\"", "\"$barcode\"" ]; - } - } - } - } otherwise { - push @lines, [ $xact, '"Update Failure"', '""', '""', '""' ]; - }; - } - - $cstore->request('open-ils.cstore.transaction.commit')->gather(1); - $cstore->disconnect(); - - if ($format eq 'csv') { - $r->headers_out->set("Content-Disposition" => "inline; filename=bad_debt_$date.csv"); - $r->content_type('application/octet-stream'); - - $r->print( join(',', @header) . "\n" ); - $r->print( join(',', @$_ ) . "\n" ) for (@lines); - - } elsif ($format eq 'json') { - - $r->content_type('application/json'); - - $r->print( '[' ); - - my $first = 1; - for my $line ( @lines ) { - $r->print( ',' ) if $first; - $first = 0; - - $r->print( '{' ); - for my $field ( 0 .. 4 ) { - $r->print( "$header[$field] : $$line[$field]" ); - $r->print( ',' ) if ($field < 4); - } - $r->print( '}' ); - } - - $r->print( ']' ); - } - - return Apache2::Const::OK; - -} - -sub verify_login { - my $auth_token = shift; - return undef unless $auth_token; - - my $user = OpenSRF::AppSession - ->create("open-ils.auth") - ->request( "open-ils.auth.session.retrieve", $auth_token ) - ->gather(1); - - if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) { - return undef; - } - - return $user if ref($user); - return undef; -} - -sub show_template { - my $r = shift; - - $r->content_type('text/html'); - $r->print(<<HTML); - -<html> - <head> - <title>Record Export - - -
- Use field number (starting from 0) - from CSV file - -
- - - -HTML - - return Apache2::Const::OK; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/EGWeb.pm b/Open-ILS/src/perlmods/OpenILS/WWW/EGWeb.pm deleted file mode 100644 index 42eb6ffbf7..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/EGWeb.pm +++ /dev/null @@ -1,230 +0,0 @@ -package OpenILS::WWW::EGWeb; -use strict; use warnings; -use Template; -use XML::Simple; -use XML::LibXML; -use File::stat; -use Apache2::Const -compile => qw(OK DECLINED HTTP_INTERNAL_SERVER_ERROR); -use Apache2::Log; -use OpenSRF::EX qw(:try); - -use constant OILS_HTTP_COOKIE_SKIN => 'oils:skin'; -use constant OILS_HTTP_COOKIE_THEME => 'oils:theme'; -use constant OILS_HTTP_COOKIE_LOCALE => 'oils:locale'; - -my $web_config; -my $web_config_file; -my $web_config_edit_time; - -sub import { - my $self = shift; - $web_config_file = shift; - unless(-r $web_config_file) { - warn "Invalid web config $web_config_file"; - return; - } - check_web_config(); -} - - -sub handler { - my $r = shift; - check_web_config($r); # option to disable this - my $ctx = load_context($r); - my $base = $ctx->{base_path}; - my($template, $page_args, $as_xml) = find_template($r, $base, $ctx); - return Apache2::Const::DECLINED unless $template; - - $template = $ctx->{skin} . "/$template"; - $ctx->{page_args} = $page_args; - $r->content_type('text/html; encoding=utf8'); - - my $tt = Template->new({ - OUTPUT => ($as_xml) ? sub { parse_as_xml($r, $ctx, @_); } : $r, - INCLUDE_PATH => $ctx->{template_paths}, - }); - - unless($tt->process($template, {ctx => $ctx})) { - $r->log->warn('Template error: ' . $tt->error); - return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR; - } - - return Apache2::Const::OK; -} - -sub parse_as_xml { - my $r = shift; - my $ctx = shift; - my $data = shift; - - my $success = 0; - - try { - my $doc = XML::LibXML->new->parse_string($data); - $data = $doc->documentElement->toStringC14N; - $data = $ctx->{final_dtd} . "\n" . $data; - $success = 1; - } otherwise { - my $e = shift; - my $err = "Invalid XML: $e"; - $r->log->error($err); - $r->content_type('text/plain; encoding=utf8'); - $r->print("\n$err\n\n$data"); - }; - - $r->print($data) if ($success); -} - - -sub load_context { - my $r = shift; - my $cgi = CGI->new; - my $ctx = $web_config->{ctx}; - $ctx->{hostname} = $r->hostname; - $ctx->{base_url} = $cgi->url(-base => 1); - $ctx->{skin} = $cgi->cookie(OILS_HTTP_COOKIE_SKIN) || 'default'; - $ctx->{theme} = $cgi->cookie(OILS_HTTP_COOKIE_THEME) || 'default'; - $ctx->{locale} = - $cgi->cookie(OILS_HTTP_COOKIE_LOCALE) || - parse_accept_lang($r->headers_in->get('Accept-Language')) || 'en-US'; - $r->log->debug('skin = ' . $ctx->{skin} . ' : theme = ' . - $ctx->{theme} . ' : locale = ' . $ctx->{locale}); - return $ctx; -} - -# turn Accept-Language into sometihng EG can understand -sub parse_accept_lang { - my $al = shift; - return undef unless $al; - my ($locale) = split(/,/, $al); - ($locale) = split(/;/, $locale); - return undef unless $locale; - $locale =~ s/-(.*)/eval '-'.uc("$1")/e; - return $locale; -} - -# Given a URI, finds the configured template and any extra page -# arguments (trailing path info). Any extra data is returned -# as page arguments, in the form of an array, one item per -# /-separated URI component -sub find_template { - my $r = shift; - my $base = shift; - my $ctx = shift; - my $skin = $ctx->{skin}; - my $path = $r->uri; - $path =~ s/$base//og; - my @parts = split('/', $path); - my $template = ''; - my $page_args = []; - my $as_xml = $ctx->{force_valid_xml}; - my $handler = $web_config->{handlers}; - - while(@parts) { - my $part = shift @parts; - next unless $part; - my $t = $handler->{$part}; - if(ref($t) eq 'PathConfig') { - $template = $t->{template}; - $as_xml = ($t->{as_xml} and $t->{as_xml} =~ /true/io) || $as_xml; - $page_args = [@parts]; - last; - } else { - $handler = $t; - } - } - - unless($template) { # no template configured - - # see if we can magically find the template based on the path and default extension - my $ext = $ctx->{default_template_extension}; - - my @parts = split('/', $path); - my $localpath = $path; - my @args; - while(@parts) { - last unless $localpath; - for my $tpath (@{$ctx->{template_paths}}) { - my $fpath = "$tpath/$skin/$localpath.$ext"; - $r->log->debug("looking at possible template $fpath"); - if(-r $fpath) { - $template = "$localpath.$ext"; - last; - } - } - last if $template; - push(@args, pop @parts); - $localpath = '/'.join('/', @parts); - } - - $page_args = [@args]; - - # no template configured or found - unless($template) { - $r->log->warn("No template configured for path $path"); - return (); - } - } - - $r->log->debug("template = $template : page args = @$page_args"); - return ($template, $page_args, $as_xml); -} - -# if the web configuration file has never been loaded or has -# changed since the last load, reload it -sub check_web_config { - my $r = shift; - my $epoch = stat($web_config_file)->mtime; - unless($web_config_edit_time and $web_config_edit_time == $epoch) { - $r->log->debug("Reloading web config after edit...") if $r; - $web_config_edit_time = $epoch; - $web_config = parse_config($web_config_file); - } -} - -sub parse_config { - my $cfg_file = shift; - my $data = XML::Simple->new->XMLin($cfg_file); - my $ctx = {}; - my $handlers = {}; - - $ctx->{media_prefix} = (ref $data->{media_prefix}) ? '' : $data->{media_prefix}; - $ctx->{base_path} = (ref $data->{base_path}) ? '' : $data->{base_path}; - $ctx->{template_paths} = []; - $ctx->{force_valid_xml} = ($data->{force_valid_xml} =~ /true/io) ? 1 : 0; - $ctx->{default_template_extension} = $data->{default_template_extension} || 'tt2'; - $ctx->{web_dir} = $data->{web_dir}; - - my $tpaths = $data->{template_paths}->{path}; - $tpaths = [$tpaths] unless ref $tpaths; - push(@{$ctx->{template_paths}}, $_) for @$tpaths; - - for my $handler (@{$data->{handlers}->{handler}}) { - my @parts = split('/', $handler->{path}); - my $h = $handlers; - my $pcount = scalar(@parts); - for(my $i = 0; $i < $pcount; $i++) { - my $p = $parts[$i]; - unless(defined $h->{$p}) { - if($i == $pcount - 1) { - $h->{$p} = PathConfig->new(%$handler); - last; - } else { - $h->{$p} = {}; - } - } - $h = $h->{$p}; - } - } - - return {ctx => $ctx, handlers => $handlers}; -} - -package PathConfig; -sub new { - my($class, %args) = @_; - return bless(\%args, $class); -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/Exporter.pm b/Open-ILS/src/perlmods/OpenILS/WWW/Exporter.pm deleted file mode 100644 index 8234d1cfeb..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/Exporter.pm +++ /dev/null @@ -1,347 +0,0 @@ -package OpenILS::WWW::Exporter; -use strict; -use warnings; -use bytes; - -use Apache2::Log; -use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log); -use APR::Const -compile => qw(:error SUCCESS); -use APR::Table; - -use Apache2::RequestRec (); -use Apache2::RequestIO (); -use Apache2::RequestUtil; -use CGI; -use Data::Dumper; -use Text::CSV; - -use OpenSRF::EX qw(:try); -use OpenSRF::Utils qw/:datetime/; -use OpenSRF::Utils::Cache; -use OpenSRF::System; -use OpenSRF::AppSession; -use XML::LibXML; -use XML::LibXSLT; - -use Encode; -use Unicode::Normalize; -use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::Logger qw/$logger/; - -use MARC::Record; -use MARC::File::XML; - -use UNIVERSAL::require; - -our @formats = qw/USMARC UNIMARC XML BRE/; - -# set the bootstrap config and template include directory when -# this module is loaded -my $bootstrap; - -sub import { - my $self = shift; - $bootstrap = shift; -} - - -sub child_init { - OpenSRF::System->bootstrap_client( config_file => $bootstrap ); -} - -sub handler { - my $r = shift; - my $cgi = new CGI; - - # find some IDs ... - my @records; - - @records = map { $_ ? ($_) : () } $cgi->param('id'); - - if (!@records) { # try for a file - my $file = $cgi->param('idfile'); - if ($file) { - my $col = $cgi->param('idcolumn') || 0; - my $csv = new Text::CSV; - - while (<$file>) { - $csv->parse($_); - my @data = $csv->fields; - my $id = $data[$col]; - $id =~ s/\D+//o; - next unless ($id); - push @records, $id; - } - } - } - - if (!@records) { # try pathinfo - my $path_rec = $cgi->path_info(); - if ($path_rec) { - @records = map { $_ ? ($_) : () } split '/', $path_rec; - } - } - - my $ses = OpenSRF::AppSession->create('open-ils.cstore'); - - # still no records ... - my $container = $cgi->param('containerid'); - if ($container) { - my $bucket = $ses->request( 'open-ils.cstore.direct.container.biblio_record_entry_bucket.retrieve', $container )->gather(1); - unless($bucket) { - $r->log->error("No such bucket $container"); - $logger->error("No such bucket $container"); - return Apache2::Const::NOT_FOUND; - } - if ($bucket->pub !~ /t|1/oi) { - my $authid = $cgi->cookie('ses') || $cgi->param('ses'); - my $auth = verify_login($authid); - if (!$auth) { - return 403; - } - } - my $recs = $ses->request( 'open-ils.cstore.direct.container.biblio_record_entry_bucket_item.search.atomic', { bucket => $container } )->gather(1); - @records = map { ($_->target_biblio_record_entry) } @$recs; - } - - return show_template($r) unless (@records); - - my $type = $cgi->param('rectype') || 'biblio'; - if ($type ne 'biblio' && $type ne 'authority') { - return 400; - } - - my $tcn_v = 'tcn_value'; - my $tcn_s = 'tcn_source'; - - my $holdings = $cgi->param('holdings') if ($type eq 'biblio'); - my $location = $cgi->param('location') || 'gaaagpl'; # just because... - - my $format = $cgi->param('format') || 'USMARC'; - $format = uc($format); - - my $encoding = $cgi->param('encoding') || 'UTF-8'; - $encoding = uc($encoding); - - my $filename = $cgi->param('filename') || "export.$type.$encoding.$format"; - - binmode(STDOUT, ':raw') if ($encoding ne 'UTF-8'); - binmode(STDOUT, ':utf8') if ($encoding eq 'UTF-8'); - - if (!grep { uc($format) eq $_ } @formats) { - return 400; - } - - if ($format ne 'XML') { - my $ftype = 'MARC::File::' . $format; - $ftype->require; - } - - - $r->headers_out->set("Content-Disposition" => "inline; filename=$filename"); - - if (uc($format) eq 'XML') { - $r->content_type('application/xml'); - } else { - $r->content_type('application/octet-stream'); - } - - $r->print( <<" HEADER" ) if (uc($format) eq 'XML'); - - - HEADER - - my %orgs; - my %shelves; - my %statuses; - - my $flesh = {}; - if ($holdings) { - - my $req = $ses->request( 'open-ils.cstore.direct.actor.org_unit.search', { id => { '!=' => undef } } ); - - while (my $o = $req->recv) { - next if ($req->failed); - $o = $o->content; - last unless ($o); - $orgs{$o->id} = $o; - } - $req->finish; - - $req = $ses->request( 'open-ils.cstore.direct.asset.copy_location.search', { id => { '!=' => undef } } ); - - while (my $s = $req->recv) { - next if ($req->failed); - $s = $s->content; - last unless ($s); - $shelves{$s->id} = $s; - } - $req->finish; - - $req = $ses->request( 'open-ils.cstore.direct.config.copy_status.search', { id => { '!=' => undef } } ); - - while (my $s = $req->recv) { - next if ($req->failed); - $s = $s->content; - last unless ($s); - $statuses{$s->id} = $s; - } - $req->finish; - - $flesh = { flesh => 2, flesh_fields => { bre => [ 'call_numbers' ], acn => [ 'copies' ] } }; - } - - for my $i ( @records ) { - my $bib; - try { - local $SIG{ALRM} = sub { die "TIMEOUT\n" }; - alarm(1); - $bib = $ses->request( "open-ils.cstore.direct.$type.record_entry.retrieve", $i, $flesh )->gather(1); - alarm(0); - } otherwise { - warn "\n!!!!!! Timed out trying to read record $i\n"; - }; - alarm(0); - - next unless $bib; - - if (uc($format) eq 'BRE') { - $r->print( OpenSRF::Utils::JSON->perl2JSON($bib) . "\n" ); - next; - } - - try { - - my $req = MARC::Record->new_from_xml( $bib->marc, $encoding, $format ); - $req->encoding($encoding) if ($encoding eq 'UTF-8'); - - if ($holdings) { - $req->delete_field( $_ ) for ($req->field('852')); # remove any legacy 852s - my $cn_list = $bib->call_numbers; - if ($cn_list && @$cn_list) { - - my $cp_list = [ map { @{ $_->copies } } @$cn_list ]; - if ($cp_list && @$cp_list) { - - my %cn_map; - push @{$cn_map{$_->call_number}}, $_ for (@$cp_list); - - for my $cn ( @$cn_list ) { - my $cn_map_list = $cn_map{$cn->id}; - - for my $cp ( @$cn_map_list ) { - - $req->append_fields( - MARC::Field->new( - 852, '4', '', - a => $location, - b => $orgs{$cn->owning_lib}->shortname, - b => $orgs{$cp->circ_lib}->shortname, - c => $shelves{$cp->location}->name, - j => $cn->label, - ($cp->circ_modifier ? ( g => $cp->circ_modifier ) : ()), - p => $cp->barcode, - ($cp->price ? ( y => $cp->price ) : ()), - ($cp->copy_number ? ( t => $cp->copy_number ) : ()), - ($cp->ref eq 't' ? ( x => 'reference' ) : ( x => 'nonreference' )), - ($cp->holdable eq 'f' ? ( x => 'unholdable' ) : ( x => 'holdable' )), - ($cp->circulate eq 'f' ? ( x => 'noncirculating' ) : ( x => 'circulating' )), - ($cp->opac_visible eq 'f' ? ( x => 'hidden' ) : ( x => 'visible' )), - z => $statuses{$cp->status}->name, - ) - ); - - } - } - } - } - } - - if (uc($format) eq 'XML') { - my $x = $req->as_xml_record; - $x =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o; - $r->print($x); - } elsif (uc($format) eq 'UNIMARC') { - $r->print($req->as_usmarc); - } elsif (uc($format) eq 'USMARC') { - $r->print($req->as_usmarc); - } - - $r->rflush(); - - } otherwise { - my $e = shift; - warn "\n$e\n"; - }; - - } - - $r->print("\n") if ($format eq 'XML'); - - return Apache2::Const::OK; - -} - -sub verify_login { - my $auth_token = shift; - return undef unless $auth_token; - - my $user = OpenSRF::AppSession - ->create("open-ils.auth") - ->request( "open-ils.auth.session.retrieve", $auth_token ) - ->gather(1); - - if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) { - return undef; - } - - return $user if ref($user); - return undef; -} - -sub show_template { - my $r = shift; - - $r->content_type('text/html'); - $r->print(< - - Record Export - - -
- Use field number (starting from 0) - from CSV file -

or

- Record ID -

Record Type: - -
Record Format: - -
Record Encoding: - -
Include holdings in Bibliographic Records: - -

-
- - - -HTML - - return Apache2::Const::OK; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/IDL2js.pm b/Open-ILS/src/perlmods/OpenILS/WWW/IDL2js.pm deleted file mode 100644 index ee5b2ef255..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/IDL2js.pm +++ /dev/null @@ -1,79 +0,0 @@ -package OpenILS::WWW::IDL2js; -use strict; use warnings; -use XML::LibXML; -use XML::LibXSLT; -use Apache2::Const -compile => qw(OK DECLINED HTTP_INTERNAL_SERVER_ERROR); -use Error qw/:try/; -use OpenSRF::System; -use OpenSRF::Utils::SettingsClient; - -my $bs_config; -my $stylesheet; -my $idl_doc; - - -# load and parse the stylesheet -sub import { - my $self = shift; - $bs_config = shift; -} - -# parse the IDL, loaded from the network -my $__initted = 0; -sub child_init { - $__initted = 1; - - OpenSRF::System->bootstrap_client(config_file => $bs_config); - my $sclient = OpenSRF::Utils::SettingsClient->new(); - - my $xsl_file = $sclient->config_value('IDL2js'); - - unless($xsl_file) { - warn "XSL2js XSL file required for IDL2js Apache module\n"; - return; - } - - $xsl_file = $sclient->config_value(dirs => 'xsl')."/$xsl_file"; - my $idl_file = $sclient->config_value("IDL"); - - my $xslt = XML::LibXSLT->new(); - - try { - - my $style_doc = XML::LibXML->load_xml(location => $xsl_file, no_cdata=>1); - $stylesheet = $xslt->parse_stylesheet($style_doc); - - } catch Error with { - my $e = shift; - warn "Invalid XSL File: $xsl_file: $e\n"; - }; - - $idl_doc = XML::LibXML->load_xml(location => $idl_file); -} - - -sub handler { - my $r = shift; - my $args = $r->args || ''; - child_init() unless $__initted; - - return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR unless $stylesheet and $idl_doc; - return Apache2::Const::DECLINED if $args and $args !~ /^[a-zA-Z,]*$/; - - my $output; - try { - my $results = $stylesheet->transform($idl_doc, class_list => "'$args'"); - $output = $stylesheet->output_as_bytes($results); - } catch Error with { - my $e = shift; - $r->log->error("IDL XSL Error: $e"); - }; - - return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR unless $output; - - $r->content_type('application/x-javascript; encoding=utf8'); - $r->print($output); - return Apache2::Const::OK; -} - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/Method.pm b/Open-ILS/src/perlmods/OpenILS/WWW/Method.pm deleted file mode 100644 index c5dc94c55a..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/Method.pm +++ /dev/null @@ -1,161 +0,0 @@ -package OpenILS::WWW::Method; -use strict; use warnings; - -use Apache2::Log; -use Apache2::Const -compile => qw(OK REDIRECT :log); -use APR::Const -compile => qw(:error SUCCESS); -use Apache2::RequestRec (); -use Apache2::RequestIO (); -use Apache2::RequestUtil; - -use OpenSRF::Utils::JSON; - -use CGI (); - -use OpenSRF::EX qw(:try); -use OpenSRF::System; - -my %session_hash; - -use constant MAX_SESSION_REQUESTS => 20; - -sub handler { - - use Data::Dumper; - - - my $apache = shift; - my $cgi = CGI->new( $apache ); - - print "Content-type: text/plain; charset=utf-8\n\n"; - #print $cgi->header; - - my @p = $cgi->param(); - warn "Params: " . Dumper(\@p); - - my $method = $cgi->param("method"); - my $service = $cgi->param("service"); - - my $err = undef; - - if( ! $service || ! $method ) { - $err = { - is_err => 1, - err_msg => "Service name and method name required to fulfill request", - }; - } - - if($err) { - print OpenSRF::Utils::JSON->perl2JSON($err); - return Apache2::Const::OK; - } - - my @param_array; - my %param_hash; - - warn "here\n"; - - if(defined($cgi->param("param"))) { - for my $param ( $cgi->param("param")) { - push( @param_array, OpenSRF::Utils::JSON->JSON2perl( $param )); - } - } else { - for my $param ($cgi->param()) { - $param_hash{$param} = OpenSRF::Utils::JSON->JSON2perl($cgi->param($param)) - unless( $param eq "method" or $param eq "service" ); - } - } - - - if( @param_array ) { - perform_method($service, $method, @param_array); - } else { - perform_method($service, $method, %param_hash); - } - - return Apache2::Const::OK; -} - -sub child_init_handler { - OpenSRF::System->bootstrap_client( - config_file => "SYSCONFDIR/opensrf_core.xml" ); -} - - -sub perform_method { - - my ($service, $method, @params) = @_; - - warn "performing method $method for service $service with params @params\n"; - - my $session; - - if($session_hash{$service} ) { - - $session = $session_hash{$service}; - $session->{web_count} += 1; - - if( $session->{web_count} > MAX_SESSION_REQUESTS) { - $session->disconnect(); - $session->{web_count} = 1; - } - - } else { - - $session = OpenSRF::AppSession->create($service); - $session_hash{$service} = $session; - $session->{web_count} = 1; - - } - - my $request = $session->request( $method, @params ); - - my @results; - while( my $response = $request->recv(20) ) { - - if( UNIVERSAL::isa( $response, "Error" )) { - warn "Received exception: " . $response->stringify . "\n"; - my $err = { - is_err => 1, - err_msg => "Error Completing Request:\n " . - "Service: $service \nMethod: $method \nParams: @params \n" . - $response->stringify() . "\n", - }; - print OpenSRF::Utils::JSON->perl2JSON($err); - $request->finish(); - return 0; - } - - my $content = $response->content; - push @results, $content; - } - - - if(!$request->complete) { - warn "ERROR Completing Request"; - my $err = { - is_err => 1, - err_msg => "Error Completing Request:\n ". - "Service: $service \nMethod: $method \nParams: @params \n" . - "request->complete test failed in OpenILS::Web::Method\n" - }; - print OpenSRF::Utils::JSON->perl2JSON($err); - $request->finish(); - return 0; - } - - $request->finish(); - $session->finish(); - - warn "Results: \n"; - warn Dumper \@results; - - print OpenSRF::Utils::JSON->perl2JSON( \@results ); - - return 1; -} - -# This module appears unfinshed and/or obsolete with many unconditional warns/dumps. -# File is not referenced elsewhere in the codebase. Candidate for deletion. - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/PasswordReset.pm b/Open-ILS/src/perlmods/OpenILS/WWW/PasswordReset.pm deleted file mode 100644 index 17ec3059f0..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/PasswordReset.pm +++ /dev/null @@ -1,218 +0,0 @@ -package OpenILS::WWW::PasswordReset; - -# Copyright (C) 2010 Laurentian University -# Dan Scott -# -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. - -use strict; use warnings; - -use Apache2::Log; -use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log); -use APR::Const -compile => qw(:error SUCCESS); -use Apache2::RequestRec (); -use Apache2::RequestIO (); -use Apache2::RequestUtil; -use CGI; -use Template; - -use OpenSRF::EX qw(:try); -use OpenSRF::Utils qw/:datetime/; -use OpenSRF::Utils::Cache; -use OpenSRF::System; -use OpenSRF::AppSession; - -use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::Logger qw/$logger/; -use OpenILS::Application::AppUtils; -use OpenILS::Utils::CStoreEditor qw/:funcs/; - -my $log = 'OpenSRF::Utils::Logger'; -my $U = 'OpenILS::Application::AppUtils'; - -my ($bootstrap, $actor, $templates); -my $i18n = {}; -my $init_done = 0; # has child_init been called? - -sub import { - my $self = shift; - $bootstrap = shift; -} - -sub child_init { - OpenSRF::System->bootstrap_client( config_file => $bootstrap ); - - my $conf = OpenSRF::Utils::SettingsClient->new(); - my $idl = $conf->config_value("IDL"); - Fieldmapper->import(IDL => $idl); - $templates = $conf->config_value("dirs", "templates"); - $actor = OpenSRF::AppSession->create('open-ils.actor'); - load_i18n(); - $init_done = 1; -} - -sub password_reset { - my $apache = shift; - - child_init() unless $init_done; - - return Apache2::Const::DECLINED if (-e $apache->filename); - - $apache->content_type('text/html'); - - my $cgi = new CGI; - my $ctx = {}; - - $ctx->{'uri'} = $apache->uri; - - # Get our locale from the URL - (my $locale = $apache->path_info) =~ s{^.*?/([a-z]{2}-[A-Z]{2})/.*?$}{$1}; - if (!$locale) { - $locale = 'en-US'; - } - - # If locale exists, use it; otherwise fall back to en-US - if (exists $i18n->{$locale}) { - $ctx->{'i18n'} = $i18n->{$locale}; - } else { - $ctx->{'i18n'} = $i18n->{'en-US'}; - } - - my $tt = Template->new({ - INCLUDE_PATH => $templates - }) || die "$Template::ERROR\n"; - - # Get our UUID: if no UUID, then display barcode / username / email prompt - (my $uuid = $apache->path_info) =~ s{^/$locale/([^/]*?)$}{$1}; - $logger->info("Password reset: UUID = $uuid"); - - if (!$uuid) { - request_password_reset($apache, $cgi, $tt, $ctx); - } else { - reset_password($apache, $cgi, $tt, $ctx, $uuid); - } -} - -sub reset_password { - my ($apache, $cgi, $tt, $ctx, $uuid) = @_; - - my $password_1 = $cgi->param('pwd1'); - my $password_2 = $cgi->param('pwd2'); - - $ctx->{'title'} = $ctx->{'i18n'}{'TITLE'}; - $ctx->{'password_prompt'} = $ctx->{'i18n'}{'PASSWORD_PROMPT'}; - $ctx->{'password_prompt2'} = $ctx->{'i18n'}{'PASSWORD_PROMPT2'}; - - # In case non-matching passwords slip through our funky Web interface - if ($password_1 and $password_2 and ($password_1 ne $password_2)) { - $ctx->{'status'} = { - style => 'error', - msg => $ctx->{'i18n'}{'NO_MATCH'} - }; - $tt->process('password-reset/reset-form.tt2', $ctx) - || die $tt->error(); - return Apache2::Const::OK; - } - - if ($password_1 and $password_2 and ($password_1 eq $password_2)) { - my $response = $actor->request('open-ils.actor.patron.password_reset.commit', $uuid, $password_1)->gather(); - if (ref($response) && $response->{'textcode'}) { - - if ($response->{'textcode'} eq 'PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST') { - $ctx->{'status'} = { - style => 'error', - msg => $ctx->{'i18n'}{'NOT_ACTIVE'} - - }; - } - if ($response->{'textcode'} eq 'PATRON_PASSWORD_WAS_NOT_STRONG') { - $ctx->{'status'} = { - style => 'error', - msg => $ctx->{'i18n'}{'NOT_STRONG'} - - }; - } - $tt->process('password-reset/reset-form.tt2', $ctx) - || die $tt->error(); - return Apache2::Const::OK; - } - $ctx->{'status'} = { - style => 'success', - msg => $ctx->{'i18n'}{'SUCCESS'} - }; - } - - # Either the password change was successful, or this is their first time through - $tt->process('password-reset/reset-form.tt2', $ctx) - || die $tt->error(); - - return Apache2::Const::OK; -} - -# Load our localized strings - lame, need to convert to Locale::Maketext -sub load_i18n { - foreach my $string_bundle (glob("$templates/password-reset/strings.*")) { - open(I18NFH, '<', $string_bundle); - (my $locale = $string_bundle) =~ s/^.*\.([a-z]{2}-[A-Z]{2})$/$1/; - $logger->debug("Loaded locale [$locale] from file: [$string_bundle]"); - while() { - my ($string_id, $string) = ($_ =~ m/^(.+?)=(.*?)$/); - $i18n->{$locale}{$string_id} = $string; - } - close(I18NFH); - } -} - -sub request_password_reset { - my ($apache, $cgi, $tt, $ctx) = @_; - - my $barcode = $cgi->param('barcode'); - my $username = $cgi->param('username'); - my $email = $cgi->param('email'); - - if (!($barcode or $username or $email)) { - $ctx->{'status'} = { - style => 'plain', - msg => $ctx->{'i18n'}{'IDENTIFY_YOURSELF'} - }; - $tt->process('password-reset/request-form.tt2', $ctx) - || die $tt->error(); - return Apache2::Const::OK; - } elsif ($barcode) { - my $response = $actor->request('open-ils.actor.patron.password_reset.request', 'barcode', $barcode)->gather(); - $ctx->{'status'} = { - style => 'plain', - msg => $ctx->{'i18n'}{'REQUEST_SUCCESS'} - }; - # Hide form - $tt->process('password-reset/request-form.tt2', $ctx) - || die $tt->error(); - return Apache2::Const::OK; - } elsif ($username) { - my $response = $actor->request('open-ils.actor.patron.password_reset.request', 'username', $username)->gather(); - $ctx->{'status'} = { - style => 'plain', - msg => $ctx->{'i18n'}{'REQUEST_SUCCESS'} - }; - # Hide form - $tt->process('password-reset/request-form.tt2', $ctx) - || die $tt->error(); - return Apache2::Const::OK; - } -} - -1; - -# vim: et:ts=4:sw=4 diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/Proxy.pm b/Open-ILS/src/perlmods/OpenILS/WWW/Proxy.pm deleted file mode 100644 index 6c5f3da40d..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/Proxy.pm +++ /dev/null @@ -1,199 +0,0 @@ -package OpenILS::WWW::Proxy; -use strict; use warnings; - -use Apache2::Log; -use Apache2::Const -compile => qw(REDIRECT FORBIDDEN OK NOT_FOUND DECLINED :log); -use APR::Const -compile => qw(:error SUCCESS); -use CGI; -use Data::Dumper; -use Digest::MD5 qw/md5_hex/; - -use OpenSRF::EX qw(:try); -use OpenSRF::System; - - -# set the bootstrap config and template include directory when -# this module is loaded -my $bootstrap; -my $ssl_off; - -my $default_template = < - - TITLE - - -


-
-
- - - - - - - - - - - - -
DESCRIPTION
Username or barcode:
Password:
- -
-
- - -HTML - -sub import { - my $self = shift; - $bootstrap = shift; - $ssl_off = shift; -} - - -sub child_init { - OpenSRF::System->bootstrap_client( config_file => $bootstrap ); -} - -sub handler { - my $apache = shift; - - my $proxyhtml = $apache->dir_config('OILSProxyHTML'); - my $title = $apache->dir_config('OILSProxyTitle'); - my $desc = $apache->dir_config('OILSProxyDescription'); - my $ltype = $apache->dir_config('OILSProxyLoginType'); - my $perms = [ split ' ', $apache->dir_config('OILSProxyPermissions') ]; - - return Apache2::Const::NOT_FOUND unless ($title || $proxyhtml); - return Apache2::Const::NOT_FOUND unless (@$perms); - - my $cgi = new CGI; - my $auth_ses = $cgi->cookie('ses') || $cgi->param('ses'); - my $ws_ou = $apache->dir_config('OILSProxyLoginOU') || $cgi->cookie('ws_ou') || $cgi->param('ws_ou'); - - my $url = $cgi->url; - - # push everyone to the secure site - if (!$ssl_off && $url =~ /^http:/o) { - my $base = $cgi->url(-base=>1); - $base =~ s/^http:/https:/o; - print "Location: $base".$apache->unparsed_uri."\n\n"; - return Apache2::Const::REDIRECT; - } - - if (!$auth_ses) { - my $u = $cgi->param('user'); - my $p = $cgi->param('passwd'); - - if (!$u) { - - print $cgi->header(-type=>'text/html', -expires=>'-1d'); - if (!$proxyhtml) { - $proxyhtml = $default_template; - $proxyhtml =~ s/TITLE/$title/gso; - $proxyhtml =~ s/DESCRIPTION/$desc/gso; - } else { - # XXX template toolkit?? - } - - print $proxyhtml; - return Apache2::Const::OK; - } - - $auth_ses = oils_login($u, $p, $ltype); - if ($auth_ses) { - print $cgi->redirect( - -uri=> $apache->unparsed_uri, - -cookie=>$cgi->cookie( - -name=>'ses', - -value=>$auth_ses, - -path=>'/' - ) - ); - return Apache2::Const::REDIRECT; - } else { - return back_to_login($apache, $cgi); - } - } - - my $user = verify_login($auth_ses); - return back_to_login($apache, $cgi) unless $user; - - $ws_ou ||= $user->home_ou; - - warn "Checking perms " . join(',', @$perms) . " for user " . $user->id . " at location $ws_ou\n"; - - my $failures = OpenSRF::AppSession - ->create('open-ils.actor') - ->request('open-ils.actor.user.perm.check', $auth_ses, $user->id, $ws_ou, $perms) - ->gather(1); - - return back_to_login($apache, $cgi) if (@$failures > 0); - - # they're good, let 'em through - return Apache2::Const::DECLINED; -} - -sub back_to_login { - my $apache = shift; - my $cgi = shift; - print $cgi->redirect( - -uri=>$apache->unparsed_uri, - -cookie=>$cgi->cookie( - -name=>'ses', - -value=>'', - -path=>'/',-expires=>'-1h' - ) - ); - return Apache2::Const::REDIRECT; -} - -# returns the user object if the session is valid, 0 otherwise -sub verify_login { - my $auth_token = shift; - return undef unless $auth_token; - - my $user = OpenSRF::AppSession - ->create("open-ils.auth") - ->request( "open-ils.auth.session.retrieve", $auth_token ) - ->gather(1); - - if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) { - return undef; - } - - return $user if ref($user); - return undef; -} - -sub oils_login { - my( $username, $password, $type ) = @_; - - $type |= "staff"; - my $nametype = 'username'; - $nametype = 'barcode' if ($username =~ /^\d+$/o); - - my $seed = OpenSRF::AppSession - ->create("open-ils.auth") - ->request( 'open-ils.auth.authenticate.init', $username ) - ->gather(1); - - return undef unless $seed; - - my $response = OpenSRF::AppSession - ->create("open-ils.auth") - ->request( 'open-ils.auth.authenticate.complete', - { $nametype => $username, - password => md5_hex($seed . md5_hex($password)), - type => $type }) - ->gather(1); - - return undef unless $response; - - return $response->{payload}->{authtoken}; -} - -1; - diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/Redirect.pm b/Open-ILS/src/perlmods/OpenILS/WWW/Redirect.pm deleted file mode 100644 index b4854773e6..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/Redirect.pm +++ /dev/null @@ -1,158 +0,0 @@ -package OpenILS::WWW::Redirect; -use strict; use warnings; - -use Socket; -use Apache2::Log; -use Apache2::Const -compile => qw(OK REDIRECT :log); -use APR::Const -compile => qw(:error SUCCESS); -use Apache2::RequestRec (); -use Apache2::RequestIO (); -use CGI (); - -use OpenSRF::AppSession; -use OpenSRF::System; -use OpenSRF::Utils::Logger qw/$logger/; - -use vars '$lib_ips_hash'; -my $lib_ips_hash; - -my $bootstrap_config_file; -sub import { - my( $self, $config ) = @_; - $bootstrap_config_file = $config; -} - -sub init { - OpenSRF::System->bootstrap_client( config_file => $bootstrap_config_file ); -} - -sub parse_ips_file { - my $class = shift; - my $ips_file = shift; - - if( open(F, $ips_file) ) { - - while( my $data = ) { - chomp($data); - - my( $shortname, $ip1, $ip2 ) = split(/\s+/, $data); - next unless ($shortname and $ip1 and $ip2); - - $lib_ips_hash->{$shortname} = [] unless $lib_ips_hash->{$shortname}; - push( @{$lib_ips_hash->{$shortname}}, [ $ip1, $ip2 ] ); - } - - close(F); - - } else { - $logger->error("Unable to open lib IP redirector file $ips_file"); - } -} - - -sub handler { - - my $user_ip = $ENV{REMOTE_ADDR}; - my $apache_obj = shift; - my $cgi = CGI->new( $apache_obj ); - - - my $skin = $apache_obj->dir_config('OILSRedirectSkin') || 'default'; - my $depth = $apache_obj->dir_config('OILSRedirectDepth'); - my $locale = $apache_obj->dir_config('OILSRedirectLocale') || 'en-US'; - - my $hostname = $cgi->server_name(); - my $port = $cgi->server_port(); - - my $proto = "http"; - if($cgi->https) { $proto = "https"; } - - my $url = "$proto://$hostname:$port/opac/$locale/skin/$skin/xml/index.xml"; - - my $path = $apache_obj->path_info(); - - $logger->debug("Apache client connecting from $user_ip"); - - if(my $shortname = redirect_libs($user_ip)) { - - $logger->info("Apache redirecting $user_ip to $shortname"); - my $session = OpenSRF::AppSession->create("open-ils.actor"); - - my $org = $session->request( - 'open-ils.actor.org_unit.retrieve_by_shortname', - $shortname)->gather(1); - - if($org) { - $url .= "?ol=" . $org->id; - $url .= "&d=$depth" if defined $depth; - } - } - - print "Location: $url\n\n"; - return Apache2::Const::REDIRECT; - - return print_page($url); -} - -sub redirect_libs { - my $source_ip = shift; - my $aton_binary = inet_aton( $source_ip ); - - return 0 unless $aton_binary; - - # do this the linear way for now... - for my $shortname (keys %$lib_ips_hash) { - - for my $block (@{$lib_ips_hash->{$shortname}}) { - - if(defined($block->[0]) && defined($block->[1]) ) { - my $start_binary = inet_aton( $block->[0] ); - my $end_binary = inet_aton( $block->[1] ); - next unless( $start_binary and $end_binary ); - if( $start_binary le $aton_binary and - $end_binary ge $aton_binary ) { - return $shortname; - } - } - } - } - return 0; -} - - -sub print_page { - - my $url = shift; - - print "Content-type: text/html; charset=utf-8\n\n"; - print <<" HTML"; - - - - - - -

-
-

Loading...

-
-

-
- - - HTML - - return Apache2::Const::OK; -} - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/Reporter.pm b/Open-ILS/src/perlmods/OpenILS/WWW/Reporter.pm deleted file mode 100644 index 573bcd499a..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/Reporter.pm +++ /dev/null @@ -1,159 +0,0 @@ -package OpenILS::WWW::Reporter; -use strict; use warnings; - -use vars qw/$dtype_xform_map $dtype_xform/; - -use Apache2::Log; -use Apache2::Const -compile => qw(OK REDIRECT DECLINED :log); -use APR::Const -compile => qw(:error SUCCESS); -use Apache2::RequestRec (); -use Apache2::RequestIO (); -use Apache2::RequestUtil; -use CGI; -use Data::Dumper; - -use Template; - -use OpenSRF::EX qw(:try); -use OpenSRF::System; -use XML::LibXML; - -use OpenSRF::Utils::SettingsParser; -use OpenILS::Utils::Fieldmapper; -use OpenILS::WWW::Reporter::transforms; - - -# set the bootstrap config and template include directory when -# this module is loaded -my $bootstrap; -my $includes = []; -my $base_xml; -#my $base_xml_doc; - -sub import { - my( $self, $bs_config, $core_xml, @incs ) = @_; - $bootstrap = $bs_config; - $base_xml = $core_xml; - $includes = [ @incs ]; -} - - -# our templates plugins are here -my $plugin_base = 'OpenILS::Template::Plugin'; - -sub child_init { - OpenSRF::System->bootstrap_client( config_file => $bootstrap ); - - #parse the base xml file - #my $parser = XML::LibXML->new; - #$parser->expand_xinclude(1); - - #$base_xml_doc = $parser->parse_file($base_xml); - -} - -sub handler { - - my $apache = shift; - return Apache2::Const::DECLINED if (-e $apache->filename); - - my $cgi = CGI->new; - - my $path = $apache->path_info; - (my $ttk = $path) =~ s{^/?([a-zA-Z0-9_]+).*?$}{$1}o; - - $ttk = $apache->filename unless $ttk; - $ttk = "dashboard" unless $ttk; - - $ttk = (split '/', $ttk)[-1]; - - my $user; - - # if the user is not logged in via cookie, route them to the login page - if(! ($user = verify_login($cgi->cookie("ses"))) ) { - $ttk = "login"; - } - - - print "Content-type: text/html; charset=utf-8\n\n"; - #print "Content-type: text/html\n\n"; - - _process_template( - apache => $apache, - template => "$ttk.ttk", - params => { - user => $user, - stage_dir => $ttk, - config_xml => $base_xml, - }, - ); - - return Apache2::Const::OK; -} - - -sub _process_template { - - my %params = @_; - my $ttk = $params{template} || return undef; - my $apache = $params{apache} || undef; - my $param_hash = $params{params} || {}; - $$param_hash{dtype_xform_map} = $OpenILS::WWW::Reporter::dtype_xform_map; - $$param_hash{dtype_xforms} = $OpenILS::WWW::Reporter::dtype_xforms; - - my $template; - - $template = Template->new( { - OUTPUT => $apache, - ABSOLUTE => 1, - RELATIVE => 1, - PLUGIN_BASE => $plugin_base, - INCLUDE_PATH => $includes, - PRE_CHOMP => 1, - POST_CHOMP => 1, - #LOAD_PERL => 1, - } - ); - - try { - - if( ! $template->process( $ttk, $param_hash ) ) { - warn "Error Processing Template: " . $template->error(); - my $err = $template->error(); - $err =~ s/\n/\/g; - warn "Error processing template $ttk\n"; - my $string = "
Unable to process template:

" . $err . ""; - print "ERROR: $string"; - #$template->process( $error_ttk , { error => $string } ); - } - - } catch Error with { - my $e = shift; - warn "Error processing template $ttk: $e - $@ \n"; - print "


Error

$e

$@
"; - return; - }; - -} - -# returns the user object if the session is valid, 0 otherwise -sub verify_login { - my $auth_token = shift; - return 0 unless $auth_token; - - my $session = OpenSRF::AppSession->create("open-ils.auth"); - my $req = $session->request( - "open-ils.auth.session.retrieve", $auth_token ); - my $user = $req->gather(1); - - if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) { - return 0; - } - - return $user if ref($user); - return 0; -} - - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/Reporter/transforms.pm b/Open-ILS/src/perlmods/OpenILS/WWW/Reporter/transforms.pm deleted file mode 100644 index 8123d15c41..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/Reporter/transforms.pm +++ /dev/null @@ -1,87 +0,0 @@ -#!/usr/bin/perl - -package OpenILS::WWW::Reporter; - -our $dtype_xform_map = { - 'int' => [ 'avg','stddev','sum','count','count_dist','numformat'], - 'numeric' => [ 'avg','stddev','sum','count','count_dist','numformat'], - 'float' => [ 'avg','stddev','sum','count','count_dist','numformat'], - 'time' => [ 'count', 'dateformat'], - 'date' => [ 'count', 'age','dateformat'], - 'timestamp' => [ 'count', 'age','dateformat'], - 'timestamptz' => [ 'count', 'age','dateformat'], - 'text' => [ 'count','count_dist','lower','upper','substr'], - 'call_number' => [ 'count','count_dist','dewy','dewy_prefix','count_dist_dewey','count_dist_dewey_prefix','lower','upper','substr'], -}; - - - -our $dtype_xforms = { - 'avg' => { - 'name' => 'Average per group', - 'select' => 'AVG(?COLNAME?)', - 'group' => 0 }, - 'stddev' => { - 'label' => 'Standard Deviation per group', - 'select' => 'STDDEV(?COLNAME?)', - 'group' => 0 }, - 'sum' => { - 'label' => 'Sum per group', - 'select' => 'SUM(?COLNAME?)', - 'group' => 0 }, - 'count' => { - 'label' => 'Count per group', - 'select' => 'COUNT(?COLNAME?)', - 'group' => 0 }, - 'count_dist' => { - 'label' => 'Distinct Count per group', - 'select' => 'COUNT(DISTINCT ?COLNAME?)', - 'group' => 0 }, - 'count_dist_dewey' => { - 'label' => 'Distinct Count of Dewey numbers per group', - 'select' => 'COUNT(DISTINCT call_number_dewey(?COLNAME?))', - 'group' => 1 }, - 'count_dist_dewey_prefix'=> { - 'label' => 'Distinct Count of Dewey Number Prefixes per group', - 'select' => 'COUNT(DISTINCT call_number_dewey(?COLNAME?,?PARAM?))', - 'param' => 1, - 'group' => 1 }, - 'dewy_prefix' => { - 'label' => 'Extract Dewey number prefix from call number', - 'select' => 'call_number_dewey(?COLNAME?,?PARAM?)', - 'param' => 1, - 'group' => 1 }, - 'dewy' => { - 'label' => 'Extract Dewey number from call number', - 'select' => 'call_number_dewey(?COLNAME?)', - 'group' => 1 }, - 'lower' => { - 'label' => 'Transform string to lower case', - 'select' => 'LOWER(?COLNAME?)', - 'group' => 1 }, - 'upper' => { - 'label' => 'Transform string to upper case', - 'select' => 'UPPER(?COLNAME?)', - 'group' => 1 }, - 'substr' => { - 'label' => 'Trim string length', - 'select' => 'substr(?COLNAME?,1,?PARAM?)', - 'param' => 1, - 'group' => 1 }, - 'age' => { - 'label' => 'Age as of runtime -- day granularity', - 'select' => 'AGE(?COLNAME?::DATE)', - 'group' => 1 }, - 'dateformat' => { # see http://www.postgresql.org/docs/8.0/interactive/functions-formatting.html - 'label' => 'Format date and time', - 'select' => "TO_CHAR(?COLNAME?,'?PARAM?')", - 'param' => 1, - 'group' => 1 }, - 'numformat' => { # see http://www.postgresql.org/docs/8.0/interactive/functions-formatting.html - 'label' => 'Format Numeric data', - 'select' => "TO_CHAR(?COLNAME?,'?PARAM?')", - 'param' => 1, - 'group' => 1 }, -}; - -; diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/SuperCat.pm b/Open-ILS/src/perlmods/OpenILS/WWW/SuperCat.pm deleted file mode 100644 index 040b88897e..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/SuperCat.pm +++ /dev/null @@ -1,2088 +0,0 @@ -package OpenILS::WWW::SuperCat; -use strict; use warnings; - -use Apache2::Log; -use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log); -use APR::Const -compile => qw(:error SUCCESS); -use Apache2::RequestRec (); -use Apache2::RequestIO (); -use Apache2::RequestUtil; -use CGI; -use Data::Dumper; -use SRU::Request; -use SRU::Response; - -use OpenSRF::EX qw(:try); -use OpenSRF::Utils qw/:datetime/; -use OpenSRF::Utils::Cache; -use OpenSRF::System; -use OpenSRF::AppSession; -use XML::LibXML; -use XML::LibXSLT; - -use Encode; -use Unicode::Normalize; -use OpenILS::Utils::Fieldmapper; -use OpenILS::WWW::SuperCat::Feed; -use OpenSRF::Utils::Logger qw/$logger/; -use OpenILS::Application::AppUtils; - -use MARC::Record; -use MARC::File::XML; - -my $log = 'OpenSRF::Utils::Logger'; -my $U = 'OpenILS::Application::AppUtils'; - -# set the bootstrap config when this module is loaded -my ($bootstrap, $supercat, $actor, $parser, $search, $xslt, $cn_browse_xslt, %browse_types); - -$browse_types{call_number}{xml} = sub { - my $tree = shift; - - my $year = (gmtime())[5] + 1900; - my $content = ''; - - $content .= "\n"; - - for my $cn (@$tree) { - (my $cn_class = $cn->class_name) =~ s/::/-/gso; - $cn_class =~ s/Fieldmapper-//gso; - - my $cn_tag = "tag:open-ils.org,$year:$cn_class/".$cn->id; - my $cn_lib = $cn->owning_lib->shortname; - my $cn_label = $cn->label; - - $cn_label =~ s/\n//gos; - $cn_label =~ s/&/&/go; - $cn_label =~ s/'/'/go; - $cn_label =~ s//>/go; - - (my $ou_class = $cn->owning_lib->class_name) =~ s/::/-/gso; - $ou_class =~ s/Fieldmapper-//gso; - - my $ou_tag = "tag:open-ils.org,$year:$ou_class/".$cn->owning_lib->id; - my $ou_name = $cn->owning_lib->name; - - $ou_name =~ s/\n//gos; - $ou_name =~ s/'/'/go; - - (my $rec_class = $cn->record->class_name) =~ s/::/-/gso; - $rec_class =~ s/Fieldmapper-//gso; - - my $rec_tag = "tag:open-ils.org,$year:$rec_class/".$cn->record->id.'/'.$cn->owning_lib->shortname; - - $content .= "\n"; - $content .= "\n"; - - my $r_doc = $parser->parse_string($cn->record->marc); - $r_doc->documentElement->setAttribute( id => $rec_tag ); - $content .= $U->entityize($r_doc->documentElement->toString); - - $content .= "\n"; - } - - $content .= "\n"; - return ("Content-type: application/xml\n\n",$content); -}; - - -$browse_types{call_number}{html} = sub { - my $tree = shift; - my $p = shift; - my $n = shift; - - if (!$cn_browse_xslt) { - $cn_browse_xslt = $parser->parse_file( - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ). - "/CNBrowse2HTML.xsl" - ); - $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt ); - } - - my (undef,$xml) = $browse_types{call_number}{xml}->($tree); - - return ( - "Content-type: text/html\n\n", - $U->entityize( - $cn_browse_xslt->transform( - $parser->parse_string( $xml ), - 'prev' => "'$p'", - 'next' => "'$n'" - )->toString(1) - ) - ); -}; - -sub import { - my $self = shift; - $bootstrap = shift; -} - - -sub child_init { - OpenSRF::System->bootstrap_client( config_file => $bootstrap ); - - my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL"); - Fieldmapper->import(IDL => $idl); - - $supercat = OpenSRF::AppSession->create('open-ils.supercat'); - $actor = OpenSRF::AppSession->create('open-ils.actor'); - $search = OpenSRF::AppSession->create('open-ils.search'); - $parser = new XML::LibXML; - $xslt = new XML::LibXSLT; - - $cn_browse_xslt = $parser->parse_file( - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ). - "/CNBrowse2HTML.xsl" - ); - - $cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt ); - - my $list = $supercat - ->request("open-ils.supercat.record.formats") - ->gather(1); - - $list = [ map { (keys %$_)[0] } @$list ]; - push @$list, 'htmlholdings','html', 'marctxt', 'ris'; - - for my $browse_axis ( qw/title author subject topic series item-age/ ) { - for my $record_browse_format ( @$list ) { - { - my $__f = $record_browse_format; - my $__a = $browse_axis; - - $browse_types{$__a}{$__f} = sub { - my $record_list = shift; - my $prev = shift; - my $next = shift; - my $real_format = shift || $__f; - my $unapi = shift; - my $base = shift; - my $site = shift; - - $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]"); - my $feed = create_record_feed( 'record', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /(-full|-uris)$/o ? 1 : 0 ); - $feed->root( "$base/../" ); - $feed->lib( $site ); - $feed->link( next => $next => $feed->type ); - $feed->link( previous => $prev => $feed->type ); - - return ( - "Content-type: ". $feed->type ."; charset=utf-8\n\n", - $feed->toString - ); - }; - } - } - } - - for my $basic_axis ( qw/authority.title authority.author authority.subject authority.topic/ ) { - for my $browse_axis ( ($basic_axis, $basic_axis . ".refs") ) { - { - my $__f = 'marcxml'; - my $__a = $browse_axis; - - $browse_types{$__a}{$__f} = sub { - my $record_list = shift; - my $prev = shift; - my $next = shift; - my $real_format = shift || $__f; - my $unapi = shift; - my $base = shift; - my $site = shift; - - $log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]"); - my $feed = create_record_feed( 'authority', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /-full$/o ? -1 : 0 ); - $feed->root( "$base/../" ); - $feed->link( next => $next => $feed->type ); - $feed->link( previous => $prev => $feed->type ); - - return ( - "Content-type: ". $feed->type ."; charset=utf-8\n\n", - $feed->toString - ); - }; - } - } - } -} - -=head2 parse_feed_type($type) - -Determines whether and how a given feed type needs to be "fleshed out" -with holdings information. - -The feed type could end with the string "-full", in which case we want -to return call numbers, copies, and URIS. - -Or the feed type could be "-uris", in which case we want to return -call numbers and URIS. - -Otherwise, we won't return any holdings. - -=cut - -sub parse_feed_type { - my $type = shift; - - if ($type =~ /-full$/o) { - return 1; - } - - if ($type =~ /-uris$/o) { - return "uris"; - } - - # Otherwise, we'll return just the facts, ma'am - return 0; -} - -=head2 supercat_format($format_hashref, $format_type) - -Given a reference to a hash containing the namespace_uri, -docs, and schema location attributes for a set of formats, -generate the XML description required by the supercat service. - -We derive the base type from the format type so that we do not -have to populate the hash with redundant information. - -=cut - -sub supercat_format { - my $h = shift; - my $type = shift; - - (my $base_type = $type) =~ s/(-full|-uris)$//o; - - my $format = "$typeapplication/xml"; - - for my $part ( qw/namespace_uri docs schema_location/ ) { - $format .= "<$part>$$h{$base_type}{$part}" - if ($$h{$base_type}{$part}); - } - - $format .= ''; - - return $format; -} - -=head2 unapi_format($format_hashref, $format_type) - -Given a reference to a hash containing the namespace_uri, -docs, and schema location attributes for a set of formats, -generate the XML description required by the supercat service. - -We derive the base type from the format type so that we do not -have to populate the hash with redundant information. - -=cut - -sub unapi_format { - my $h = shift; - my $type = shift; - - (my $base_type = $type) =~ s/(-full|-uris)$//o; - - my $format = "filename); - - (my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o; - - my $list = $supercat - ->request("open-ils.supercat.oisbn", $isbn) - ->gather(1); - - print "Content-type: application/xml; charset=utf-8\n\n"; - print "\n"; - - unless (exists $$list{metarecord}) { - print ''; - return Apache2::Const::OK; - } - - print "\n"; - - for ( keys %{ $$list{record_list} } ) { - (my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o; - print " $o\n" - } - - print "\n"; - - return Apache2::Const::OK; -} - -sub unapi { - - my $apache = shift; - return Apache2::Const::DECLINED if (-e $apache->filename); - - my $cgi = new CGI; - - my $add_path = 0; - if ( $cgi->server_software !~ m|^Apache/2.2| ) { - my $rel_name = $cgi->url(-relative=>1); - $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/); - } - - my $url = $cgi->url(-path_info=>$add_path); - my $root = (split 'unapi', $url)[0]; - my $base = (split 'unapi', $url)[0] . 'unapi'; - - - my $uri = $cgi->param('id') || ''; - my $host = $cgi->virtual_host || $cgi->server_name; - - my $skin = $cgi->param('skin') || 'default'; - my $locale = $cgi->param('locale') || 'en-US'; - - # Enable localized results of copy status, etc - $supercat->session_locale($locale); - - my $format = $cgi->param('format'); - my $flesh_feed = parse_feed_type($format); - (my $base_format = $format) =~ s/(-full|-uris)$//o; - my ($id,$type,$command,$lib,$depth,$paging) = ('','',''); - - if (!$format) { - my $body = "Content-type: application/xml; charset=utf-8\n\n"; - - if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) { - $id = $2; - $paging = $3; - ($lib,$depth) = split('/', $4); - $type = 'record'; - $type = 'metarecord' if ($1 =~ /^m/o); - $type = 'authority' if ($1 =~ /^authority/o); - - my $list = $supercat - ->request("open-ils.supercat.$type.formats") - ->gather(1); - - if ($type eq 'record' or $type eq 'isbn') { - $body .= <<" FORMATS"; - - - - - - - - - - - FORMATS - } elsif ($type eq 'metarecord') { - $body .= <<" FORMATS"; - - - FORMATS - } else { - $body .= <<" FORMATS"; - - FORMATS - } - - for my $h (@$list) { - my ($type) = keys %$h; - $body .= unapi_format($h, $type); - - if (OpenILS::WWW::SuperCat::Feed->exists($type)) { - $body .= unapi_format($h, "$type-full"); - $body .= unapi_format($h, "$type-uris"); - } - } - - $body .= "\n"; - - } else { - my $list = $supercat - ->request("open-ils.supercat.$type.formats") - ->gather(1); - - push @$list, - @{ $supercat - ->request("open-ils.supercat.metarecord.formats") - ->gather(1); - }; - - my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list; - $list = [ map { { $_ => $hash{$_} } } sort keys %hash ]; - - $body .= <<" FORMATS"; - - - - - - - - - - - FORMATS - - - for my $h (@$list) { - my ($type) = keys %$h; - $body .= "\t" . unapi_format($h, $type); - - if (OpenILS::WWW::SuperCat::Feed->exists($type)) { - $body .= "\t" . unapi_format($h, "$type-full"); - $body .= "\t" . unapi_format($h, "$type-uris"); - } - } - - $body .= "\n"; - - } - print $body; - return Apache2::Const::OK; - } - - my $scheme; - if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) { - $scheme = $1; - $id = $2; - $paging = $3; - ($lib,$depth) = split('/', $4); - $type = 'record'; - $type = 'metarecord' if ($scheme =~ /^metabib/o); - $type = 'isbn' if ($scheme =~ /^isbn/o); - $type = 'acp' if ($scheme =~ /^asset-copy/o); - $type = 'acn' if ($scheme =~ /^asset-call_number/o); - $type = 'auri' if ($scheme =~ /^asset-uri/o); - $type = 'authority' if ($scheme =~ /^authority/o); - $command = 'retrieve'; - $command = 'browse' if (grep { $scheme eq $_ } qw/call_number title author subject topic authority.title authority.author authority.subject authority.topic series item-age/); - } - - if ($paging) { - $paging = [split ',', $paging]; - } else { - $paging = []; - } - - if (!$lib || $lib eq '-') { - $lib = $actor->request( - 'open-ils.actor.org_unit_list.search' => parent_ou => undef - )->gather(1)->[0]->shortname; - } - - my ($lib_object,$lib_id,$ou_types,$lib_depth); - if ($type ne 'acn' && $type ne 'acp' && $type ne 'auri') { - $lib_object = $actor->request( - 'open-ils.actor.org_unit_list.search' => shortname => $lib - )->gather(1)->[0]; - $lib_id = $lib_object->id; - - $ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1); - $lib_depth = $depth || (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth; - } - - if ($command eq 'browse') { - print "Location: $root/browse/$base_format/$scheme/$lib/$id\n\n"; - return 302; - } - - if ($type eq 'isbn') { - my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1); - if (!@$rec) { - print "Content-type: text/html; charset=utf-8\n\n"; - $apache->custom_response( 404, <<" HTML"); - - - Type [$type] with id [$id] not found! - - -
-
Sorry, we couldn't $command a $type with the id of $id in format $format.
- - - HTML - return 404; - } - $id = $rec->[0]->id; - $type = 'record'; - } - - if ( !grep - { (keys(%$_))[0] eq $base_format } - @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) } - and !grep - { $_ eq $base_format } - qw/opac html htmlholdings marctxt ris holdings_xml/ - ) { - print "Content-type: text/html; charset=utf-8\n\n"; - $apache->custom_response( 406, <<" HTML"); - - - Invalid format [$format] for type [$type]! - - -
-
Sorry, format $format is not valid for type $type.
- - - HTML - return 406; - } - - if ($format eq 'opac') { - print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n" - if ($type eq 'metarecord'); - print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id&l=$lib_id&d=$lib_depth\n\n" - if ($type eq 'record'); - return 302; - } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format) && ($type ne 'acn' && $type ne 'acp' && $type ne 'auri')) { - my $feed = create_record_feed( - $type, - $format => [ $id ], - $base, - $lib, - $depth, - $flesh_feed, - $paging - ); - - if (!$feed->count) { - print "Content-type: text/html; charset=utf-8\n\n"; - $apache->custom_response( 404, <<" HTML"); - - - Type [$type] with id [$id] not found! - - -
-
Sorry, we couldn't $command a $type with the id of $id in format $format.
- - - HTML - return 404; - } - - $feed->root($root); - $feed->creator($host); - $feed->update_ts(); - $feed->link( unapi => $base) if ($flesh_feed); - - print "Content-type: ". $feed->type ."; charset=utf-8\n\n"; - print $U->entityize($feed->toString) . "\n"; - - return Apache2::Const::OK; - } - - my $method = "open-ils.supercat.$type.$base_format.$command"; - my @params = ($id); - push @params, $lib, $lib_depth, $flesh_feed, $paging if ($base_format eq 'holdings_xml'); - - # for acn, acp, etc, the "lib" pathinfo position isn't useful. - # however, we can have it carry extra options like no_record! (comma separated) - push @params, { map { ( $_ => 1 ) } split(',', $lib) } if ( grep { $type eq $_} qw/acn acp auri/); - - my $req = $supercat->request($method,@params); - my $data = $req->gather(); - - if ($req->failed || !$data) { - print "Content-type: text/html; charset=utf-8\n\n"; - $apache->custom_response( 404, <<" HTML"); - - - $type $id not found! - - -
-
Sorry, we couldn't $command a $type with the id of $id in format $format.
- - - HTML - return 404; - } - - print "Content-type: application/xml; charset=utf-8\n\n$data"; - - if ($base_format eq 'holdings_xml') { - while (my $c = $req->recv) { - print $c->content; - } - } - - return Apache2::Const::OK; -} - -sub supercat { - - my $apache = shift; - return Apache2::Const::DECLINED if (-e $apache->filename); - - my $cgi = new CGI; - - my $add_path = 0; - if ( $cgi->server_software !~ m|^Apache/2.2| ) { - my $rel_name = $cgi->url(-relative=>1); - $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/); - } - - my $url = $cgi->url(-path_info=>$add_path); - my $root = (split 'supercat', $url)[0]; - my $base = (split 'supercat', $url)[0] . 'supercat'; - my $unapi = (split 'supercat', $url)[0] . 'unapi'; - - my $host = $cgi->virtual_host || $cgi->server_name; - - my $path = $cgi->path_info; - my ($id,$type,$format,$command) = reverse split '/', $path; - my $flesh_feed = parse_feed_type($format); - (my $base_format = $format) =~ s/(-full|-uris)$//o; - - my $skin = $cgi->param('skin') || 'default'; - my $locale = $cgi->param('locale') || 'en-US'; - - # Enable localized results of copy status, etc - $supercat->session_locale($locale); - - if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) { - print "Content-type: application/xml; charset=utf-8\n"; - if ($1) { - my $list = $supercat - ->request("open-ils.supercat.$1.formats") - ->gather(1); - - print "\n"; - - print " - - opac - text/html - "; - - if ($1 eq 'record' or $1 eq 'isbn') { - print " - htmlholdings - text/html - - - html - text/html - - - htmlholdings-full - text/html - - - html-full - text/html - - - marctxt - text/plain - - - ris - text/plain - "; - } - - for my $h (@$list) { - my ($type) = keys %$h; - print supercat_format($h, $type); - - if (OpenILS::WWW::SuperCat::Feed->exists($type)) { - print supercat_format($h, "$type-full"); - print supercat_format($h, "$type-uris"); - } - - } - - print "\n"; - - return Apache2::Const::OK; - } - - my $list = $supercat - ->request("open-ils.supercat.record.formats") - ->gather(1); - - push @$list, - @{ $supercat - ->request("open-ils.supercat.metarecord.formats") - ->gather(1); - }; - - my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list; - $list = [ map { { $_ => $hash{$_} } } sort keys %hash ]; - - print "\n - - opac - text/html - - - htmlholdings - text/html - - - html - text/html - - - htmlholdings-full - text/html - - - html-full - text/html - - - marctxt - text/plain - - - ris - text/plain - "; - - for my $h (@$list) { - my ($type) = keys %$h; - print supercat_format($h, $type); - - if (OpenILS::WWW::SuperCat::Feed->exists($type)) { - print supercat_format($h, "$type-full"); - print supercat_format($h, "$type-uris"); - } - - } - - print "\n"; - - - return Apache2::Const::OK; - } - - if ($format eq 'opac') { - print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n" - if ($type eq 'metarecord'); - print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id\n\n" - if ($type eq 'record'); - return 302; - - } elsif ($base_format eq 'marc21') { - - my $ret = 200; - try { - my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0]; - - print "Content-type: application/octet-stream\n\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc; - - } otherwise { - warn shift(); - - print "Content-type: text/html; charset=utf-8\n\n"; - $apache->custom_response( 404, <<" HTML"); - - - ERROR - - -
-
Couldn't fetch $id as MARC21.
- - - HTML - $ret = 404; - }; - - return Apache2::Const::OK; - - } elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) { - my $feed = create_record_feed( - $type, - $format => [ $id ], - undef, undef, undef, - $flesh_feed - ); - - $feed->root($root); - $feed->creator($host); - - $feed->update_ts(); - - $feed->link( unapi => $base) if ($flesh_feed); - - print "Content-type: ". $feed->type ."; charset=utf-8\n\n"; - print $U->entityize($feed->toString) . "\n"; - - return Apache2::Const::OK; - } - - my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id); - $req->wait_complete; - - if ($req->failed) { - print "Content-type: text/html; charset=utf-8\n\n"; - $apache->custom_response( 404, <<" HTML"); - - - $type $id not found! - - -
-
Sorry, we couldn't $command a $type with the id of $id in format $format.
- - - HTML - return 404; - } - - print "Content-type: application/xml; charset=utf-8\n\n"; - print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString ); - - return Apache2::Const::OK; -} - - -sub bookbag_feed { - my $apache = shift; - return Apache2::Const::DECLINED if (-e $apache->filename); - - my $cgi = new CGI; - - my $year = (gmtime())[5] + 1900; - my $host = $cgi->virtual_host || $cgi->server_name; - - my $add_path = 0; - if ( $cgi->server_software !~ m|^Apache/2.2| ) { - my $rel_name = $cgi->url(-relative=>1); - $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/); - } - - my $url = $cgi->url(-path_info=>$add_path); - my $root = (split 'feed', $url)[0] . '/'; - my $base = (split 'bookbag', $url)[0] . '/bookbag'; - my $unapi = (split 'feed', $url)[0] . '/unapi'; - - my $skin = $cgi->param('skin') || 'default'; - my $locale = $cgi->param('locale') || 'en-US'; - my $org = $cgi->param('searchOrg'); - - # Enable localized results of copy status, etc - $supercat->session_locale($locale); - - my $org_unit = get_ou($org); - my $scope = "l=" . $org_unit->[0]->id . "&"; - - $root =~ s{(?path_info; - #warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi"; - - my ($id,$type) = reverse split '/', $path; - my $flesh_feed = parse_feed_type($type); - - my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1); - return Apache2::Const::NOT_FOUND unless($bucket); - - my $bucket_tag = "tag:$host,$year:record_bucket/$id"; - if ($type eq 'opac') { - print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" . - join('&', map { "rl=" . $_->target_biblio_record_entry } @{ $bucket->items }) . - "\n\n"; - return 302; - } - - my $feed = create_record_feed( - 'record', - $type, - [ map { $_->target_biblio_record_entry } @{ $bucket->items } ], - $unapi, - $org_unit->[0]->shortname, - undef, - $flesh_feed - ); - $feed->root($root); - $feed->id($bucket_tag); - - $feed->title("Items in Book Bag [".$bucket->name."]"); - $feed->creator($host); - $feed->update_ts(); - - $feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml'); - $feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml'); - $feed->link(html => $base . "/html-full/$id" => 'text/html'); - $feed->link(unapi => $unapi); - - $feed->link( - OPAC => - "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" . - join('&', map { 'rl=' . $_->target_biblio_record_entry } @{$bucket->items} ), - 'text/html' - ); - - - print "Content-type: ". $feed->type ."; charset=utf-8\n\n"; - print $U->entityize($feed->toString) . "\n"; - - return Apache2::Const::OK; -} - -sub changes_feed { - my $apache = shift; - return Apache2::Const::DECLINED if (-e $apache->filename); - - my $cgi = new CGI; - - my $year = (gmtime())[5] + 1900; - my $host = $cgi->virtual_host || $cgi->server_name; - - my $add_path = 0; - if ( $cgi->server_software !~ m|^Apache/2.2| ) { - my $rel_name = $cgi->url(-relative=>1); - $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/); - } - - my $url = $cgi->url(-path_info=>$add_path); - my $root = (split 'feed', $url)[0]; - my $base = (split 'freshmeat', $url)[0] . '/freshmeat'; - my $unapi = (split 'feed', $url)[0] . 'unapi'; - - my $skin = $cgi->param('skin') || 'default'; - my $locale = $cgi->param('locale') || 'en-US'; - my $org = $cgi->param('searchOrg'); - - # Enable localized results of copy status, etc - $supercat->session_locale($locale); - - my $org_unit = get_ou($org); - my $scope = "l=" . $org_unit->[0]->id . "&"; - - my $path = $cgi->path_info; - #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi"; - - $path =~ s/^\/(?:feed\/)?freshmeat\///og; - - my ($type,$rtype,$axis,$limit,$date) = split '/', $path; - my $flesh_feed = parse_feed_type($type); - - $limit ||= 10; - $limit = 10 if $limit !~ /^\d+$/; - - my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1); - - #if ($type eq 'opac') { - # print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" . - # join('&', map { "rl=" . $_ } @$list) . - # "\n\n"; - # return 302; - #} - - my $search = 'record'; - if ($rtype eq 'authority') { - $search = 'authority'; - } - my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed); - $feed->root($root); - - if ($date) { - $feed->title("Up to $limit recent $rtype ${axis}s from $date forward"); - } else { - $feed->title("$limit most recent $rtype ${axis}s"); - } - - $feed->creator($host); - $feed->update_ts(); - - $feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml'); - $feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml'); - $feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html'); - $feed->link(unapi => $unapi); - - $feed->link( - OPAC => - "http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" . - join('&', map { 'rl=' . $_} @$list ), - 'text/html' - ); - - - print "Content-type: ". $feed->type ."; charset=utf-8\n\n"; - print $U->entityize($feed->toString) . "\n"; - - return Apache2::Const::OK; -} - -sub opensearch_osd { - my $version = shift; - my $lib = shift; - my $class = shift; - my $base = shift; - - if ($version eq '1.0') { - print < - - $base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count} - http://a9.com/-/spec/opensearchrss/1.0/ - $lib - Search $lib - Search the $lib OPAC by $class. - $lib book library - harry+potter - Mike Rylander for GPLS/PINES - feedback\@open-ils.org - open - false - -OSD - } else { - print < - - $lib - Search the $lib OPAC by $class. - $lib book library - - - - - - - Search $lib - - Mike Rylander for GPLS/PINES - feedback\@open-ils.org - open - false - en-US - UTF-8 - UTF-8 - -OSD - } - - return Apache2::Const::OK; -} - -sub opensearch_feed { - my $apache = shift; - return Apache2::Const::DECLINED if (-e $apache->filename); - - my $cgi = new CGI; - my $year = (gmtime())[5] + 1900; - - my $host = $cgi->virtual_host || $cgi->server_name; - - my $add_path = 0; - if ( $cgi->server_software !~ m|^Apache/2.2| ) { - my $rel_name = $cgi->url(-relative=>1); - $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/); - } - - my $url = $cgi->url(-path_info=>$add_path); - my $root = (split 'opensearch', $url)[0]; - my $base = (split 'opensearch', $url)[0] . 'opensearch'; - my $unapi = (split 'opensearch', $url)[0] . 'unapi'; - - my $path = $cgi->path_info; - #warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi"; - - if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) { - - my $version = $1; - my $lib = uc($2); - my $class = $3; - - if (!$lib || $lib eq '-') { - $lib = $actor->request( - 'open-ils.actor.org_unit_list.search' => parent_ou => undef - )->gather(1)->[0]->shortname; - } - - if ($class eq '-') { - $class = 'keyword'; - } - - return opensearch_osd($version, $lib, $class, $base); - } - - - my $page = $cgi->param('startPage') || 1; - my $offset = $cgi->param('startIndex') || 1; - my $limit = $cgi->param('count') || 10; - - $page = 1 if ($page !~ /^\d+$/); - $offset = 1 if ($offset !~ /^\d+$/); - $limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25); - - if ($page > 1) { - $offset = ($page - 1) * $limit; - } else { - $offset -= 1; - } - - my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','',''); - (undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path; - - $lang = $cgi->param('searchLang') if $cgi->param('searchLang'); - $lang = '' if ($lang eq '*'); - - $sort = $cgi->param('searchSort') if $cgi->param('searchSort'); - $sort ||= ''; - $sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir'); - $sortdir ||= ''; - - $terms .= " " if ($terms && $cgi->param('searchTerms')); - $terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms'); - - $class = $cgi->param('searchClass') if $cgi->param('searchClass'); - $class ||= '-'; - - $type = $cgi->param('responseType') if $cgi->param('responseType'); - $type ||= '-'; - - $org = $cgi->param('searchOrg') if $cgi->param('searchOrg'); - $org ||= '-'; - - - my $kwt = $cgi->param('kw'); - my $tit = $cgi->param('ti'); - my $aut = $cgi->param('au'); - my $sut = $cgi->param('su'); - my $set = $cgi->param('se'); - - $terms .= " " if ($terms && $kwt); - $terms .= "keyword: $kwt" if ($kwt); - $terms .= " " if ($terms && $tit); - $terms .= "title: $tit" if ($tit); - $terms .= " " if ($terms && $aut); - $terms .= "author: $aut" if ($aut); - $terms .= " " if ($terms && $sut); - $terms .= "subject: $sut" if ($sut); - $terms .= " " if ($terms && $set); - $terms .= "series: $set" if ($set); - - if ($version eq '1.0') { - $type = 'rss2'; - } elsif ($type eq '-') { - $type = 'atom'; - } - my $flesh_feed = parse_feed_type($type); - - $terms = decode_utf8($terms); - $lang = 'eng' if ($lang eq 'en-US'); - - $log->debug("OpenSearch terms: $terms"); - - my $org_unit = get_ou($org); - - # Apostrophes break search and get indexed as spaces anyway - my $safe_terms = $terms; - $safe_terms =~ s{'}{ }go; - - my $recs = $search->request( - 'open-ils.search.biblio.multiclass.query' => { - org_unit => $org_unit->[0]->id, - offset => $offset, - limit => $limit, - sort => $sort, - sort_dir => $sortdir, - default_class => $class, - ($lang ? ( 'language' => $lang ) : ()), - } => $safe_terms => 1 - )->gather(1); - - $log->debug("Hits for [$terms]: $recs->{count}"); - - my $feed = create_record_feed( - 'record', - $type, - [ map { $_->[0] } @{$recs->{ids}} ], - $unapi, - $org, - undef, - $flesh_feed - ); - - $log->debug("Feed created..."); - - $feed->root($root); - $feed->lib($org); - $feed->search($safe_terms); - $feed->class($class); - - $feed->title("Search results for [$terms] at ".$org_unit->[0]->name); - - $feed->creator($host); - $feed->update_ts(); - - $feed->_create_node( - $feed->{item_xpath}, - 'http://a9.com/-/spec/opensearch/1.1/', - 'totalResults', - $recs->{count}, - ); - - $feed->_create_node( - $feed->{item_xpath}, - 'http://a9.com/-/spec/opensearch/1.1/', - 'startIndex', - $offset + 1, - ); - - $feed->_create_node( - $feed->{item_xpath}, - 'http://a9.com/-/spec/opensearch/1.1/', - 'itemsPerPage', - $limit, - ); - - $log->debug("...basic feed data added..."); - - $feed->link( - next => - $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit => - 'application/opensearch+xml' - ) if ($offset + $limit < $recs->{count}); - - $feed->link( - previous => - $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit => - 'application/opensearch+xml' - ) if ($offset); - - $feed->link( - self => - $base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" => - 'application/opensearch+xml' - ); - - $feed->link( - alternate => - $base . "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" => - 'application/rss+xml' - ); - - $feed->link( - atom => - $base . "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" => - 'application/atom+xml' - ); - - $feed->link( - 'html' => - $base . "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" => - 'text/html' - ); - - $feed->link( - 'html-full' => - $base . "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" => - 'text/html' - ); - - $feed->link( 'unapi-server' => $unapi); - - $log->debug("...feed links added..."); - -# $feed->link( -# opac => -# $root . "../$lang/skin/default/xml/rresult.xml?rt=list&" . -# join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ), -# 'text/html' -# ); - - #print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n"; - print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . $feed->toString . "\n"; - - $log->debug("...and feed returned."); - - return Apache2::Const::OK; -} - -sub create_record_feed { - my $search = shift; - my $type = shift; - my $records = shift; - my $unapi = shift; - - my $lib = uc(shift()) || '-'; - my $depth = shift; - my $flesh = shift; - - my $paging = shift; - - my $cgi = new CGI; - my $base = $cgi->url; - my $host = $cgi->virtual_host || $cgi->server_name; - - my ($year,$month,$day) = reverse( (localtime)[3,4,5] ); - $year += 1900; - $month += 1; - - my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day); - - my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type); - - $type =~ s/(-full|-uris)$//o; - - my $feed = new OpenILS::WWW::SuperCat::Feed ($type); - $feed->base($base) if ($flesh); - $feed->unapi($unapi) if ($flesh); - - $type = 'atom' if ($type eq 'html'); - $type = 'marcxml' if (($type eq 'htmlholdings') || ($type eq 'marctxt') || ($type eq 'ris')); - - #$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1); - - my $count = 0; - for my $record (@$records) { - next unless($record); - - #my $rec = $record->id; - my $rec = $record; - - my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib"; - $item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord'); - $item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn'); - $item_tag .= "/$depth" if (defined($depth)); - - $item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority'); - - my $xml = $supercat->request( - "open-ils.supercat.$search.$type.retrieve", - $rec - )->gather(1); - next unless $xml; - - my $node = $feed->add_item($xml); - next unless $node; - - $xml = ''; - if ($lib && ($type eq 'marcxml' || $type eq 'atom') && $flesh > 0) { - my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging ); - while ( !$r->complete ) { - $xml .= join('', map {$_->content} $r->recv); - } - $xml .= join('', map {$_->content} $r->recv); - $node->add_holdings($xml); - } - - $node->id($item_tag); - #$node->update_ts(cleanse_ISO8601($record->edit_date)); - $node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0); - $node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0); - $node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh); - $node->link('unapi-id' => $item_tag) if ($flesh); - } - - return $feed; -} - -sub string_browse { - my $apache = shift; - return Apache2::Const::DECLINED if (-e $apache->filename); - - my $cgi = new CGI; - my $year = (gmtime())[5] + 1900; - - my $host = $cgi->virtual_host || $cgi->server_name; - - my $add_path = 0; - if ( $cgi->server_software !~ m|^Apache/2.2| ) { - my $rel_name = $cgi->url(-relative=>1); - $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/); - } - - my $url = $cgi->url(-path_info=>$add_path); - my $root = (split 'browse', $url)[0]; - my $base = (split 'browse', $url)[0] . 'browse'; - my $unapi = (split 'browse', $url)[0] . 'unapi'; - - my $path = $cgi->path_info; - $path =~ s/^\///og; - - my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path; - #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size "; - - return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub - - my $status = [$cgi->param('status')]; - my $cpLoc = [$cgi->param('copyLocation')]; - $site ||= $cgi->param('searchOrg'); - $page ||= $cgi->param('startPage') || 0; - $page_size ||= $cgi->param('count') || 9; - - $page = 0 if ($page !~ /^-?\d+$/); - $page_size = 9 if $page_size !~ /^\d+$/; - - my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size); - my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size); - - unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) { - warn "something's wrong..."; - warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size "; - return undef; - } - - $string = decode_utf8($string); - $string =~ s/\+/ /go; - $string =~ s/'//go; - - my $tree = $supercat->request( - "open-ils.supercat.$axis.browse", - $string, - (($axis =~ /^authority/) ? () : ($site)), - $page_size, - $page, - $status, - $cpLoc - )->gather(1); - - (my $norm_format = $format) =~ s/(-full|-uris)$//o; - - my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site); - print $header.$content; - return Apache2::Const::OK; -} - -sub string_startwith { - my $apache = shift; - return Apache2::Const::DECLINED if (-e $apache->filename); - - my $cgi = new CGI; - my $year = (gmtime())[5] + 1900; - - my $host = $cgi->virtual_host || $cgi->server_name; - - my $add_path = 0; - if ( $cgi->server_software !~ m|^Apache/2.2| ) { - my $rel_name = $cgi->url(-relative=>1); - $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/); - } - - my $url = $cgi->url(-path_info=>$add_path); - my $root = (split 'startwith', $url)[0]; - my $base = (split 'startwith', $url)[0] . 'startwith'; - my $unapi = (split 'startwith', $url)[0] . 'unapi'; - - my $path = $cgi->path_info; - $path =~ s/^\///og; - - my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path; - #warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size "; - - my $status = [$cgi->param('status')]; - my $cpLoc = [$cgi->param('copyLocation')]; - $site ||= $cgi->param('searchOrg'); - $page ||= $cgi->param('startPage') || 0; - $page_size ||= $cgi->param('count') || 9; - - $page = 0 if ($page !~ /^-?\d+$/); - $page_size = 9 if $page_size !~ /^\d+$/; - - my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size); - my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size); - - unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) { - warn "something's wrong..."; - warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size "; - return undef; - } - - $string = decode_utf8($string); - $string =~ s/\+/ /go; - $string =~ s/'//go; - - my $tree = $supercat->request( - "open-ils.supercat.$axis.startwith", - $string, - (($axis =~ /^authority/) ? () : ($site)), - $page_size, - $page, - $status, - $cpLoc - )->gather(1); - - (my $norm_format = $format) =~ s/(-full|-uris)$//o; - - my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site); - print $header.$content; - return Apache2::Const::OK; -} - -sub item_age_browse { - my $apache = shift; - return Apache2::Const::DECLINED if (-e $apache->filename); - - my $cgi = new CGI; - my $year = (gmtime())[5] + 1900; - - my $host = $cgi->virtual_host || $cgi->server_name; - - my $add_path = 0; - if ( $cgi->server_software !~ m|^Apache/2.2| ) { - my $rel_name = $cgi->url(-relative=>1); - $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/); - } - - my $url = $cgi->url(-path_info=>$add_path); - my $root = (split 'browse', $url)[0]; - my $base = (split 'browse', $url)[0] . 'browse'; - my $unapi = (split 'browse', $url)[0] . 'unapi'; - - my $path = $cgi->path_info; - $path =~ s/^\///og; - - my ($format,$axis,$site,$page,$page_size) = split '/', $path; - #warn " >>> $format -> $axis -> $site -> $page -> $page_size "; - - unless ($axis eq 'item-age') { - warn "something's wrong..."; - warn " >>> $format -> $axis -> $site -> $page -> $page_size "; - return undef; - } - - my $status = [$cgi->param('status')]; - my $cpLoc = [$cgi->param('copyLocation')]; - $site ||= $cgi->param('searchOrg') || '-'; - $page ||= $cgi->param('startPage') || 1; - $page_size ||= $cgi->param('count') || 10; - - $page = 1 if ($page !~ /^-?\d+$/ || $page < 1); - $page_size = 10 if $page_size !~ /^\d+$/; - - my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size); - my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size); - - my $recs = $supercat->request( - "open-ils.supercat.new_book_list", - $site, - $page_size, - $page, - $status, - $cpLoc - )->gather(1); - - (my $norm_format = $format) =~ s/(-full|-uris)$//o; - - my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site); - print $header.$content; - return Apache2::Const::OK; -} - -our %qualifier_map = ( - - # Some EG qualifiers - 'eg.site' => 'site', - 'eg.sort' => 'sort', - 'eg.direction' => 'dir', - 'eg.available' => 'available', - - # Title class: - 'eg.title' => 'title', - 'dc.title' => 'title', - 'bib.titleabbreviated' => 'title|abbreviated', - 'bib.titleuniform' => 'title|uniform', - 'bib.titletranslated' => 'title|translated', - 'bib.titlealternative' => 'title', - 'bib.titleseries' => 'series', - 'eg.series' => 'title', - - # Author/Name class: - 'eg.author' => 'author', - 'eg.name' => 'author', - 'creator' => 'author', - 'dc.creator' => 'author', - 'dc.contributer' => 'author', - 'dc.publisher' => 'keyword', - 'bib.name' => 'author', - 'bib.namepersonal' => 'author|personal', - 'bib.namepersonalfamily'=> 'author|personal', - 'bib.namepersonalgiven' => 'author|personal', - 'bib.namecorporate' => 'author|corporate', - 'bib.nameconference' => 'author|conference', - - # Subject class: - 'eg.subject' => 'subject', - 'dc.subject' => 'subject', - 'bib.subjectplace' => 'subject|geographic', - 'bib.subjecttitle' => 'keyword', - 'bib.subjectname' => 'subject|name', - 'bib.subjectoccupation' => 'keyword', - - # Keyword class: - 'eg.keyword' => 'keyword', - 'srw.serverchoice' => 'keyword', - - # Identifiers: - 'dc.identifier' => 'keyword', - - # Dates: - 'bib.dateissued' => undef, - 'bib.datecreated' => undef, - 'bib.datevalid' => undef, - 'bib.datemodified' => undef, - 'bib.datecopyright' => undef, - - # Resource Type: - 'dc.type' => undef, - - # Format: - 'dc.format' => undef, - - # Genre: - 'bib.genre' => 'keyword', - - # Target Audience: - 'bib.audience' => undef, - - # Place of Origin: - 'bib.originplace' => undef, - - # Language - 'dc.language' => 'lang', - - # Edition - 'bib.edition' => 'keyword', - - # Part: - 'bib.volume' => 'keyword', - 'bib.issue' => 'keyword', - 'bib.startpage' => 'keyword', - 'bib.endpage' => 'keyword', - - # Issuance: - 'bib.issuance' => 'keyword', -); - -our %qualifier_ids = ( - eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1', - dc => 'info:srw/cql-context-set/1/dc-v1.1', - bib => 'info:srw/cql-context-set/1/bib-v1.0', - srw => '' -); - -our %nested_qualifier_map = ( - eg => { - site => ['site','Evergreen Site Code (shortname)'], - sort => ['sort','Sort on relevance, title, author, pubdate, create_date or edit_date'], - direction => ['dir','Sort direction (asc|desc)'], - available => ['available','Filter to available (true|false)'], - title => ['title'], - author => ['author'], - name => ['author'], - subject => ['subject'], - keyword => ['keyword'], - series => ['series'], - }, - dc => { - title => ['title'], - creator => ['author'], - contributor => ['author'], - publisher => ['keyword'], - subject => ['subject'], - identifier => ['keyword'], - type => [undef], - format => [undef], - language => ['lang'], - }, - bib => { - # Title class: - titleAbbreviated => ['title'], - titleUniform => ['title'], - titleTranslated => ['title'], - titleAlternative => ['title'], - titleSeries => ['series'], - - # Author/Name class: - name => ['author'], - namePersonal => ['author'], - namePersonalFamily => ['author'], - namePersonalGiven => ['author'], - nameCorporate => ['author'], - nameConference => ['author'], - - # Subject class: - subjectPlace => ['subject'], - subjectTitle => ['keyword'], - subjectName => ['subject|name'], - subjectOccupation => ['keyword'], - - # Keyword class: - - # Dates: - dateIssued => [undef], - dateCreated => [undef], - dateValid => [undef], - dateModified => [undef], - dateCopyright => [undef], - - # Genre: - genre => ['keyword'], - - # Target Audience: - audience => [undef], - - # Place of Origin: - originPlace => [undef], - - # Edition - edition => ['keyword'], - - # Part: - volume => ['keyword'], - issue => ['keyword'], - startPage => ['keyword'], - endPage => ['keyword'], - - # Issuance: - issuance => ['keyword'], - }, - srw => { - serverChoice => ['keyword'], - }, -); - - -my $base_explain = < - - - - - - - - - <description primary="true"/> - </databaseInfo> - - <indexInfo> - <set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/> - </indexInfo> - - <schemaInfo> - <schema - identifier="info:srw/schema/1/marcxml-v1.1" - location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd" - sort="true" - retrieve="true" - name="marcxml"> - <title>MARC21Slim (marcxml) - - - - - 50 - eg - keyword - all - marcxml - marcxml - 50 - relevant - stem - fuzzy - word - - - -XML - - -my $ex_doc; -sub sru_search { - my $cgi = new CGI; - - my $req = SRU::Request->newFromCGI( $cgi ); - my $resp = SRU::Response->newFromRequest( $req ); - - # Find the org_unit shortname, if passed as part of the URL - # http://example.com/opac/extras/sru/SHORTNAME - my $url = $cgi->path_info; - my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#; - - if ( $resp->type eq 'searchRetrieve' ) { - - # Older versions of Debian packages returned terms to us double-encoded, - # so we had to forcefully double-decode them a second time with - # an outer decode('utf8', $string) call; this seems to be resolved with - # Debian Lenny packages sometime between 2009-07-27 and 2010-02-15 - my $cql_query = decode_utf8($req->query); - my $search_string = decode_utf8($req->cql->toEvergreen); - - # Ensure the search string overrides the default site - if ($shortname and $search_string !~ m#site:#) { - $search_string .= " site:$shortname"; - } - - my $offset = $req->startRecord; - $offset-- if ($offset); - $offset ||= 0; - - my $limit = $req->maximumRecords; - $limit ||= 10; - - $log->info("SRU search string [$cql_query] converted to [$search_string]\n"); - - my $recs = $search->request( - 'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1 - )->gather(1); - - my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1); - - foreach my $record (@$bre) { - my $marcxml = $record->marc; - # Make the beast conform to a VDX-supported format - # See http://vdxipedia.oclc.org/index.php/Holdings_Parsing - # Trying to implement LIBSOL_852_A format; so much for standards - if ($holdings) { - my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1); - my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML'); - - # Force record leader to 'a' as our data is always UTF8 - # Avoids marc8_to_utf8 from being invoked with horrible results - # on the off-chance the record leader isn't correct - my $ldr = $marc->leader; - substr($ldr, 9, 1, 'a'); - $marc->leader($ldr); - - # Expects the record ID in the 001 - $marc->delete_field($_) for ($marc->field('001')); - if (!$marc->field('001')) { - $marc->insert_fields_ordered( - MARC::Field->new( '001', $record->id ) - ); - } - $marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s - foreach my $cn (keys %$bib_holdings) { - foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) { - $marc->insert_fields_ordered( - MARC::Field->new( - '852', '4', '', - a => $cp->{'location'}, - b => $bib_holdings->{$cn}->{'owning_lib'}, - c => $cn, - d => $cp->{'circlib'}, - g => $cp->{'barcode'}, - n => $cp->{'status'}, - ) - ); - } - } - - # Ensure the data is encoded as UTF8 before we hand it off - $marcxml = encode_utf8($marc->as_xml_record()); - $marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o; - - } - $resp->addRecord( - SRU::Response::Record->new( - recordSchema => 'info:srw/schema/1/marcxml-v1.1', - recordData => $marcxml, - recordPosition => ++$offset - ) - ); - } - - $resp->numberOfRecords($recs->{count}); - - } elsif ( $resp->type eq 'explain' ) { - if (!$ex_doc) { - my $host = $cgi->virtual_host || $cgi->server_name; - - my $add_path = 0; - if ( $cgi->server_software !~ m|^Apache/2.2| ) { - my $rel_name = $cgi->url(-relative=>1); - $add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/); - } - my $base = $cgi->url(-base=>1); - my $url = $cgi->url(-path_info=>$add_path); - $url =~ s/^$base\///o; - - my $doc = $parser->parse_string($base_explain); - my $e = $doc->documentElement; - $e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host ); - $e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port ); - $e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url ); - - for my $name ( keys %OpenILS::WWW::SuperCat::nested_qualifier_map ) { - - my $identifier = $OpenILS::WWW::SuperCat::qualifier_ids{ $name }; - - next unless $identifier; - - my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' ); - $set_node->setAttribute( identifier => $identifier ); - $set_node->setAttribute( name => $name ); - - $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node ); - - for my $index ( keys %{ $OpenILS::WWW::SuperCat::nested_qualifier_map{$name} } ) { - my $desc = $OpenILS::WWW::SuperCat::nested_qualifier_map{$name}{$index}[1] || $index; - - my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' ); - - my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' ); - $map_node->appendChild( $name_node ); - - my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' ); - - my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' ); - $index_node->appendChild( $title_node ); - $index_node->appendChild( $map_node ); - - $index_node->setAttribute( id => $name . '.' . $index ); - $title_node->appendText( $desc ); - $name_node->setAttribute( set => $name ); - $name_node->appendText($index ); - - $e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node ); - } - } - - $ex_doc = $e->toString; - } - - $resp->record( - SRU::Response::Record->new( - recordSchema => 'info:srw/cql-context-set/2/zeerex-1.1', - recordData => $ex_doc - ) - ); - } - - print $cgi->header( -type => 'application/xml' ); - print $U->entityize($resp->asXML) . "\n"; - return Apache2::Const::OK; -} - - -{ - package CQL::BooleanNode; - - sub toEvergreen { - my $self = shift; - my $left = $self->left(); - my $right = $self->right(); - my $leftStr = $left->toEvergreen; - my $rightStr = $right->toEvergreen(); - - my $op = '||' if uc $self->op() eq 'OR'; - $op ||= '&&'; - - return "$leftStr $rightStr"; - } - - package CQL::TermNode; - - sub toEvergreen { - my $self = shift; - my $qualifier = $self->getQualifier(); - my $term = $self->getTerm(); - my $relation = $self->getRelation(); - - my $query; - if ( $qualifier ) { - my ($qset, $qname) = split(/\./, $qualifier); - - $log->debug("SRU toEvergreen: $qset, $qname $OpenILS::WWW::SuperCat::nested_qualifier_map{$qset}{$qname}[0]\n"); - - if ( exists($OpenILS::WWW::SuperCat::nested_qualifier_map{$qset}{$qname}) ) { - $qualifier = $OpenILS::WWW::SuperCat::nested_qualifier_map{$qset}{$qname}[0] || 'kw'; - } - - my @modifiers = $relation->getModifiers(); - - my $base = $relation->getBase(); - if ( grep { $base eq $_ } qw/= scr exact all/ ) { - - my $quote_it = 1; - foreach my $m ( @modifiers ) { - if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) { - $quote_it = 0; - last; - } - } - - $quote_it = 0 if ( $base eq 'all' ); - $term = maybeQuote($term) if $quote_it; - - } else { - croak( "Evergreen doesn't support the $base relations" ); - } - - - } else { - $qualifier = "kw"; - } - - return "$qualifier:$term"; - } -} - -=head2 get_ou($org_unit) - -Returns an aou object for a given actor.org_unit shortname or ID. - -=cut - -sub get_ou { - my $org = shift || '-'; - my $org_unit; - - if ($org eq '-') { - $org_unit = $actor->request( - 'open-ils.actor.org_unit_list.search' => parent_ou => undef - )->gather(1); - } elsif ($org !~ /^\d+$/o) { - $org_unit = $actor->request( - 'open-ils.actor.org_unit_list.search' => shortname => uc($org) - )->gather(1); - } else { - $org_unit = $actor->request( - 'open-ils.actor.org_unit_list.search' => id => $org - )->gather(1); - } - - return $org_unit; -} - -1; - -# vim: noet:ts=4:sw=4 diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/SuperCat/Feed.pm b/Open-ILS/src/perlmods/OpenILS/WWW/SuperCat/Feed.pm deleted file mode 100644 index cd11a7542a..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/SuperCat/Feed.pm +++ /dev/null @@ -1,852 +0,0 @@ -package OpenILS::WWW::SuperCat::Feed; -use strict; use warnings; -use vars qw/$parser/; -use OpenSRF::EX qw(:try); -use XML::LibXML; -use XML::LibXSLT; -use OpenSRF::Utils::SettingsClient; -use CGI; -use DateTime; -use DateTime::Format::Mail; - - -sub exists { - my $class = shift; - my $type = shift; - - return 1 if UNIVERSAL::can("OpenILS::WWW::SuperCat::Feed::$type" => 'new'); - return 0; -} - -sub new { - my $class = shift; - my $type = shift; - if ($type) { - $class .= '::'.$type; - return $class->new; - } - throw OpenSRF::EX::ERROR ("I need a feed type!") ; -} - -sub build { - my $class = shift; - my $xml = shift; - return undef unless $xml; - - $parser = new XML::LibXML if (!$parser); - - my $self = { doc => $parser->parse_string($xml), items => [] }; - - $self = bless $self => $class; - $self->{count} = 0; - return $self; -} - -sub type { - my $self = shift; - my $type = shift; - $self->{type} = $type if ($type); - return $self->{type}; -} - -sub count { - my $self = shift; - return $self->{count}; -} - -sub search { - my $self = shift; - my $search = shift; - $self->{search} = $search if ($search); - return $self->{search}; -} - -sub class { - my $self = shift; - my $search = shift; - $self->{class} = $search if ($search); - return $self->{class}; -} - -sub Sort { - my $self = shift; - my $search = shift; - $self->{sort} = $search if ($search); - return $self->{sort}; -} - -sub SortDir { - my $self = shift; - my $search = shift; - $self->{sort_dir} = $search if ($search); - return $self->{sort_dir}; -} - -sub lang { - my $self = shift; - my $search = shift; - $self->{lang} = $search if ($search); - return $self->{lang}; -} - -sub lib { - my $self = shift; - my $lib = shift; - $self->{lib} = $lib if ($lib); - return $self->{lib}; -} - -sub base { - my $self = shift; - my $base = shift; - $self->{base} = $base if ($base); - return $self->{base}; -} - -sub root { - my $self = shift; - my $root = shift; - $self->{root} = $root if ($root); - return $self->{root}; -} - -sub unapi { - my $self = shift; - my $unapi = shift; - $self->{unapi} = $unapi if ($unapi); - return $self->{unapi}; -} - -sub push_item { - my $self = shift; - $self->{count} += scalar(@_); - push @{ $self->{items} }, @_; -} - -sub items { - my $self = shift; - return @{ $self->{items} } if (wantarray); - return $self->{items}; -} - -sub _add_node { - my $self = shift; - - my $xpath = shift; - my $new = shift; - - for my $node ($self->{doc}->findnodes($xpath)) { - $node->appendChild($new); - last; - } -} - -sub _create_node { - my $self = shift; - - my $xpath = shift; - my $ns = shift; - my $name = shift; - my $text = shift; - my $attrs = shift; - - for my $node ($self->{doc}->findnodes($xpath)) { - my $new = $self->{doc}->createElement($name) if (!$ns); - $new = $self->{doc}->createElementNS($ns,$name) if ($ns); - - $new->appendChild( $self->{doc}->createTextNode( $text ) ) - if (defined $text); - - if (ref($attrs)) { - for my $key (keys %$attrs) { - next unless $$attrs{$key}; - $new->setAttribute( $key => $$attrs{$key} ); - } - } - - $node->appendChild( $new ); - - return $new; - } -} - -sub add_item { - my $self = shift; - my $class = ref($self) || $self; - $class .= '::item'; - - my $item_xml = shift; - my $entry = $class->new($item_xml); - return undef unless $entry; - - $entry->base($self->base); - $entry->unapi($self->unapi); - - $self->push_item($entry); - return $entry; -} - -sub add_holdings { - my $self = shift; - my $holdings_xml = shift; - - return $self unless ($holdings_xml); - - $parser = new XML::LibXML if (!$parser); - my $new_doc = $parser->parse_string($holdings_xml); - - for my $root ( $self->{doc}->findnodes($self->{holdings_xpath}) ) { - $root->appendChild($new_doc->documentElement); - last; - } - return $self; -} - -sub composeDoc { - my $self = shift; - for my $root ( $self->{doc}->findnodes($self->{item_xpath}) ) { - for my $item ( $self->items ) { - $root->appendChild( $item->{doc}->documentElement ); - } - last; - } -} - -sub toString { - my $self = shift; - $self->composeDoc; - return $self->{doc}->toString(1); -} - -sub id {}; -sub link {}; -sub title {}; -sub update_ts {}; -sub creator {}; - -#---------------------------------------------------------- - -package OpenILS::WWW::SuperCat::Feed::atom; -use base 'OpenILS::WWW::SuperCat::Feed'; -use OpenSRF::Utils qw/:datetime/; - -sub new { - my $class = shift; - my $self = $class->SUPER::build(''); - $self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', undef); - $self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', 'atom'); - $self->{type} = 'application/atom+xml'; - $self->{item_xpath} = '/atom:feed'; - return $self; -} - -sub title { - my $self = shift; - my $text = shift; - $self->_create_node('/atom:feed','http://www.w3.org/2005/Atom','title', $text); -} - -sub update_ts { - my $self = shift; - # ATOM demands RFC-3339 compliant datetime formats - my $text = shift || gmtime_ISO8601(); - $self->_create_node($self->{item_xpath},'http://www.w3.org/2005/Atom','updated', $text); -} - -sub creator { - my $self = shift; - my $text = shift; - $self->_create_node('/atom:feed','http://www.w3.org/2005/Atom','author'); - $self->_create_node('/atom:feed/atom:author', 'http://www.w3.org/2005/Atom','name', $text); -} - -sub link { - my $self = shift; - my $type = shift; - my $id = shift; - my $mime = shift || "application/x-$type+xml"; - my $title = shift; - - $type = 'self' if ($type eq 'atom'); - - $self->_create_node( - $self->{item_xpath}, - 'http://www.w3.org/2005/Atom', - 'link', - undef, - { rel => $type, - href => $id, - title => $title, - type => $mime, - } - ); -} - -sub id { - my $self = shift; - my $id = shift; - - $self->_create_node( $self->{item_xpath}, 'http://www.w3.org/2005/Atom', 'id', $id ); -} - -package OpenILS::WWW::SuperCat::Feed::atom::item; -use base 'OpenILS::WWW::SuperCat::Feed::atom'; - -sub new { - my $class = shift; - my $xml = shift; - my $self = $class->SUPER::build($xml); - $self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', undef); - $self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', 'atom'); - $self->{item_xpath} = '/atom:entry'; - $self->{holdings_xpath} = '/atom:entry'; - $self->{type} = 'application/atom+xml'; - return $self; -} - - -#---------------------------------------------------------- - -package OpenILS::WWW::SuperCat::Feed::rss2; -use base 'OpenILS::WWW::SuperCat::Feed'; - -sub new { - my $class = shift; - my $self = $class->SUPER::build(''); - $self->{type} = 'application/rss+xml'; - $self->{item_xpath} = '/rss/channel'; - return $self; -} - -sub title { - my $self = shift; - my $text = shift; - $self->_create_node('/rss/channel',undef,'title', $text); - # RSS2 demands a /channel/description element; just dupe title until we give - # users the ability to provide a description for their bookbags - $self->_create_node('/rss/channel',undef,'description', $text); -} - -sub update_ts { - my $self = shift; - # RSS2 demands RFC-822 compliant datetime formats - my $text = shift || DateTime::Format::Mail->format_datetime(DateTime->now()); - $self->_create_node($self->{item_xpath},undef,'lastBuildDate', $text); -} - -sub creator { - my $self = shift; - my $text = shift; - $self->_create_node('/rss/channel', undef,'generator', $text); -} - -sub link { - my $self = shift; - my $type = shift; - my $id = shift; - my $mime = shift || "application/x-$type+xml"; - - if ($type eq 'rss2' or $type eq 'alternate') { - # Just link to ourself using standard RSS2 link element - $self->_create_node( - $self->{item_xpath}, - undef, - 'link', - $id, - undef - ); - } else { - # Alternate link: use XHTML link element - $self->_create_node( - $self->{item_xpath}, - 'http://www.w3.org/1999/xhtml', - 'xhtml:link', - $id, - { rel => $type, - type => $mime, - } - ); - } -} - -sub id { - my $self = shift; - my $id = shift; - - $self->_create_node($self->{item_xpath}, undef,'guid', $id); -} - -package OpenILS::WWW::SuperCat::Feed::rss2::item; -use base 'OpenILS::WWW::SuperCat::Feed::rss2'; - -sub new { - my $class = shift; - my $xml = shift; - my $self = $class->SUPER::build($xml); - $self->{type} = 'application/rss+xml'; - $self->{item_xpath} = '/item'; - $self->{holdings_xpath} = '/item'; - return $self; -} - -sub update_ts { - my $self = shift; - # RSS2 demands RFC-822 compliant datetime formats - my $text = shift; - if (!$text) { - # No date passed in, default to now - $text = DateTime::Format::Mail->format_datetime(DateTime->now()); - } elsif ($text =~ m/^\s*(\d{4})\.?\s*$/o) { - # Publication date is just a year, convert accordingly - my $year = DateTime->new(year=>$1); - $text = DateTime::Format::Mail->format_datetime($year); - } - $self->_create_node($self->{item_xpath},undef,'pubDate', $text); -} - -sub id { - my $self = shift; - my $id = shift; - - $self->_create_node( - $self->{item_xpath}, - undef, - 'guid', - $id, - { - isPermaLink=>"false" - } - ); -} - -#---------------------------------------------------------- - -package OpenILS::WWW::SuperCat::Feed::mods; -use base 'OpenILS::WWW::SuperCat::Feed'; - -sub new { - my $class = shift; - my $self = $class->SUPER::build(''); - $self->{type} = 'application/xml'; - $self->{item_xpath} = '/mods:modsCollection'; - return $self; -} - -package OpenILS::WWW::SuperCat::Feed::mods::item; -use base 'OpenILS::WWW::SuperCat::Feed::mods'; - -sub new { - my $class = shift; - my $xml = shift; - my $self = $class->SUPER::build($xml); - $self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/', 'mods'); - $self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/', undef, 1); - $self->{type} = 'application/xml'; - $self->{holdings_xpath} = '/mods:mods'; - return $self; -} - -my $linkid = 1; - -sub link { - my $self = shift; - my $type = shift; - my $id = shift; - - if ($type eq 'unapi' || $type eq 'opac') { - $self->_create_node( - 'mods:mods', - undef, - 'relatedItem', - undef, - { type => 'otherFormat', id => 'link-'.$linkid } - ); - $self->_create_node( - "mods:mods/relatedItem[\@id='link-$linkid']", - undef, - 'recordIdentifier', - $id - ); - $linkid++; - } -} - -#---------------------------------------------------------- - -package OpenILS::WWW::SuperCat::Feed::mods3; -use base 'OpenILS::WWW::SuperCat::Feed::mods'; - -sub new { - my $class = shift; - my $self = $class->SUPER::build(''); - $self->{type} = 'application/xml'; - $self->{item_xpath} = '/mods:modsCollection'; - return $self; -} - -package OpenILS::WWW::SuperCat::Feed::mods3::item; -use base 'OpenILS::WWW::SuperCat::Feed::mods::item'; - -sub new { - my $class = shift; - my $xml = shift; - my $self = $class->SUPER::build($xml); - $self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/v3', 'mods'); - $self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/v3', undef, 1); - $self->{type} = 'application/xml'; - $self->{holdings_xpath} = '/mods:mods'; - return $self; -} - -sub link { - my $self = shift; - my $type = shift; - my $id = shift; - - if ($type eq 'unapi' || $type eq 'opac') { - $self->_create_node( - 'mods:mods', - undef, - 'relatedItem', - undef, - { type => 'otherFormat', id => 'link-'.$linkid } - ); - $self->_create_node( - "mods:mods/relatedItem[\@id='link-$linkid']", - undef, - 'recordIdentifier', - $id - ); - $linkid++; - } -} - - -#---------------------------------------------------------- - -package OpenILS::WWW::SuperCat::Feed::mods32; -use base 'OpenILS::WWW::SuperCat::Feed::mods3'; - -sub new { - my $class = shift; - my $self = $class->SUPER::build(''); - $self->{type} = 'application/xml'; - $self->{item_xpath} = '/mods:modsCollection'; - return $self; -} - -package OpenILS::WWW::SuperCat::Feed::mods32::item; -use base 'OpenILS::WWW::SuperCat::Feed::mods3::item'; - -#---------------------------------------------------------- - -package OpenILS::WWW::SuperCat::Feed::mods33; -use base 'OpenILS::WWW::SuperCat::Feed::mods3'; - -sub new { - my $class = shift; - my $self = $class->SUPER::build(''); - $self->{type} = 'application/xml'; - $self->{item_xpath} = '/mods:modsCollection'; - return $self; -} - -package OpenILS::WWW::SuperCat::Feed::mods33::item; -use base 'OpenILS::WWW::SuperCat::Feed::mods3::item'; - - -#---------------------------------------------------------- - -package OpenILS::WWW::SuperCat::Feed::marcxml; -use base 'OpenILS::WWW::SuperCat::Feed'; - -sub new { - my $class = shift; - my $self = $class->SUPER::build(''); - $self->{type} = 'application/xml'; - $self->{item_xpath} = '/marc:collection'; - return $self; -} -sub link { - my $self = shift; - my $type = shift; - my $id = shift; - - if ($type eq 'unapi') { - $self->_create_node( - 'marc:collection', - 'http://www.w3.org/1999/xhtml', - 'xhtml:link', - undef, - { rel => 'unapi-server', href => $id, title => "unapi" } - ); - $linkid++; - } -} - - -package OpenILS::WWW::SuperCat::Feed::marcxml::item; -use base 'OpenILS::WWW::SuperCat::Feed::marcxml'; - -sub new { - my $class = shift; - my $xml = shift; - my $self = $class->SUPER::build($xml); - return undef unless $self; - $self->{doc}->documentElement->setNamespace('http://www.loc.gov/MARC21/slim', undef); - $self->{type} = 'application/xml'; - $self->{holdings_xpath} = '/*[local-name()="record"]'; - return $self; -} - -sub link { - my $self = shift; - my $type = shift; - my $id = shift; - - if ($type eq 'opac') { - $self->_create_node( - '*[local-name()="record"]', - 'http://www.w3.org/1999/xhtml', - 'xhtml:link', - undef, - { rel => 'otherFormat', href => $id, title => "Dynamic Details" } - ); - $linkid++; - } elsif ($type eq 'unapi-id') { - $self->_create_node( - '*[local-name()="record"]', - 'http://www.w3.org/1999/xhtml', - 'xhtml:abbr', - undef, - { title => $id, class => "unapi-id" } - ); - $linkid++; - } -} - - -#---------------------------------------------------------- - -package OpenILS::WWW::SuperCat::Feed::html; -use base 'OpenILS::WWW::SuperCat::Feed::atom'; - -sub new { - my $class = shift; - my $self = $class->SUPER::new; - $self->type('text/html'); - return $self; -} - -our ($_parser, $_xslt, $xslt_file); - -sub toString { - my $self = shift; - my $base = $self->base || ''; - my $root = $self->root || ''; - my $search = $self->search || ''; - my $class = $self->class || ''; - my $lib = $self->lib || '-'; - - $self->composeDoc; - - $_parser ||= new XML::LibXML; - $_xslt ||= new XML::LibXSLT; - - $xslt_file ||= - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ). - "/ATOM2XHTML.xsl"; - - # parse the MODS xslt ... - my $atom2html_xslt = $_xslt->parse_stylesheet( $_parser->parse_file($xslt_file) ); - - my $new_doc = $atom2html_xslt->transform( - $self->{doc}, - base_dir => "'$root'", - lib => "'$lib'", - searchTerms => "'$search'", - searchClass => "'$class'", - ); - - return $new_doc->toString(1); -} - - -package OpenILS::WWW::SuperCat::Feed::html::item; -use base 'OpenILS::WWW::SuperCat::Feed::atom::item'; - -#---------------------------------------------------------- - -package OpenILS::WWW::SuperCat::Feed::htmlcard; -use base 'OpenILS::WWW::SuperCat::Feed::marcxml'; - -sub new { - my $class = shift; - my $self = $class->SUPER::new; - $self->type('text/html'); - $self->{xsl} = "/MARC21slim2HTMLCard.xsl"; - return $self; -} - -our ($_parser, $_xslt, $xslt_file); - -sub toString { - my $self = shift; - my $base = $self->base || ''; - my $root = $self->root || ''; - my $search = $self->search || ''; - my $sort = $self->Sort || ''; - my $sort_dir = $self->SortDir || ''; - my $lang = $self->lang || ''; - my $lib = $self->lib || '-'; - - $self->composeDoc; - - $_parser ||= new XML::LibXML; - $_xslt ||= new XML::LibXSLT; - - $xslt_file = - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ).$self->{xsl}; - - # parse the MODS xslt ... - my $atom2html_xslt = $_xslt->parse_stylesheet( $_parser->parse_file($xslt_file) ); - - my $new_doc = $atom2html_xslt->transform( - $self->{doc}, - base_dir => "'$root'", - lib => "'$lib'", - searchTerms => "'$search'", - searchSort => "'$sort'", - searchSortDir => "'$sort_dir'", - searchLang => "'$lang'", - ); - - return $new_doc->toString(1); -} - -package OpenILS::WWW::SuperCat::Feed::htmlcard::item; -use base 'OpenILS::WWW::SuperCat::Feed::marcxml::item'; - -package OpenILS::WWW::SuperCat::Feed::htmlholdings; -use base 'OpenILS::WWW::SuperCat::Feed::htmlcard'; - -sub new { - my $class = shift; - my $self = $class->SUPER::new; - $self->{xsl} = "/MARC21slim2HTMLCard-holdings.xsl"; - return $self; -} - -package OpenILS::WWW::SuperCat::Feed::htmlholdings::item; -use base 'OpenILS::WWW::SuperCat::Feed::htmlcard::item'; - - -package OpenILS::WWW::SuperCat::Feed::marctxt; -use base 'OpenILS::WWW::SuperCat::Feed::marcxml'; - -sub new { - my $class = shift; - my $self = $class->SUPER::new; - $self->{type} = 'text/plain'; - $self->{xsl} = "/MARC21slim2MARCtxt.xsl"; - return $self; -} - - -our ($_parser, $_xslt, $xslt_file); - -sub toString { - my $self = shift; - my $base = $self->base || ''; - my $root = $self->root || ''; - my $search = $self->search || ''; - my $class = $self->class || ''; - my $lib = $self->lib || '-'; - - $self->composeDoc; - - $_parser ||= new XML::LibXML; - $_xslt ||= new XML::LibXSLT; - - $xslt_file ||= - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ). - $self->{xsl}; - - # parse the MARC text xslt ... - my $marctxt_xslt = $_xslt->parse_stylesheet( $_parser->parse_file($xslt_file) ); - - my $new_doc = $marctxt_xslt->transform( - $self->{doc}, - base_dir => "'$root'", - lib => "'$lib'", - searchTerms => "'$search'", - searchClass => "'$class'", - ); - - return $marctxt_xslt->output_string($new_doc); -} - - -package OpenILS::WWW::SuperCat::Feed::marctxt::item; -use base 'OpenILS::WWW::SuperCat::Feed::marcxml::item'; - - -package OpenILS::WWW::SuperCat::Feed::ris; -use base 'OpenILS::WWW::SuperCat::Feed::marcxml'; - -sub new { - my $class = shift; - my $self = $class->SUPER::new; - $self->{type} = 'text/plain'; - $self->{xsl} = "/MARC21slim2RIS.xsl"; - return $self; -} - - -our ($_parser, $_xslt, $xslt_file); - -sub toString { - my $self = shift; - my $base = $self->base || ''; - my $root = $self->root || ''; - my $search = $self->search || ''; - my $class = $self->class || ''; - my $lib = $self->lib || '-'; - - $self->composeDoc; - - $_parser ||= new XML::LibXML; - $_xslt ||= new XML::LibXSLT; - - $xslt_file ||= - OpenSRF::Utils::SettingsClient - ->new - ->config_value( dirs => 'xsl' ). - $self->{xsl}; - - # parse the MARC text xslt ... - my $ris_xslt = $_xslt->parse_stylesheet( $_parser->parse_file($xslt_file) ); - - my $new_doc = $ris_xslt->transform( - $self->{doc}, - base_dir => "'$root'", - lib => "'$lib'", - searchTerms => "'$search'", - searchClass => "'$class'", - ); - - return $ris_xslt->output_string($new_doc); -} - - -package OpenILS::WWW::SuperCat::Feed::ris::item; -use base 'OpenILS::WWW::SuperCat::Feed::marcxml::item'; - - -1; diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/TemplateBatchBibUpdate.pm b/Open-ILS/src/perlmods/OpenILS/WWW/TemplateBatchBibUpdate.pm deleted file mode 100644 index 8f9f0ce046..0000000000 --- a/Open-ILS/src/perlmods/OpenILS/WWW/TemplateBatchBibUpdate.pm +++ /dev/null @@ -1,671 +0,0 @@ -package OpenILS::WWW::TemplateBatchBibUpdate; -use strict; -use warnings; -use bytes; - -use Apache2::Log; -use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log); -use APR::Const -compile => qw(:error SUCCESS); -use APR::Table; - -use Apache2::RequestRec (); -use Apache2::RequestIO (); -use Apache2::RequestUtil; -use CGI; -use Data::Dumper; -use Text::CSV; - -use OpenSRF::EX qw(:try); -use OpenSRF::Utils qw/:datetime/; -use OpenSRF::Utils::Cache; -use OpenSRF::System; -use OpenSRF::AppSession; -use XML::LibXML; -use XML::LibXSLT; - -use Encode; -use Unicode::Normalize; -use OpenILS::Utils::Fieldmapper; -use OpenSRF::Utils::Logger qw/$logger/; - -use MARC::Record; -use MARC::File::XML; - -use UNIVERSAL::require; - -our @formats = qw/USMARC UNIMARC XML BRE/; - -# set the bootstrap config and template include directory when -# this module is loaded -my $bootstrap; - -sub import { - my $self = shift; - $bootstrap = shift; -} - - -sub child_init { - OpenSRF::System->bootstrap_client( config_file => $bootstrap ); - Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL")); -} - -sub handler { - my $r = shift; - my $cgi = new CGI; - - my $authid = $cgi->cookie('ses') || $cgi->param('ses'); - my $usr = verify_login($authid); - return show_template($r) unless ($usr); - - my $template = $cgi->param('template'); - return show_template($r) unless ($template); - - - my $rsource = $cgi->param('recordSource'); - # find some IDs ... - my @records; - - if ($rsource eq 'r') { - @records = map { $_ ? ($_) : () } $cgi->param('recid'); - } - - if ($rsource eq 'c') { # try for a file - my $file = $cgi->param('idfile'); - if ($file) { - my $col = $cgi->param('idcolumn') || 0; - my $csv = new Text::CSV; - - while (<$file>) { - $csv->parse($_); - my @data = $csv->fields; - my $id = $data[$col]; - $id =~ s/\D+//o; - next unless ($id); - push @records, $id; - } - } - } - - my $e = OpenSRF::AppSession->connect('open-ils.cstore'); - $e->request('open-ils.cstore.transaction.begin')->gather(1); - - # still no records ... - my $container = $cgi->param('containerid'); - if ($rsource eq 'b') { - if ($container) { - my $bucket = $e->request( - 'open-ils.cstore.direct.container.biblio_record_entry_bucket.retrieve', - $container - )->gather(1); - unless($bucket) { - $e->request('open-ils.cstore.transaction.rollback')->gather(1); - $e->disconnect; - $r->log->error("No such bucket $container"); - $logger->error("No such bucket $container"); - return Apache2::Const::NOT_FOUND; - } - my $recs = $e->request( - 'open-ils.cstore.direct.container.biblio_record_entry_bucket_item.search.atomic', - { bucket => $container } - )->gather(1); - @records = map { ($_->target_biblio_record_entry) } @$recs; - } - } - - unless (@records) { - $e->request('open-ils.cstore.transaction.rollback')->gather(1); - $e->disconnect; - return show_template($r); - } - - # we have a template and some record ids, so... - - # insert the template record - my $min_id = $e->request( - 'open-ils.cstore.json_query', - { select => { bre => [{ column => 'id', transform => 'min', aggregate => 1}] }, from => 'bre' } - )->gather(1)->{id} - 1; - - warn "new template bib id = $min_id\n"; - - my $tmpl_rec = Fieldmapper::biblio::record_entry->new; - $tmpl_rec->id($min_id); - $tmpl_rec->deleted('t'); - $tmpl_rec->active('f'); - $tmpl_rec->marc($template); - $tmpl_rec->creator($usr->id); - $tmpl_rec->editor($usr->id); - - warn "about to create bib $min_id\n"; - $e->request('open-ils.cstore.direct.biblio.record_entry.create', $tmpl_rec )->gather(1); - - # create the new container for the records and the template - my $bucket = Fieldmapper::container::biblio_record_entry_bucket->new; - $bucket->owner($usr->id); - $bucket->btype('template_merge'); - - my $bname = $cgi->param('bname') || 'Temporary Merge Bucket '. localtime() . ' ' . $usr->id; - $bucket->name($bname); - - $bucket = $e->request('open-ils.cstore.direct.container.biblio_record_entry_bucket.create', $bucket )->gather(1); - - # create items in the bucket - my $item = Fieldmapper::container::biblio_record_entry_bucket_item->new; - $item->bucket($bucket->id); - $item->target_biblio_record_entry($min_id); - - $e->request('open-ils.cstore.direct.container.biblio_record_entry_bucket_item.create', $item )->gather(1); - - my %seen; - for my $r (@records) { - next if ($seen{$r}); - $item->target_biblio_record_entry($r); - $e->request('open-ils.cstore.direct.container.biblio_record_entry_bucket_item.create', $item )->gather(1); - $seen{$r}++; - } - - $e->request('open-ils.cstore.transaction.commit')->gather(1); - $e->disconnect; - - # fire the background bucket processor - my $cache_key = OpenSRF::AppSession - ->create('open-ils.cat') - ->request('open-ils.cat.container.template_overlay.background', $authid, $bucket->id) - ->gather(1); - - return show_processing_template($r, $bucket->id, \@records, $cache_key); -} - -sub verify_login { - my $auth_token = shift; - return undef unless $auth_token; - - my $user = OpenSRF::AppSession - ->create("open-ils.auth") - ->request( "open-ils.auth.session.retrieve", $auth_token ) - ->gather(1); - - if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) { - return undef; - } - - return $user if ref($user); - return undef; -} - -sub show_processing_template { - my $r = shift; - my $bid = shift; - my $recs = shift; - my $cache_key = shift; - - my $rec_string = @$recs; - - $r->content_type('text/html'); - $r->print(< - - - Merging records... - - - - - - - - - - - -
- - - - - - - - - - - - - - - - - -
- StatusRecord Count
Success
Failure
- -
- - - -HTML - - return Apache2::Const::OK; -} - - -sub show_template { - my $r = shift; - - $r->content_type('text/html'); - $r->print(<<'HTML'); - - - - Merge Template Builder - - - - - - - - - - - - -
- - - - - - - - - - - - - - - - - - -
Bucket named: -
- -
-
- Column of: - -
-
- Columns are numbered starting at 0. For instance, when looking at a CSV file in Excel, the column labeled A is the same as column 0, and the column labeled B is the same as column 1. -
Record ID:
- - (After setting up your template below.) - -
-
- -
- -
- - - - - -
Update Template Preview:

-
-        
-
-        

-        

-            
-                
-                    
-                        
-                        
-                        
-                    
-                    
-                        
-                        
-                        
-                    
-                    
-                        
-                        
-                    
-                    
-                        
-                        
-                        
-                    
-                    
-                        
-                        
-                        
-                    
-                    
-                        
-                    
-                    
-                        
-                        
-                    
-                        
-                        
-                        
-                    
-                    
-                        
-                    
-                
-            
Rule SetupDataHelp
Action (Rule Type)
-                            
-                        How to change the existing records
MARC Tag
-                        Three characters, no spaces, no indicators, etc. eg: 245
Subfields (optional)No spaces, no delimiters, eg: abcnp
MARC DataMARC-Breaker formatted data with indicators and subfield delimiters, eg:
245 04$aThe End
Advanced Matching Restriction (Optional)
Subfield
-                        A single subfield code, no delimiters, eg: a
Regular ExpressionSee the Perl documentation
-                            for an explanation of Regular Expressions.
-                        

-                            
-                        

-        

-        

-        

-
-    
-
-HTML
-
-    return Apache2::Const::OK;
-}
-
-1;
-
-
diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/Vandelay.pm b/Open-ILS/src/perlmods/OpenILS/WWW/Vandelay.pm
deleted file mode 100644
index 314b2e3153..0000000000
--- a/Open-ILS/src/perlmods/OpenILS/WWW/Vandelay.pm
+++ /dev/null
@@ -1,148 +0,0 @@
-package OpenILS::WWW::Vandelay;
-use strict;
-use warnings;
-use bytes;
-
-use Apache2::Log;
-use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND FORBIDDEN :log);
-use APR::Const    -compile => qw(:error SUCCESS);
-use APR::Table;
-
-use Apache2::RequestRec ();
-use Apache2::RequestIO ();
-use Apache2::RequestUtil;
-use CGI;
-use Data::Dumper;
-use Text::CSV;
-
-use OpenSRF::EX qw(:try);
-use OpenSRF::Utils::Cache;
-use OpenSRF::System;
-use OpenSRF::AppSession;
-use XML::LibXML;
-
-use OpenILS::Utils::Fieldmapper;
-use OpenSRF::Utils::Logger qw/$logger/;
-
-use MARC::Record;
-use MARC::File::XML;
-
-use MIME::Base64;
-use Digest::MD5 qw/md5_hex/;
-use OpenSRF::Utils::SettingsClient;
-
-use UNIVERSAL::require;
-
-our @formats = qw/USMARC UNIMARC XML BRE/;
-my $MAX_FILE_SIZE = 10737418240; #10G
-my $FILE_READ_SIZE = 4096;
-
-# set the bootstrap config and template include directory when
-# this module is loaded
-my $bootstrap;
-
-sub import {
-        my $self = shift;
-        $bootstrap = shift;
-}
-
-
-sub child_init {
-        OpenSRF::System->bootstrap_client( config_file => $bootstrap );
-}
-
-sub spool_marc {
-	my $r = shift;
-	my $cgi = new CGI;
-
-	my $auth = $cgi->param('ses') || $cgi->cookie('ses');
-
-	unless(verify_login($auth)) {
-        $logger->error("authentication failed on vandelay record import: $auth");
-	    return Apache2::Const::FORBIDDEN;
-    }
-
-    my $data_fingerprint = '';
-	my $purpose = $cgi->param('purpose') || '';
-	my $infile = $cgi->param('marc_upload') || '';
-    my $bib_source = $cgi->param('bib_source') || '';
-    my $provider = $cgi->param('provider') || '';
-    my $picklist = $cgi->param('picklist') || '';
-    my $create_po = $cgi->param('create_po') || '';
-    my $activate_po = $cgi->param('activate_po') || '';
-    my $ordering_agency = $cgi->param('ordering_agency') || '';
-    my $create_assets = $cgi->param('create_assets') || '';
-
-    $logger->debug("purpose = $purpose, infile = $infile, bib_source = $bib_source ".
-        "provider = $provider, picklist = $picklist, create_po = $create_po, ordering_agency = $ordering_agency");
-
-	my $conf = OpenSRF::Utils::SettingsClient->new;
-	my $dir = $conf->config_value(
-        apps => 'open-ils.vandelay' => app_settings => databases => 'importer');
-
-    unless(-w $dir) {
-        $logger->error("We need some place to store our MARC files");
-	    return Apache2::Const::FORBIDDEN;
-    }
-
-    if($infile and -e $infile) {
-        my ($total_bytes, $buf, $bytes) = (0);
-	    $data_fingerprint = md5_hex(time."$$".rand());
-        my $outfile = "$dir/$data_fingerprint.mrc";
-
-        unless(open(OUTFILE, ">$outfile")) {
-            $logger->error("unable to open MARC file [$outfile] for writing: $@");
-	        return Apache2::Const::FORBIDDEN;
-        }
-
-        while($bytes = sysread($infile, $buf, $FILE_READ_SIZE)) {
-            $total_bytes += $bytes;
-            if($total_bytes >= $MAX_FILE_SIZE) {
-                close(OUTFILE);
-                unlink $outfile;
-                $logger->error("import exceeded upload size: $MAX_FILE_SIZE");
-	            return Apache2::Const::FORBIDDEN;
-            }
-            print OUTFILE $buf;
-        }
-
-        close(OUTFILE);
-
-	    OpenSRF::Utils::Cache->new->put_cache(
-		    'vandelay_import_spool_' . $data_fingerprint,
-		    {   purpose => $purpose, 
-                path => $outfile,
-                bib_source => $bib_source,
-                provider => $provider,
-                picklist => $picklist,
-                create_po => $create_po,
-                create_assets => $create_assets,
-                ordering_agency => $ordering_agency
-            }
-	    );
-    }
-
-    $logger->info("uploaded MARC batch with key $data_fingerprint");
-    $r->content_type('text/plain; charset=utf-8');
-	print "$data_fingerprint";
-	return Apache2::Const::OK;
-}
-
-sub verify_login {
-        my $auth_token = shift;
-        return undef unless $auth_token;
-
-        my $user = OpenSRF::AppSession
-                ->create("open-ils.auth")
-                ->request( "open-ils.auth.session.retrieve", $auth_token )
-                ->gather(1);
-
-        if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) {
-                return undef;
-        }
-
-        return $user if ref($user);
-        return undef;
-}
-
-1;
diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/Web.pm b/Open-ILS/src/perlmods/OpenILS/WWW/Web.pm
deleted file mode 100644
index 77a2822061..0000000000
--- a/Open-ILS/src/perlmods/OpenILS/WWW/Web.pm
+++ /dev/null
@@ -1,102 +0,0 @@
-package OpenILS::WWW::Web;
-use strict;
-use warnings;
-
-use Apache2::Log;
-use Apache2::Const -compile => qw(OK REDIRECT :log);
-use APR::Const     -compile => qw(:error SUCCESS);
-use Apache2::RequestRec ();
-use Apache2::RequestIO  ();
-use Apache2::RequestUtil;
-
-#use CGI ();
-use Template;
-
-use OpenSRF::EX qw(:try);
-use OpenSRF::System;
-
-my $main_ttk       = "opac/logic/page_router.ttk";
-my $error_ttk      = "opac/pages/error.ttk";
-my $init_ttk       = "opac/logic/page_init.ttk";
-my $bootstrap      = "SYSCONFDIR/opensrf_core.xml";
-my $child_init_ttk = "opac/logic/child_init.ttk";
-
-my $includes = [];    # [  '/pines/cvs/ILS/Open-ILS/src/templates' ];
-
-sub import {
-    my ( $self, $tdir ) = @_;
-    $includes = [$tdir];
-}
-
-my $plugin_base = 'OpenILS::Template::Plugin';
-
-sub handler {
-
-    my $apache = shift;
-    print "Content-type: text/html; charset=utf-8\n\n";
-
-    _process_template(
-        apache      => $apache,
-        template    => $main_ttk,
-        pre_process => $init_ttk
-    );
-
-    return Apache2::Const::OK;
-}
-
-sub child_init_handler {
-    _process_template( template => $child_init_ttk );
-}
-
-sub _process_template {
-
-    my %params      = @_;
-    my $ttk         = $params{template}    || return undef;
-    my $apache      = $params{apache}      || undef;
-    my $pre_process = $params{pre_process} || undef;
-    my $param_hash  = $params{params}      || {};
-
-    my $template;
-
-    $template = Template->new(
-        {
-            OUTPUT       => $apache,
-            ABSOLUTE     => 1,
-            RELATIVE     => 1,
-            PLUGIN_BASE  => $plugin_base,
-            PRE_PROCESS  => $pre_process,
-            INCLUDE_PATH => $includes,
-            PRE_CHOMP    => 1,
-            POST_CHOMP   => 1,
-        }
-    );
-
-    try {
-
-        if ( !$template->process( $ttk, $param_hash ) ) {
-            warn "Error Occured: " . $template->error();
-            my $err = $template->error();
-            $err =~ s/\n/\/g;
-            warn "Error processing template $ttk\n";
-            my $string =
-                "
Unable to process template:

 " 
-              . $err
-              . "!!!";
-            $template->process( $error_ttk, { error => $string } );
-        }
-
-    }
-    catch Error with {
-        my $e = shift;
-        warn "Error processing template $ttk:  $e - $@ \n";
-        print "


Error

 $e 

 $@ 
";
-        return;
-    };
-
-}
-
-# This module appears obsolete (probably superceded by EGWeb.pm
-# The template files it references do not exist in the codebase.
-# File is not referenced elsewhere in the codebase.  Candidate for deletion.
-
-1;
diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/XMLRPCGateway.pm b/Open-ILS/src/perlmods/OpenILS/WWW/XMLRPCGateway.pm
deleted file mode 100644
index ea80f1d0fa..0000000000
--- a/Open-ILS/src/perlmods/OpenILS/WWW/XMLRPCGateway.pm
+++ /dev/null
@@ -1,156 +0,0 @@
-package OpenILS::WWW::XMLRPCGateway;
-use strict; use warnings;
-
-use CGI;
-use Apache2::Log;
-use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
-use APR::Const    -compile => qw(:error SUCCESS);
-use Apache2::RequestRec ();
-use Apache2::RequestIO ();
-use Apache2::RequestUtil;
-use Data::Dumper;
-use UNIVERSAL::require;
-
-use XML::LibXML;
-use OpenSRF::EX qw(:try);
-use OpenSRF::System;
-use OpenSRF::Utils::Cache;
-use OpenSRF::Utils::Logger qw/$logger/;
-use OpenSRF::Utils::SettingsClient;
-
-use RPC::XML qw/smart_encode/;
-use RPC::XML::Parser;
-use RPC::XML::Function;
-use RPC::XML::Method;
-use RPC::XML::Procedure;
-
-$RPC::XML::ENCODING = 'utf-8';
-
-my $services; 						# allowed services
-my $CLASS_KEY = '__class__';	# object wrapper class key
-my $PAYLOAD_KEY = '__data__';	# object wrapper payload key
-my $bs_config; 					# bootstrap config
-my $__inited = 0; 				# has child_init run?
-
-
-# set the bootstrap config when this module is loaded
-sub import { $bs_config = $_[1]; }
-
-
-# Bootstrap and load config settings
-sub child_init {
-	$__inited = 1;
-	OpenSRF::System->bootstrap_client( config_file => $bs_config );
-	my $sclient	= OpenSRF::Utils::SettingsClient->new();
-	my $idl = $sclient->config_value("IDL");
-	$services = $sclient->config_value("xml-rpc", "allowed_services", "service");
-	$services = ref $services ? $services : [ $services ];
-	$logger->debug("XML-RPC: allowed services @$services");
-	OpenILS::Utils::Fieldmapper->require;
-	Fieldmapper->import(IDL => $idl);
-}
-
-
-sub handler {
-
-	my $r		= shift;
-	my $cgi	= CGI->new;
-	my $service = $r->path_info;
-	$service =~ s#^/##;
-
-	child_init() unless $__inited; # ?
-
-	return Apache2::Const::NOT_FOUND unless grep { $_ eq $service } @$services;
-
-	my $request = RPC::XML::Parser->new->parse($cgi->param('POSTDATA'));
-
-	my @args;
-	push( @args, unwrap_perl($_->value) ) for @{$request->args};
-	my $method = $request->name;
-
-	warn "XML-RPC: service=$service, method=$method, args=@args\n";
-	$logger->debug("XML-RPC: service=$service, method=$method, args=@args");
-
-	my $perl = run_request( $service, $method, @args );
-	my $resp = RPC::XML::response->new(smart_encode($perl));
-
-	print "Content-type: application/xml; charset=utf-8\n\n";
-	print $resp->as_string;
-	return Apache2::Const::OK;
-}
-
-
-sub run_request {
-    my( $service, $method, @args ) = @_;
-    my $ses = OpenSRF::AppSession->create( $service );
-    #my $data = $ses->request($method, @args)->gather(1);
-
-    my $data = [];
-    my $req = $ses->request($method, @args);
-    while( my $resp = $req->recv( timeout => 600 ) ) {
-        if( $req->failed ) {
-            push( @$data, $req->failed );
-            last;
-        }
-        push( @$data, $resp->content );
-    }
-
-    return [] if scalar(@$data) == 0;
-    return wrap_perl($$data[0]) 
-        if scalar(@$data) == 1 and $method !~ /.atomic$/og;
-    return wrap_perl($data);
-}
-
-# These should probably be moved out to a library somewhere
-
-sub wrap_perl {
-   my $obj = shift;
-   my $ref = ref($obj);
-
-   if ($ref =~ /^Fieldmapper/o) {
-      $ref = $obj->json_hint;
-      $obj = $obj->to_bare_hash;
-   }
-
-   if( $ref eq 'HASH' ) {
-      $obj->{$_} = wrap_perl( $obj->{$_} ) for (keys %$obj);
-   } elsif( $ref eq 'ARRAY' ) {
-      $obj->[$_] = wrap_perl( $obj->[$_] ) for(0..scalar(@$obj) - 1 );
-   } elsif( $ref ) {
-      if(UNIVERSAL::isa($obj, 'HASH')) {
-         $obj->{$_} = wrap_perl( $obj->{$_} ) for (keys %$obj);
-         bless($obj, 'HASH'); # so our parser won't add the hints
-      } elsif(UNIVERSAL::isa($obj, 'ARRAY')) {
-         $obj->[$_] = wrap_perl( $obj->[$_] ) for(0..scalar(@$obj) - 1);
-         bless($obj, 'ARRAY'); # so our parser won't add the hints
-      }
-      $obj = { $CLASS_KEY => $ref, $PAYLOAD_KEY => $obj };
-   }
-   return $obj;
-}
-
-
-
-sub unwrap_perl {
-   my $obj = shift;
-   my $ref = ref($obj);
-   if( $ref eq 'HASH' ) {
-      if( defined($obj->{$CLASS_KEY})) {
-         my $class = $obj->{$CLASS_KEY};
-         if( $obj = unwrap_perl($obj->{$PAYLOAD_KEY}) ) {
-            return bless(\$obj, $class) unless ref($obj);
-            return bless( $obj, $class );
-         }
-         return undef;
-      }
-      $obj->{$_} = unwrap_perl( $obj->{$_} ) for (keys %$obj);
-   } elsif( $ref eq 'ARRAY' ) {
-      $obj->[$_] = unwrap_perl($obj->[$_]) for(0..scalar(@$obj) - 1);
-   }
-   return $obj;
-}
-
-
-
-
-1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS.pm b/Open-ILS/src/perlmods/lib/OpenILS.pm
new file mode 100644
index 0000000000..cac6530cec
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS.pm
@@ -0,0 +1,7 @@
+#!/usr/bin/perl
+
+package OpenILS;
+
+our $VERSION = '2.00';
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application.pm
new file mode 100644
index 0000000000..cd4dbbf9c0
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application.pm
@@ -0,0 +1,73 @@
+package OpenILS::Application;
+use OpenSRF::Application;
+use UNIVERSAL::require;
+use base qw/OpenSRF::Application/;
+
+sub ils_version {
+    # version format is "x-y-z", for example "2-0-0" for Evergreen 2.0.0
+    # For branches, format is "x-y"
+    return "HEAD";
+}
+
+__PACKAGE__->register_method(
+    api_name    => 'opensrf.open-ils.system.ils_version',
+    api_level   => 1,
+    method      => 'ils_version',
+);
+
+__PACKAGE__->register_method(
+    api_name => 'opensrf.open-ils.fetch_idl.file',
+    api_level => 1,
+    method => 'get_idl_file',
+);
+sub get_idl_file {
+    use OpenSRF::Utils::SettingsClient;
+    return OpenSRF::Utils::SettingsClient->new->config_value('IDL');
+}
+
+sub register_method {
+    my $class = shift;
+    my %args = @_;
+    my %dup_args = %args;
+
+    $class = ref($class) || $class;
+
+    $args{package} ||= $class;
+    __PACKAGE__->SUPER::register_method( %args );
+
+    if (exists($dup_args{authoritative}) and $dup_args{authoritative}) {
+        (my $name = $dup_args{api_name}) =~ s/$/.authoritative/o;
+        if ($name ne $dup_args{api_name}) {
+            $dup_args{real_api_name} = $dup_args{api_name};
+            $dup_args{method} = 'authoritative_wrapper';
+            $dup_args{api_name} = $name;
+            $dup_args{package} = __PACKAGE__;
+            __PACKAGE__->SUPER::register_method( %dup_args );
+        }
+    }
+}
+
+sub authoritative_wrapper {
+
+    if (!$OpenILS::Utils::CStoreEditor::_loaded) {
+        die "Couldn't load OpenILS::Utils::CStoreEditor!" unless 'OpenILS::Utils::CStoreEditor'->use;
+    }
+
+    my $self = shift;
+    my $client = shift;
+    my @args = @_;
+
+    my $method = $self->method_lookup($self->{real_api_name});
+    die unless $method;
+
+    local $OpenILS::Utils::CStoreEditor::always_xact = 1;
+
+    $client->respond( $_ ) for ( $method->run(@args) );
+
+    OpenILS::Utils::CStoreEditor->flush_forced_xacts();
+
+    return undef;
+}
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq.pm
new file mode 100644
index 0000000000..04ba25485e
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq.pm
@@ -0,0 +1,15 @@
+package OpenILS::Application::Acq;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+use OpenILS::Application::Acq::Picklist;
+use OpenILS::Application::Acq::Financials;
+use OpenILS::Application::Acq::Provider;
+use OpenILS::Application::Acq::Lineitem;
+use OpenILS::Application::Acq::Order;
+use OpenILS::Application::Acq::EDI;
+use OpenILS::Application::Acq::Search;
+use OpenILS::Application::Acq::Claims;
+use OpenILS::Application::Acq::Invoice;
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Claims.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Claims.pm
new file mode 100644
index 0000000000..dba843cd88
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Claims.pm
@@ -0,0 +1,349 @@
+package OpenILS::Application::Acq::Claims;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Application::AppUtils;
+use OpenILS::Event;
+my $U = 'OpenILS::Application::AppUtils';
+
+
+__PACKAGE__->register_method(
+	method => 'claim_ready_items',
+	api_name	=> 'open-ils.acq.claim.eligible.lineitem_detail',
+    stream => 1,
+	signature => {
+        desc => q/Locates lineitem_details that are eligible for claiming/,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {   desc => q/
+                    Filter object.  Filter keys include 
+                    purchase_order
+                    lineitem
+                    lineitem_detail
+                    claim_policy_action
+                    ordering_agency
+                /, 
+                type => 'object'
+            },
+            {   desc => q/
+                    Flesh fields.  Which fields to flesh on the response object.  
+                    For valid options, see the filter object
+                q/, 
+                type => 'array'
+            }
+        ],
+        return => {desc => 'Claim ready data', type => 'object', class => 'acrlid'}
+    }
+);
+
+sub claim_ready_items {
+    my($self, $conn, $auth, $filters, $flesh_fields, $limit, $offset) = @_;
+
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+
+    $filters ||= {};
+    $flesh_fields ||= [];
+    $limit ||= 50;
+    $offset ||= 0;
+
+    if(defined $filters->{ordering_agency}) {
+        return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $filters->{ordering_agency});
+    } else {
+        $filters->{ordering_agency} = $U->user_has_work_perm_at($e, 'VIEW_PURCHASE_ORDER', {descendants => 1});
+    }
+
+    my $items = $e->search_acq_claim_ready_lineitem_detail([$filters, {limit => $limit, offset => $offset}]);
+
+    my %cache;
+    for my $item (@$items) {
+
+        # flesh from the flesh fields, using the cache when we can
+        foreach (@$flesh_fields) {
+            my $retrieve = "retrieve_acq_${_}";
+            $cache{$_} = {} unless $cache{$_};
+            $item->$_( 
+                $cache{$_}{$item->$_} || 
+                ($cache{$_}{$item->$_} = $e->$retrieve($item->$_))
+            );
+        }
+
+        $conn->respond($item);
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method(
+    method => "claim_item",
+    api_name => "open-ils.acq.claim.lineitem",
+    stream => 1,
+    signature => {
+        desc => q/Initiates a claim for a lineitem/,
+        params => [
+            {desc => "Authentication token", type => "string"},
+            {desc => "Lineitem ID", type => "number"},
+            {desc => q/Claim (acqcl) ID.  If defined, attach new claim
+                events to this existing claim object/, type => "number"},
+            {desc => q/Claim Type (acqclt) ID.  If defined (and no claim is
+                defined), create a new claim with this type/, type => "number"},
+            {desc => "Note for the claim event", type => "string"},
+            {desc => q/Optional: Claim Policy Actions.  If not present,
+                claim events for all eligible claim policy actions will be
+                created.  This is an array of acqclpa IDs./,
+                type => "array"},
+        ],
+        return => {
+            desc => "The claim voucher events on success, Event on error",
+            type => "object", class => "acrlid"
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+	method => 'claim_item',
+	api_name	=> 'open-ils.acq.claim.lineitem_detail',
+    stream => 1,
+	signature => {
+        desc => q/Initiates a claim for an individual lineitem_detail/,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Lineitem Detail ID', type => 'number'},
+            {desc => 'Claim (acqcl) ID.  If defined, attach new claim events to this existing claim object', type => 'number'},
+            {desc => 'Claim Type (acqclt) ID.  If defined (and no claim is defined), create a new claim with this type', type => 'number'},
+            {desc => "Note for the claim event", type => "string"},
+            {   desc => q/
+                
+                    Optional: Claim Policy Actions.  If not present, claim events 
+                    for all eligible claim policy actions will be created.  This is
+                    an array of acqclpa ID's.
+                /, 
+                type => 'array'
+            },
+            {   desc => q/
+                    Optional: Claim Event Types.  If present, we bypass any policy configuration
+                    and use the specified event types.  This is useful for manual claiming against
+                    items that have no claim policy.
+                /,
+                type => 'array'
+            }
+        ],
+        return => {
+            desc => "The claim voucher events on success, Event on error",
+            type => "object", class => "acrlid"
+        }
+    }
+);
+
+sub claim_item {
+    my $self = shift;
+    my $conn = shift;
+    my $auth = shift;
+    my $object_id = shift;
+    my $claim_id = shift;
+    my $claim_type_id = shift;
+    my $note = shift;
+    my $policy_actions = shift;
+
+    # if this claim occurs outside of a policy, allow the caller to specificy the event type
+    my $claim_event_types = shift; 
+
+    my $e = new_editor(xact => 1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $evt;
+    my $claim;
+    my $claim_type;
+    my $claim_events = {
+        events => [],
+        trigger_stuff => []
+    };
+
+    my $lid_flesh = {
+        "flesh" => 2,
+        "flesh_fields" => {
+            "acqlid" => ["lineitem"], "jub" => ["purchase_order"],
+        }
+    };
+
+    if($claim_id) {
+        $claim = $e->retrieve_acq_claim($claim_id) or return $e->die_event;
+    } elsif($claim_type_id) {
+        $claim_type = $e->retrieve_acq_claim_type($claim_type_id) or return $e->die_event;
+    } else {
+        $e->rollback;
+        return OpenILS::Event->new('BAD_PARAMS');
+    }
+
+
+    my $lids;
+    if($self->api_name =~ /claim.lineitem_detail/) {
+
+        $lids = $e->search_acq_lineitem_detail([
+            {"id" => $object_id, "cancel_reason" => undef},
+            $lid_flesh
+        ]) or return $e->die_event;
+
+    } elsif($self->api_name =~ /claim.lineitem/) {
+        $lids = $e->search_acq_lineitem_detail([
+            {"lineitem" => $object_id, "cancel_reason" => undef},
+            $lid_flesh
+        ]) or return $e->die_event;
+    }
+
+    foreach my $lid (@$lids) {
+        return $evt if
+            $evt = claim_lineitem_detail(
+                $e, $lid, $claim, $claim_type, $policy_actions,
+                $note, $claim_events, $claim_event_types
+            );
+    }
+
+    $e->commit;
+
+    # create related A/T events
+    $U->create_events_for_hook('claim_event.created', $_->[0], $_->[1]) for @{$claim_events->{trigger_stuff}};
+
+    # do voucher rendering and return result
+    $conn->respond($U->fire_object_event(
+        undef, "format.acqcle.html", $_->[0], $_->[1], "print-on-demand"
+    )) foreach @{$claim_events->{trigger_stuff}};
+    return undef;
+}
+
+sub claim_lineitem_detail {
+    my($e, $lid, $claim, $claim_type, $policy_actions, $note, $claim_events, $claim_event_types) = @_;
+
+    # Create the claim object
+    unless($claim) {
+        $claim = Fieldmapper::acq::claim->new;
+        $claim->lineitem_detail($lid->id);
+        $claim->type($claim_type->id);
+        $e->create_acq_claim($claim) or return $e->die_event;
+    }
+
+    unless($claim_event_types) {
+        # user did not specify explicit event types
+
+        unless($policy_actions) {
+            # user did not specifcy policy actions.  find all eligible.
+
+            my $list = $e->json_query({
+                select => {acrlid => ['claim_policy_action']},
+                from => 'acrlid',
+                where => {lineitem_detail => $lid->id}
+            });
+    
+            $policy_actions = [map { $_->{claim_policy_action} } @$list];
+        }
+
+        # from the set of policy_action's, locate the related event types
+        # IOW, the policy action's action
+        $claim_event_types = [];
+        for my $act_id (@$policy_actions) {
+            my $action = $e->retrieve_acq_claim_policy_action($act_id) or return $e->die_event;
+            push(@$claim_event_types, $action->action);
+        }
+    }
+
+    # for each eligible (or chosen) policy actions, create a claim_event
+    for my $event_type (@$claim_event_types) {
+        my $event = Fieldmapper::acq::claim_event->new;
+        $event->claim($claim->id);
+        $event->type($event_type);
+        $event->creator($e->requestor->id);
+        $event->note($note);
+        $e->create_acq_claim_event($event) or return $e->die_event;
+        push(@{$claim_events->{events}}, $event);
+        push(@{$claim_events->{trigger_stuff}}, [$event, $lid->lineitem->purchase_order->ordering_agency]);
+    }
+
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+    method => "get_claim_voucher_by_lid",
+    api_name => "open-ils.acq.claim.voucher.by_lineitem_detail",
+    stream => 1,
+    signature => {
+        desc => q/Retrieve existing claim vouchers by lineitem detail ID/,
+        params => [
+            {desc => "Authentication token", type => "string"},
+            {desc => "Lineitem detail ID", type => "number"}
+        ],
+        return => {
+            desc => "Claim ready data", type => "object", class => "atev"
+        }
+    }
+);
+
+sub get_claim_voucher_by_lid {
+    my ($self, $conn, $auth, $lid_id) = @_;
+
+    my $e = new_editor("authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $lid = $e->retrieve_acq_lineitem_detail([
+        $lid_id, {
+            "flesh" => 2,
+            "flesh_fields" => {
+                "acqlid" => ["lineitem"], "jub" => ["purchase_order"]
+            }
+        }
+    ]);
+
+    return $e->die_event unless $e->allowed(
+        "VIEW_PURCHASE_ORDER", $lid->lineitem->purchase_order->ordering_agency
+    );
+
+    my $id_list = $e->json_query({
+        "select" => {"atev" => ["id"]},
+        "from" => {
+            "atev" => {
+                "atevdef" => {"field" => "id", "fkey" => "event_def"},
+                "acqcle" => {
+                    "field" => "id", "fkey" => "target",
+                    "join" => {
+                        "acqcl" => {
+                            "field" => "id", "fkey" => "claim",
+                            "join" => {
+                                "acqlid" => {
+                                    "fkey" => "lineitem_detail",
+                                    "field" => "id"
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+        },
+        "where" => {
+            "-and" => {
+                "+atevdef" => {"hook" => "format.acqcle.html"},
+                "+acqlid" => {"id" => $lid_id}
+            }
+        }
+    }) or return $e->die_event;
+
+    if ($id_list && @$id_list) {
+        foreach (@$id_list) {
+            $conn->respond(
+                $e->retrieve_action_trigger_event([
+                    $_->{"id"}, {
+                        "flesh" => 1,
+                        "flesh_fields" => {"atev" => ["template_output"]}
+                    }
+                ])
+            );
+        }
+    }
+
+    $e->disconnect;
+    undef;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
new file mode 100644
index 0000000000..3fc0883f3c
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI.pm
@@ -0,0 +1,828 @@
+package OpenILS::Application::Acq::EDI;
+use base qw/OpenILS::Application/;
+
+use strict; use warnings;
+
+use IO::Scalar;
+
+use OpenSRF::AppSession;
+use OpenSRF::EX qw/:try/;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenSRF::Utils::JSON;
+
+use OpenILS::Application::Acq::Lineitem;
+use OpenILS::Utils::RemoteAccount;
+use OpenILS::Utils::CStoreEditor q/new_editor/;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Application::Acq::EDI::Translator;
+
+use Business::EDI;
+
+use Data::Dumper;
+our $verbose = 0;
+
+sub new {
+    my($class, %args) = @_;
+    my $self = bless(\%args, $class);
+    # $self->{args} = {};
+    return $self;
+}
+
+# our $reasons = {};   # cache for acq.cancel_reason rows ?
+
+our $translator;
+
+sub translator {
+    return $translator ||= OpenILS::Application::Acq::EDI::Translator->new(@_);
+}
+
+my %map = (
+    host     => 'remote_host',
+    username => 'remote_user',
+    password => 'remote_password',
+    account  => 'remote_account',
+    # in_dir   => 'remote_path',   # field_map overrides path with in_dir
+    path     => 'remote_path',
+);
+
+
+## Just for debugging stuff:
+sub add_a_msg {
+    my ($self, $conn) = @_;
+    my $e = new_editor(xact=>1);
+    my $incoming = Fieldmapper::acq::edi_message->new;
+    $incoming->edi("This is content");
+    $incoming->account(1);
+    $incoming->remote_file('in/some_file.edi');
+    $e->create_acq_edi_message($incoming);;
+    $e->commit;
+}
+# __PACKAGE__->register_method( method => 'add_a_msg', api_name => 'open-ils.acq.edi.add_a_msg');  # debugging
+
+__PACKAGE__->register_method(
+	method    => 'retrieve',
+	api_name  => 'open-ils.acq.edi.retrieve',
+    authoritative => 1,
+	signature => {
+        desc   => 'Fetch incoming message(s) from EDI accounts.  ' .
+                  'Optional arguments to restrict to one vendor and/or a max number of messages.  ' .
+                  'Note that messages are not parsed or processed here, just fetched and translated.',
+        params => [
+            {desc => 'Authentication token',        type => 'string'},
+            {desc => 'Vendor ID (undef for "all")', type => 'number'},
+            {desc => 'Date Inactive Since',         type => 'string'},
+            {desc => 'Max Messages Retrieved',      type => 'number'}
+        ],
+        return => {
+            desc => 'List of new message IDs (empty if none)',
+            type => 'array'
+        }
+    }
+);
+
+sub retrieve_core {
+    my ($self, $set, $max, $e, $test) = @_;    # $e is a working editor
+
+    $e   ||= new_editor();
+    $set ||= __PACKAGE__->retrieve_vendors($e);
+
+    my @return = ();
+    my $vcount = 0;
+    foreach my $account (@$set) {
+        my $count = 0;
+        my $server;
+        $logger->info("EDI check for vendor " . ++$vcount . " of " . scalar(@$set) . ": " . $account->host);
+        unless ($server = __PACKAGE__->remote_account($account)) {   # assignment, not comparison
+            $logger->err(sprintf "Failed remote account mapping for %s (%s)", $account->host, $account->id);
+            next;
+        };
+#       my $rf_starter = './';  # default to current dir
+        if ($account->in_dir) { 
+            if ($account->in_dir =~ /\*+.*\//) {
+                $logger->err("EDI in_dir has a slash after an asterisk in value: '" . $account->in_dir . "'.  Skipping account with indeterminate target dir!");
+                next;
+            }
+#           $rf_starter = $account->in_dir;
+#           $rf_starter =~ s/((\/)?[^\/]*)\*+[^\/]*$//;  # kill up to the first (possible) slash before the asterisk: keep the preceeding static dir
+#           $rf_starter .= '/' if $rf_starter or $2;   # recap the dir, or replace leading "/" if there was one (but don't add if empty)
+        }
+        my @files    = ($server->ls({remote_file => ($account->in_dir || './')}));
+        my @ok_files = grep {$_ !~ /\/\.?\.$/ and $_ ne '0'} @files;
+        $logger->info(sprintf "%s of %s files at %s/%s", scalar(@ok_files), scalar(@files), $account->host, $account->in_dir);   
+        # $server->remote_path(undef);
+        foreach my $remote_file (@ok_files) {
+            # my $remote_file = $rf_starter . $_;
+            my $description = sprintf "%s/%s", $account->host, $remote_file;
+            
+            # deduplicate vs. acct/filenames already in DB
+            my $hits = $e->search_acq_edi_message([
+                {
+                    account     => $account->id,
+                    remote_file => $remote_file,
+                    status      => {'in' => [qw/ processed /]},     # if it never got processed, go ahead and get the new one (try again)
+                    # create_time => 'NOW() - 60 DAYS',     # if we wanted to allow filenames to be reused after a certain time
+                    # ideally we would also use the date from FTP, but that info isn't available via RemoteAccount
+                }
+                # { flesh => 1, flesh_fields => {...}, }
+            ]);
+            if (scalar(@$hits)) {
+                $logger->debug("EDI: $remote_file already retrieved.  Skipping");
+                warn "EDI: $remote_file already retrieved.  Skipping";
+                next;
+            }
+
+            ++$count;
+            $max and $count > $max and last;
+            $logger->info(sprintf "%s of %s targets: %s", $count, scalar(@ok_files), $description);
+            print sprintf "%s of %s targets: %s\n", $count, scalar(@ok_files), $description;
+            if ($test) {
+                push @return, "test_$count";
+                next;
+            }
+            my $content;
+            my $io = IO::Scalar->new(\$content);
+            unless ( $server->get({remote_file => $remote_file, local_file => $io}) ) {
+                $logger->error("(S)FTP get($description) failed");
+                next;
+            }
+            my $incoming = __PACKAGE__->process_retrieval($content, $remote_file, $server, $account->id, $e);
+#           $server->delete(remote_file => $_);   # delete remote copies of saved message
+            push @return, $incoming->id;
+        }
+    }
+    return \@return;
+}
+
+# my $in = OpenILS::Application::Acq::EDI->process_retrieval($file_content, $remote_filename, $server, $account_id, $editor);
+
+sub process_retrieval {
+    my $incoming = Fieldmapper::acq::edi_message->new;
+    my ($class, $content, $remote, $server, $account_or_id, $e) = @_;
+    $content or return;
+    $e ||= new_editor;
+
+    my $account = __PACKAGE__->record_activity( $account_or_id, $e );
+
+    my $z;  # must predeclare
+    $z = ( $content =~ s/('UNH\+\d+\+ORDRSP:)0(:96A:UN')/$1D$2/g )
+        and $logger->warn("Patching bogus spec reference ORDRSP:0:96A:UN => ORDRSP:D:96A:UN ($z times)");  # Hack/fix some faulty "0" in (B&T) data
+
+    $incoming->remote_file($remote);
+    $incoming->account($account->id);
+    $incoming->edi($content);
+    $incoming->message_type(($content =~ /'UNH\+\d+\+(\S{6}):/) ? $1 : 'ORDRSP');   # cheap sniffing, ORDRSP fallback
+    __PACKAGE__->attempt_translation($incoming);
+    $e->xact_begin;
+    $e->create_acq_edi_message($incoming);
+    $e->xact_commit;
+    # refresh: send process_jedi the updated row
+    $e->xact_begin;
+    my $outgoing = $e->retrieve_acq_edi_message($incoming->id);  # refresh again!
+    $e->xact_rollback;
+    my $res = __PACKAGE__->process_jedi($outgoing, $server, $account, $e);
+    $e->xact_begin;
+    $outgoing = $e->retrieve_acq_edi_message($incoming->id);  # refresh again!
+    $e->xact_rollback;
+    $outgoing->status($res ? 'processed' : 'proc_error');
+    if ($res) {
+        $e->xact_begin;
+        $e->update_acq_edi_message($outgoing);
+        $e->xact_commit;
+    }
+    return $outgoing;
+}
+
+# ->send_core
+# $account     is a Fieldmapper object for acq.edi_account row
+# $messageset  is an arrayref with acq.edi_message.id values
+# $e           is optional editor object
+sub send_core {
+    my ($class, $account, $message_ids, $e) = @_;    # $e is a working editor
+
+    ($account and scalar @$message_ids) or return;
+    $e ||= new_editor();
+
+    $e->xact_begin;
+    my @messageset = map {$e->retrieve_acq_edi_message($_)} @$message_ids;
+    $e->xact_rollback;
+    my $m_count = scalar(@messageset);
+    (scalar(@$message_ids) == $m_count) or
+        $logger->warn(scalar(@$message_ids) - $m_count . " bad IDs passed to send_core (ignored)");
+
+    my $log_str = sprintf "EDI send to edi_account %s (%s)", $account->id, $account->host;
+    $logger->info("$log_str: $m_count message(s)");
+    $m_count or return;
+
+    my $server;
+    my $server_error;
+    unless ($server = __PACKAGE__->remote_account($account, 1)) {   # assignment, not comparison
+        $logger->error("Failed remote account connection for $log_str");
+        $server_error = 1;
+    };
+    foreach (@messageset) {
+        $_ or next;     # we already warned about bum ids
+        my ($res, $error);
+        if ($server_error) {
+            $error = "Server error: Failed remote account connection for $log_str"; # already told $logger, this is to update object below
+        } elsif (! $_->edi) {
+            $logger->error("Message (id " . $_->id. ") for $log_str has no EDI content");
+            $error = "EDI empty!";
+        } elsif ($res = $server->put({remote_path => $account->path, content => $_->edi, single_ext => 1})) {
+            #  This is the successful case!
+            $_->remote_file($res);
+            $_->status('complete');
+            $_->process_time('NOW');    # For outbound files, sending is the end of processing on the EG side.
+            $logger->info("Sent message (id " . $_->id. ") via $log_str");
+        } else {
+            $logger->error("(S)FTP put to $log_str FAILED: " . ($server->error || 'UNKOWNN'));
+            $error = "put FAILED: " . ($server->error || 'UNKOWNN');
+        }
+        if ($error) {
+            $_->error($error);
+            $_->error_time('NOW');
+        }
+        $logger->info("Calling update_acq_edi_message");
+        $e->xact_begin;
+        unless ($e->update_acq_edi_message($_)) {
+             $logger->error("EDI send_core update_acq_edi_message failed for message object: " . Dumper($_));
+             OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_              ), '/tmp/update_acq_edi_message.FAIL');
+             OpenILS::Application::Acq::EDI::Translator->debug_file(Dumper($_->to_bare_hash), '/tmp/update_acq_edi_message.FAIL.to_bare_hash');
+        }
+        # There's always an update, even if we failed.
+        $e->xact_commit;
+        __PACKAGE__->record_activity($account, $e);  # There's always an update, even if we failed.
+    }
+    return \@messageset;
+}
+
+#  attempt_translation does not touch the DB, just the object.  
+sub attempt_translation {
+    my ($class, $edi_message, $to_edi) = @_;
+    my $tran  = translator();
+    my $ret   = $to_edi ? $tran->json2edi($edi_message->jedi) : $tran->edi2json($edi_message->edi);
+#   $logger->error("json: " . Dumper($json)); # debugging
+    if (not $ret or (! ref($ret)) or $ret->is_fault) {      # RPC::XML::fault on failure
+        $edi_message->status('trans_error');
+        $edi_message->error_time('NOW');
+        my $pre = "EDI Translator " . ($to_edi ? 'json2edi' : 'edi2json') . " failed";
+        my $message = ref($ret) ? 
+                      ("$pre, Error " . $ret->code . ": " . __PACKAGE__->nice_string($ret->string)) :
+                      ("$pre: "                           . __PACKAGE__->nice_string($ret)        ) ;
+        $edi_message->error($message);
+        $logger->error(  $message);
+        return;
+    }
+    $edi_message->status('translated');
+    $edi_message->translate_time('NOW');
+    if ($to_edi) {
+        $edi_message->edi($ret->value);    # translator returns an object
+    } else {
+        $edi_message->jedi($ret->value);   # translator returns an object
+    }
+    return $edi_message;
+}
+
+sub retrieve_vendors {
+    my ($self, $e, $vendor_id, $last_activity) = @_;    # $e is a working editor
+
+    $e ||= new_editor();
+
+    my $criteria = {'+acqpro' => {active => 't'}};
+    $criteria->{'+acqpro'}->{id} = $vendor_id if $vendor_id;
+    return $e->search_acq_edi_account([
+        $criteria, {
+            'join' => 'acqpro',
+            flesh => 1,
+            flesh_fields => {
+                acqedi => ['provider']
+            }
+        }
+    ]);
+#   {"id":{"!=":null},"+acqpro":{"active":"t"}}, {"join":"acqpro", "flesh_fields":{"acqedi":["provider"]},"flesh":1}
+}
+
+# This is the SRF-exposed call, so it does checkauth
+
+sub retrieve {
+    my ($self, $conn, $auth, $vendor_id, $last_activity, $max) = @_;
+
+    my $e = new_editor(authtoken=>$auth);
+    unless ($e and $e->checkauth()) {
+        $logger->warn("checkauth failed for authtoken '$auth'");
+        return ();
+    }
+    # return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);  # add permission here ?
+
+    my $set = __PACKAGE__->retrieve_vendors($e, $vendor_id, $last_activity) or return $e->die_event;
+    return __PACKAGE__->retrieve_core($e, $set, $max);
+}
+
+
+# field_map takes the hashref of vendor data with fields from acq.edi_account and 
+# maps them to the argument style needed for RemoteAccount.  It also extrapolates
+# data from the remote_host string for type and port, when available.
+
+sub field_map {
+    my $self   = shift;
+    my $vendor = shift or return;
+    my $no_override = @_ ? shift : 0;
+    my %args = ();
+    $verbose and $logger->warn("vendor: " . Dumper($vendor));
+    foreach (keys %map) {
+        $args{$map{$_}} = $vendor->$_ if defined $vendor->$_;
+    }
+    unless ($no_override) {
+        $args{remote_path} = $vendor->in_dir;    # override "path" with "in_dir"
+    }
+    my $host = $args{remote_host} || '';
+    ($host =~ s/^(S?FTP)://i    and $args{type} = uc($1)) or
+    ($host =~ s/^(SSH|SCP)://i  and $args{type} = 'SCP' ) ;
+     $host =~ s/:(\d+)$//       and $args{port} = $1;
+    ($args{remote_host} = $host) =~ s#/+##;
+    $verbose and $logger->warn("field_map: " . Dumper(\%args));
+    return %args;
+}
+
+
+# The point of remote_account is to get the RemoteAccount object with args from the DB
+
+sub remote_account {
+    my ($self, $vendor, $outbound, $e) = @_;
+
+    unless (ref($vendor)) {     # It's not a hashref/object.
+        $vendor or return;      # If in fact it's nothing: abort!
+                                # else it's a vendor_id string, so get the full vendor data
+        $e ||= new_editor();
+        my $set_of_one = $self->retrieve_vendors($e, $vendor) or return;
+        $vendor = shift @$set_of_one;
+    }
+
+    return OpenILS::Utils::RemoteAccount->new(
+        $self->field_map($vendor, $outbound)
+    );
+}
+
+# takes account ID or account Fieldmapper object
+
+sub record_activity {
+    my ($class, $account_or_id, $e) = @_;
+    $account_or_id or return;
+    $e ||= new_editor();
+    my $account = ref($account_or_id) ? $account_or_id : $e->retrieve_acq_edi_account($account_or_id);
+    $logger->info("EDI record_activity calling update_acq_edi_account");
+    $account->last_activity('NOW') or return;
+    $e->xact_begin;
+    $e->update_acq_edi_account($account) or $logger->warn("EDI: in record_activity, update_acq_edi_account FAILED");
+    $e->xact_commit;
+    return $account;
+}
+
+sub nice_string {
+    my $class = shift;
+    my $string = shift or return '';
+    chomp($string);
+    my $head   = @_ ? shift : 100;
+    my $tail   = @_ ? shift :  25;
+    (length($string) < $head + $tail) and return $string;
+    my $h = substr($string,0,$head);
+    my $t = substr($string, -1*$tail);
+    $h =~s/\s*$//o;
+    $t =~s/\s*$//o;
+    return "$h ... $t";
+    # return substr($string,0,$head) . "... " . substr($string, -1*$tail);
+}
+
+sub jedi2perl {
+    my ($class, $jedi) = @_;
+    $jedi or return;
+    my $msg = OpenSRF::Utils::JSON->JSON2perl( $jedi );
+    open (FOO, ">>/tmp/JSON2perl_dump.txt");
+    print FOO Dumper($msg), "\n\n";
+    close FOO;
+    $logger->warn("Dumped JSON2perl to /tmp/JSON2perl_dump.txt");
+    return $msg;
+}
+
+our @datecodes = (35, 359, 17, 191, 69, 76, 75, 79, 85, 74, 84, 223);
+our @noop_6063 = (21);
+
+# ->process_jedi($message, $server, $remote, $e)
+# $message is an edi_message object
+#
+sub process_jedi {
+    my ($class, $message, $server, $remote, $e) = @_;
+    $message or return;
+    $server ||= {};  # context
+    $remote ||= {};  # context
+    $e ||= new_editor;
+    my $jedi;
+    unless (ref($message) and $jedi = $message->jedi) {     # assignment, not comparison
+        $logger->warn("EDI process_jedi missing required argument (edi_message object with jedi)!");
+        return;
+    }
+    my $perl  = __PACKAGE__->jedi2perl($jedi);
+    my $error = '';
+    if (ref($message) and not $perl) {
+        $error = ($message->error || '') . " JSON2perl (jedi2perl) FAILED to convert jedi";
+    }
+    elsif (! $perl->{body}) {
+        $error = "EDI interchange body not found!";
+    } 
+    elsif (! $perl->{body}->[0]) {
+        $error = "EDI interchange body not a populated arrayref!";
+    }
+    if ($error) {
+        $logger->warn($error);
+        $message->error($error);
+        $message->error_time('NOW');
+        $e->xact_begin;
+        $e->update_acq_edi_message($message) or $logger->warn("EDI update_acq_edi_message failed! $!");
+        $e->xact_commit;
+        return;
+    }
+
+# Crazy data structure.  Most of the arrays will be 1 element... we think.
+# JEDI looks like:
+# {'body' => [{'ORDERS' => [['UNH',{'0062' => '4635','S009' => {'0057' => 'EAN008','0051' => 'UN','0052' => 'D','0065' => 'ORDERS', ...
+# 
+# So you might access it like:
+#   $obj->{body}->[0]->{ORDERS}->[0]->[0] eq 'UNH'
+
+    $logger->info("EDI interchange body has " . scalar(@{$perl->{body}}) . " message(s)");
+    my @ok_msg_codes = qw/ORDRSP OSTRPT/;
+    my @messages;
+    my $i = 0;
+    foreach my $part (@{$perl->{body}}) {
+        $i++;
+        unless (ref $part and scalar keys %$part) {
+            $logger->warn("EDI interchange message $i lacks structure.  Skipping it.");
+            next;
+        }
+        foreach my $key (keys %$part) {
+            if (! grep {$_ eq $key} @ok_msg_codes) {     # We only do one type for now.  TODO: other types here
+                $logger->warn("EDI interchange $i contains unhandled '$key' message.  Ignoring it.");
+                next;
+            }
+            my $msg = __PACKAGE__->message_object($part->{$key}) or next;
+            push @messages, $msg;
+
+            my $bgm = $msg->xpath('BGM') or $logger->warn("EDI No BGM segment found?!");
+            my $tag4343 = $msg->xpath('BGM/4343');
+            my $tag1225 = $msg->xpath('BGM/1225');
+            if (ref $tag4343) {
+                $logger->info(sprintf "EDI $key BGM/4343 Response Type: %s - %s", $tag4343->value, $tag4343->label)
+            } else {
+                $logger->warn("EDI $key BGM/4343 Response Type Code unrecognized"); # next; #?
+            }
+            if (ref $tag1225) {
+                $logger->info(sprintf "EDI $key BGM/1225 Message Function: %s - %s", $tag1225->value, $tag1225->label);
+            } else {
+                $logger->warn("EDI $key BGM/1225 Message Function Code unrecognized"); # next; #?
+            }
+
+            # TODO: currency check, just to be paranoid
+            # *should* be unnecessary (vendor should reply in currency we send in ORDERS)
+            # That begs a policy question: how to handle mismatch?  convert (bad accuracy), reject, or ignore?  I say ignore.
+
+            # ALL those codes below are basically some form of (lastest) delivery date/time
+            # see, e.g.: http://www.stylusstudio.com/edifact/D04B/2005.htm
+            # The order is the order of definitiveness (first match wins)
+            # Note: if/when we do serials via EDI, dates (and ranges/periods) will need massive special handling
+            my @dates;
+            my $ddate;
+
+            foreach my $date ($msg->xpath('delivery_schedule')) {
+                my $val_2005 = $date->xpath_value('DTM/2005') or next;
+                (grep {$val_2005 eq $_} @datecodes) or next; # no match means some other kind of date we don't care about
+                push @dates, $date;
+            }
+            if (@dates) {
+                DATECODE: foreach my $dcode (@datecodes) {   # now cycle back through hits in order of dcode definitiveness
+                    foreach my $date (@dates) {
+                        $date->xpath_value('DTM/2005') == $dcode or next;
+                        $ddate = $date->xpath_value('DTM/2380') and last DATECODE;
+                        # TODO: conversion based on format specified in DTM/2379 (best encapsulated in Business::EDI)
+                    }
+                }
+            }
+            foreach my $detail ($msg->part('line_detail')) {
+                my $eg_line = __PACKAGE__->eg_li($detail, $remote, $server->{remote_host}, $e) or next;
+                my $li_date = $detail->xpath_value('DTM/2380') || $ddate;
+                my $price   = $detail->xpath_value('line_price/PRI/5118') || '';
+                $eg_line->expected_recv_time($li_date) if $li_date;
+                $eg_line->estimated_unit_price($price) if $price;
+                if (not $message->purchase_order) {                     # first good lineitem sets the message PO link
+                    $message->purchase_order($eg_line->purchase_order); # EG $message object NOT Business::EDI $msg object
+                    $e->xact_begin;
+                    $e->update_acq_edi_message($message) or $logger->warn("EDI update_acq_edi_message (for PO number) failed! $!");
+                    $e->xact_commit;
+                }
+                # $e->search_acq_edi_account([]);
+                my $touches = 0;
+                my $eg_lids = $e->search_acq_lineitem_detail({lineitem => $eg_line->id}); # should be the same as $eg_line->lineitem_details
+                my $lidcount = scalar(@$eg_lids);
+                $lidcount == $eg_line->item_count or $logger->warn(
+                    sprintf "EDI: LI %s itemcount (%d) mismatch, %d LIDs found", $eg_line->id, $eg_line->item_count, $lidcount
+                );
+                foreach my $qty ($detail->part('all_QTY')) {
+                    my $ubound   = $qty->xpath_value('6060') or next;   # nothing to do if qty is 0
+                    my $val_6063 = $qty->xpath_value('6063');
+                    $ubound > 0 or next; # don't be crazy!
+                    if (! $val_6063) {
+                        $logger->warn("EDI: Response for LI " . $eg_line->id . " specifies quantity $ubound with no 6063 code! Contact vendor to resolve.");
+                        next;
+                    }
+                    
+                    my $eg_reason = $e->retrieve_acq_cancel_reason(1200 + $val_6063);  # DB populated w/ 6063 keys in 1200's
+                    if (! $eg_reason) {
+                        $logger->warn("EDI: Unhandled quantity code '$val_6063' (LI " . $eg_line->id . ") $ubound items unprocessed");
+                        next;
+                    } elsif (grep {$val_6063 == $_} @noop_6063) {      # an FYI like "ordered quantity"
+                        $ubound eq $lidcount
+                            or $logger->warn("EDI: LI " . $eg_line->id . " -- Vendor says we ordered $ubound, but we have $lidcount LIDs!)");
+                        next;
+                    }
+                    # elsif ($val_6063 == 83) { # backorder
+                   #} elsif ($val_6063 == 85) { # cancel
+                   #} elsif ($val_6063 == 12 or $val_6063 == 57 or $val_6063 == 84 or $val_6063 == 118) {
+                            # despatched, in transit, urgent delivery, or quantity manifested
+                   #}
+                    if ($touches >= $lidcount) {
+                        $logger->warn("EDI: LI "  . $eg_line->id . ", We already updated $touches of $lidcount LIDS, " .
+                                      "but message wants QTY $ubound more set to " . $eg_reason->label . ".  Ignoring!");
+                        next;
+                    }
+                    $e->xact_begin;
+                    foreach (1 .. $ubound) {
+                        my $eg_lid = shift @$eg_lids or $logger->warn("EDI: Used up all $lidcount LIDs!  Ignoring extra status " . $eg_reason->label);
+                        $eg_lid or next;
+                        $logger->debug(sprintf "Updating LID %s to %s", $eg_lid->id, $eg_reason->label);
+                        $eg_lid->cancel_reason($eg_reason->id);
+                        $e->update_acq_lineitem_detail($eg_lid);
+                        $touches++;
+                    }
+                    $e->xact_commit;
+                    if ($ubound == $eg_line->item_count) {
+                        $eg_line->cancel_reason($eg_reason->id);    # if ALL the items have the same cancel_reason, the PO gets it too
+                    }
+                }
+                $eg_line->edit_time('NOW'); # TODO: have this field automatically updated via ON UPDATE trigger.  
+                $e->xact_begin;
+                $e->update_acq_lineitem($eg_line) or $logger->warn("EDI: update_acq_lineitem FAILED");
+                $e->xact_commit;
+                # print STDERR "Lineitem update: ", Dumper($eg_line);
+            }
+        }
+    }
+    return \@messages;
+}
+
+# returns message object if processing should continue
+# returns false/undef value if processing should abort
+
+sub message_object {
+    my $class = shift;
+    my $body  = shift or return;
+    my $key   = shift if @_;
+    my $keystring = $key || 'UNSPECIFIED';
+
+    my $msg = Business::EDI::Message->new($body);
+    unless ($msg) {
+        $logger->error("EDI interchange message: $keystring body failed Business::EDI constructor. Skipping it.");
+        return;
+    }
+    $key = $msg->code if ! $key;  # Now we set the key for reference if it wasn't specified
+    my $val_0065 = $msg->xpath_value('UNH/S009/0065') || '';
+    unless ($val_0065 eq $key) {
+        $logger->error("EDI $key UNH/S009/0065 ('$val_0065') conflicts w/ message type $key.  Aborting");
+        return;
+    }
+    my $val_0051 = $msg->xpath_value('UNH/S009/0051') || '';
+    unless ($val_0051 eq 'UN') {
+        $logger->warn("EDI $key UNH/S009/0051 designates '$val_0051', not 'UN' as controlling agency.  Attempting to process anyway");
+    }
+    my $val_0054 = $msg->xpath_value('UNH/S009/0054') || '';
+    if ($val_0054) {
+        $logger->info("EDI $key UNH/S009/0054 uses Spec revision version '$val_0054'");
+        # Possible Spec Version limitation
+        # my $yy = $tag_0054 ? substr($val_0054,0,2) : '';
+        # unless ($yy eq '00' or $yy > 94 ...) {
+        #     $logger->warn("EDI $key UNH/S009/0051 Spec revision version '$val_0054' not supported");
+        # }
+    } else {
+        $logger->warn("EDI $key UNH/S009/0054 does not reference a known Spec revision version");
+    }
+    return $msg;
+}
+
+=head2 ->eg_li($lineitem_object, [$remote, $server_log_string, $editor])
+
+my $line_item = OpenILS::Application::Acq::EDI->eg_li($edi_line, $remote, "test_server_01", $e);
+
+ $remote is a acq.edi_account Fieldmapper object.
+ $server_log_string is an arbitrary string use to identify the remote host in potential log messages.
+
+Updates:
+ acq.lineitem.estimated_unit_price, 
+ acq.lineitem.state (dependent on mapping codes), 
+ acq.lineitem.expected_recv_time, 
+ acq.lineitem.edit_time (consequently)
+
+=cut
+
+sub eg_li {
+    my ($class, $line, $server, $server_log_string, $e) = @_;
+    $line or return;
+    $e ||= new_editor();
+
+    my $id;
+    # my $rff      = $line->part('line_reference/RFF') or $logger->warn("EDI ORDRSP line_detail/RFF missing!");
+    my $val_1153 = $line->xpath_value('line_reference/RFF/1153') || '';
+    my $val_1154 = $line->xpath_value('line_reference/RFF/1154') || '';
+    my $val_1082 = $line->xpath_value('LIN/1082') || '';
+
+    my @po_nums;
+
+    $val_1154 =~ s#^(.*)\/##;   # Many sources send the ID as 'order_ID/LI_ID'
+    $1 and push @po_nums, $1;
+    $val_1082 =~ s#^(.*)\/##;   # Many sources send the ID as 'order_ID/LI_ID'
+    $1 and push @po_nums, $1;
+
+    # TODO: possible check of po_nums
+    # now do a lot of checking
+
+    if ($val_1153 eq 'LI') {
+        $id = $val_1154 or $logger->warn("EDI ORDRSP RFF/1154 reference to LI empty.  Attempting failover to LIN/1082");
+    } else {
+        $logger->warn("EDI ORDRSP RFF/1153 unexpected value ('$val_1153', not 'LI').  Attempting failover to LIN/1082");
+    }
+
+    # FIXME - the line item ID in LIN/1082 ought to match RFF/1154, but
+    # not all materials vendors obey this.  Commenting out check for now
+    # as being too strict.
+    #if ($id and $val_1082 and $val_1082 ne $id) {
+    #    $logger->warn("EDI ORDRSP LIN/1082 Line Item ID mismatch ($id vs. $val_1082): cannot target update");
+    #    return;
+    #}
+
+    $id ||= $val_1082 || '';
+    if ($id eq '') {
+        $logger->warn('Cannot identify line item from EDI message');
+        return;
+    }
+
+    $logger->info("EDI retrieve/update lineitem $id");
+
+    my $li = OpenILS::Application::Acq::Lineitem::retrieve_lineitem_impl($e, $id, {
+        flesh_li_details => 1,
+    }, 1); # Could send more {options}.  The 1 is for no_auth.
+
+    if (! $li or ref($li) ne 'Fieldmapper::acq::lineitem') {
+        $logger->error("EDI failed to retrieve lineitem by id '$id' for server $server_log_string");
+        return;
+    }
+    unless ((! $server) or (! $server->provider)) {     # but here we want $server to be acq.edi_account instead of RemoteAccount
+        if ($server->provider != $li->provider) {
+            # links go both ways: acq.provider.edi_default and acq.edi_account.provider
+            $logger->info("EDI acct provider (" . $server->provider. ") doesn't match lineitem provider("
+                            . $li->provider . ").  Checking acq.provider.edi_default...");
+            my $provider = $e->retrieve_acq_provider($li->provider);
+            if ($provider->edi_default != $server->id) {
+                $logger->error(sprintf "EDI provider/acct %s/%s (%s) is blocked from updating lineitem $id belonging to provider/edi_default %s/%s",
+                                $server->provider, $server->id, $server->label, $li->provider, $provider->edi_default);
+                return;
+            }
+        }
+    }
+    
+    my @lin_1229 = $line->xpath('LIN/1229') or $logger->warn("EDI LIN/1229 Action Code missing!");
+    my $key = $lin_1229[0] or return;
+
+    my $eg_reason = $e->retrieve_acq_cancel_reason(1000 + $key->value);  # DB populated w/ spec keys in 1000's
+    $eg_reason or $logger->warn(sprintf "EDI LIN/1229 Action Code '%s' (%s) not recognized in acq.cancel_reason", $key->value, $key->label);
+    $eg_reason or return;
+
+    $li->cancel_reason($eg_reason->id);
+    unless ($eg_reason->keep_debits) {
+        $logger->warn("EDI LIN/1229 Action Code '%s' (%s) has keep_debits=0", $key->value, $key->label);
+    }
+
+    my @prices = $line->xpath_value("line_price/PRI/5118");
+    $li->estimated_unit_price($prices[0]) if @prices;
+
+    return $li;
+}
+
+# caching not needed for now (edi_fetcher is asynchronous)
+# sub get_reason {
+#     my ($class, $key, $e) = @_;
+#     $reasons->{$key} and return $reasons->{$key};
+#     $e ||= new_editor();
+#     $reasons->{$key} = $e->retrieve_acq_cancel_reason($key);
+#     return $reasons->{$key};
+# }
+
+1;
+
+__END__
+
+Example JSON data.
+
+Note the pseudo-hash 2-element arrays.  
+
+[
+  'SG26',
+  [
+    [
+      'LIN',
+      {
+        '1229' => '5',
+        '1082' => 1,
+        'C212' => {
+          '7140' => '9780446360272',
+          '7143' => 'EN'
+        }
+      }
+    ],
+    [
+      'IMD',
+      {
+        '7081' => 'BST',
+        '7077' => 'F',
+        'C273' => {
+          '7008' => [
+            'NOT APPLIC WEBSTERS NEW WORLD THESA'
+          ]
+        }
+      }
+    ],
+    [
+      'QTY',
+      {
+        'C186' => {
+          '6063' => '21',
+          '6060' => 10
+        }
+      }
+    ],
+    [
+      'QTY',
+      {
+        'C186' => {
+          '6063' => '12',
+          '6060' => 10
+        }
+      }
+    ],
+    [
+      'QTY',
+      {
+        'C186' => {
+          '6063' => '85',
+          '6060' => 0
+        }
+      }
+    ],
+    [
+      'FTX',
+      {
+        '4451' => 'LIN',
+        'C107' => {
+          '4441' => '01',
+          '3055' => '28',
+          '1131' => '8B'
+        }
+      }
+    ],
+    [
+      'SG30',
+      [
+        [
+          'PRI',
+          {
+            'C509' => {
+              '5118' => '4.5',
+              '5387' => 'SRP',
+              '5125' => 'AAB'
+            }
+          }
+        ]
+      ]
+    ],
+    [
+      'SG31',
+      [
+        [
+          'RFF',
+          {
+            'C506' => {
+              '1154' => '8/1',
+              '1153' => 'LI'
+            }
+          }
+        ]
+      ]
+    ]
+  ]
+],
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI/Translator.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI/Translator.pm
new file mode 100644
index 0000000000..160fd01318
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/EDI/Translator.pm
@@ -0,0 +1,82 @@
+package OpenILS::Application::Acq::EDI::Translator;
+
+use warnings;
+use strict;
+
+use RPC::XML::Client;
+use Data::Dumper;
+
+# DEFAULTS
+my $proto = 'http://';
+my $host  = $proto . 'localhost';
+my $path  = '/EDI';
+my $port  = 9191;
+my $verbose = 0;
+
+sub new {
+    my ($class, %args) = @_;
+    my $self = bless(\%args, $class);
+    $self->init;
+    return $self;
+}
+
+sub init {
+    my $self = shift;
+    $self->host_cleanup;
+}
+
+sub host_cleanup {
+    my $self = shift;
+    my $target = $self->{host} || $host;
+    $target =~ /^\S+:\/\// or $target  = ($self->{proto} || $proto) . $target;
+    $target =~ /:\d+$/     or $target .= ':' . ($self->{port} || $port);
+    $target .= ($self->{path} || $path);
+    $self->{verbose} and print "Cleanup: $self->{host} ==> $target\n";
+    $self->{host} = $target;
+    return $target;
+}
+
+sub client {
+    my $self = shift;
+    return $self->{client} ||= RPC::XML::Client->new($self->{host});     # TODO: auth
+}
+
+sub debug_file {
+    my $self = shift;
+    my $text = shift;
+    my $filename = @_ ? shift : ('/tmp/' . __PACKAGE__ . '_unknown.tmp');
+    unless (open (TMP_EDI, ">$filename")) {
+        warn "Cannot write $filename: $!";
+        return;
+    }
+    print TMP_EDI $text, "\n";
+    close TMP_EDI;
+    return 1;
+}
+
+sub json2edi {
+    my $self = shift;
+    my $text = shift;
+    $self->debug_file($text, '/tmp/perl_json2edi.tmp');
+    my $client = $self->client();
+    $self->{verbose} and print "Trying json2edi on host: $self->{host}\n";
+    $client->request->header('Content-Type' => 'text/xml;charset=utf-8');
+    my $resp = $client->send_request('json2edi', $text);
+    $self->{verbose} and print Dumper($resp);
+    return $resp;
+}
+
+sub edi2json {
+    my $self = shift;
+    my $text  = shift;
+    $self->debug_file($text, '/tmp/perl_edi2json.tmp');
+    my $client = $self->client();
+    $self->{verbose} and print "Trying edi2json on host: $self->{host}\n";
+    $client->request->header('Content-Type' => 'text/xml;charset=utf-8');
+    my $resp = $client->send_request('edi2json', $text);
+    $self->{verbose} and print Dumper($resp);
+    return $resp;
+}
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Financials.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Financials.pm
new file mode 100644
index 0000000000..acdcd31cb8
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Financials.pm
@@ -0,0 +1,1356 @@
+package OpenILS::Application::Acq::Financials;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Const qw/:const/;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Event;
+use OpenILS::Application::AppUtils;
+use OpenILS::Application::Acq::Lineitem;
+my $U = 'OpenILS::Application::AppUtils';
+
+# ----------------------------------------------------------------------------
+# Funding Sources
+# ----------------------------------------------------------------------------
+
+__PACKAGE__->register_method(
+	method => 'create_funding_source',
+	api_name	=> 'open-ils.acq.funding_source.create',
+	signature => {
+        desc => 'Creates a new funding_source',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'funding source object to create', type => 'object'}
+        ],
+        return => {desc => 'The ID of the new funding_source'}
+    }
+);
+
+sub create_funding_source {
+    my($self, $conn, $auth, $funding_source) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('ADMIN_FUNDING_SOURCE', $funding_source->owner);
+    $e->create_acq_funding_source($funding_source) or return $e->die_event;
+    $e->commit;
+    return $funding_source->id;
+}
+
+
+__PACKAGE__->register_method(
+	method => 'delete_funding_source',
+	api_name	=> 'open-ils.acq.funding_source.delete',
+	signature => {
+        desc => 'Deletes a funding_source',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'funding source ID', type => 'number'}
+        ],
+        return => {desc => '1 on success, Event on failure'}
+    }
+);
+
+sub delete_funding_source {
+    my($self, $conn, $auth, $funding_source_id) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $funding_source = $e->retrieve_acq_funding_source($funding_source_id) or return $e->die_event;
+    return $e->die_event unless $e->allowed('ADMIN_FUNDING_SOURCE', $funding_source->owner, $funding_source);
+    $e->delete_acq_funding_source($funding_source) or return $e->die_event;
+    $e->commit;
+    return 1;
+}
+
+__PACKAGE__->register_method(
+	method => 'retrieve_funding_source',
+	api_name	=> 'open-ils.acq.funding_source.retrieve',
+    authoritative => 1,
+	signature => {
+        desc => 'Retrieves a new funding_source',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'funding source ID', type => 'number'}
+        ],
+        return => {desc => 'The funding_source object on success, Event on failure'}
+    }
+);
+
+sub retrieve_funding_source {
+    my($self, $conn, $auth, $funding_source_id, $options) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    $options ||= {};
+
+    my $flesh = {flesh => 1, flesh_fields => {acqfs => []}};
+    push(@{$flesh->{flesh_fields}->{acqfs}}, 'credits') if $$options{flesh_credits};
+    push(@{$flesh->{flesh_fields}->{acqfs}}, 'allocations') if $$options{flesh_allocations};
+
+    my $funding_source = $e->retrieve_acq_funding_source([$funding_source_id, $flesh]) or return $e->event;
+
+    return $e->event unless $e->allowed(
+        ['ADMIN_FUNDING_SOURCE','MANAGE_FUNDING_SOURCE', 'VIEW_FUNDING_SOURCE'], 
+        $funding_source->owner, $funding_source); 
+
+    $funding_source->summary(retrieve_funding_source_summary_impl($e, $funding_source))
+        if $$options{flesh_summary};
+    return $funding_source;
+}
+
+__PACKAGE__->register_method(
+	method => 'retrieve_org_funding_sources',
+	api_name	=> 'open-ils.acq.funding_source.org.retrieve',
+    stream => 1,
+	signature => {
+        desc => 'Retrieves all the funding_sources associated with an org unit that the requestor has access to see',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'List of org Unit IDs.  If no IDs are provided, this method returns the 
+                full set of funding sources this user has permission to view', type => 'number'},
+            {desc => q/Limiting permission.  this permission is used find the work-org tree from which  
+                the list of orgs is generated if no org ids are provided.  
+                The default is ADMIN_FUNDING_SOURCE/, type => 'string'},
+        ],
+        return => {desc => 'The funding_source objects on success, empty array otherwise'}
+    }
+);
+
+sub retrieve_org_funding_sources {
+    my($self, $conn, $auth, $org_id_list, $options) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    $options ||= {};
+
+    my $limit_perm = ($$options{limit_perm}) ? $$options{limit_perm} : 'ADMIN_FUNDING_SOURCE';
+    return OpenILS::Event->new('BAD_PARAMS') 
+        unless $limit_perm =~ /(ADMIN|MANAGE|VIEW)_FUNDING_SOURCE/;
+
+    my $org_ids = ($org_id_list and @$org_id_list) ? $org_id_list :
+        $U->user_has_work_perm_at($e, $limit_perm, {descendants =>1});
+
+    return [] unless @$org_ids;
+    my $sources = $e->search_acq_funding_source({owner => $org_ids});
+
+    for my $source (@$sources) {
+        $source->summary(retrieve_funding_source_summary_impl($e, $source))
+            if $$options{flesh_summary};
+        $conn->respond($source);
+    }
+
+    return undef;
+}
+
+sub retrieve_funding_source_summary_impl {
+    my($e, $source) = @_;
+    my $at = $e->search_acq_funding_source_allocation_total({funding_source => $source->id})->[0];
+    my $b = $e->search_acq_funding_source_balance({funding_source => $source->id})->[0];
+    my $ct = $e->search_acq_funding_source_credit_total({funding_source => $source->id})->[0];
+    return {
+        allocation_total => ($at) ? $at->amount : 0,
+        balance => ($b) ? $b->amount : 0,
+        credit_total => ($ct) ? $ct->amount : 0,
+    };
+}
+
+
+__PACKAGE__->register_method(
+	method => 'create_funding_source_credit',
+	api_name	=> 'open-ils.acq.funding_source_credit.create',
+	signature => {
+        desc => 'Create a new funding source credit',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'funding source credit object', type => 'object'}
+        ],
+        return => {desc => 'The ID of the new funding source credit on success, Event on failure'}
+    }
+);
+
+sub create_funding_source_credit {
+    my($self, $conn, $auth, $fs_credit) = @_;
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->event unless $e->checkauth;
+
+    my $fs = $e->retrieve_acq_funding_source($fs_credit->funding_source)
+        or return $e->die_event;
+    return $e->die_event unless $e->allowed(['MANAGE_FUNDING_SOURCE'], $fs->owner, $fs); 
+
+    $e->create_acq_funding_source_credit($fs_credit) or return $e->die_event;
+    $e->commit;
+    return $fs_credit->id;
+}
+
+
+# ---------------------------------------------------------------
+# funds
+# ---------------------------------------------------------------
+
+__PACKAGE__->register_method(
+	method => 'create_fund',
+	api_name	=> 'open-ils.acq.fund.create',
+	signature => {
+        desc => 'Creates a new fund',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'fund object to create', type => 'object'}
+        ],
+        return => {desc => 'The ID of the newly created fund object'}
+    }
+);
+
+sub create_fund {
+    my($self, $conn, $auth, $fund) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('ADMIN_FUND', $fund->org);
+    $e->create_acq_fund($fund) or return $e->die_event;
+    $e->commit;
+    return $fund->id;
+}
+
+
+__PACKAGE__->register_method(
+	method => 'delete_fund',
+	api_name	=> 'open-ils.acq.fund.delete',
+	signature => {
+        desc => 'Deletes a fund',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'fund ID', type => 'number'}
+        ],
+        return => {desc => '1 on success, Event on failure'}
+    }
+);
+
+sub delete_fund {
+    my($self, $conn, $auth, $fund_id) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $fund = $e->retrieve_acq_fund($fund_id) or return $e->die_event;
+    return $e->die_event unless $e->allowed('ADMIN_FUND', $fund->org, $fund);
+    $e->delete_acq_fund($fund) or return $e->die_event;
+    $e->commit;
+    return 1;
+}
+
+__PACKAGE__->register_method(
+	method => 'retrieve_fund',
+	api_name	=> 'open-ils.acq.fund.retrieve',
+    authoritative => 1,
+	signature => {
+        desc => 'Retrieves a new fund',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'fund ID', type => 'number'}
+        ],
+        return => {desc => 'The fund object on success, Event on failure'}
+    }
+);
+
+sub retrieve_fund {
+    my($self, $conn, $auth, $fund_id, $options) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    $options ||= {};
+
+    my $flesh = {flesh => 2, flesh_fields => {acqf => []}};
+    if ($options->{"flesh_tags"}) {
+        push @{$flesh->{"flesh_fields"}->{"acqf"}}, "tags";
+        $flesh->{"flesh_fields"}->{"acqftm"} = ["tag"];
+    }
+    push(@{$flesh->{flesh_fields}->{acqf}}, 'debits') if $$options{flesh_debits};
+    push(@{$flesh->{flesh_fields}->{acqf}}, 'allocations') if $$options{flesh_allocations};
+    push(@{$flesh->{flesh_fields}->{acqfa}}, 'funding_source') if $$options{flesh_allocation_sources};
+
+    my $fund = $e->retrieve_acq_fund([$fund_id, $flesh]) or return $e->event;
+    return $e->event unless $e->allowed(['ADMIN_FUND','MANAGE_FUND', 'VIEW_FUND'], $fund->org, $fund);
+    $fund->summary(retrieve_fund_summary_impl($e, $fund))
+        if $$options{flesh_summary};
+    return $fund;
+}
+
+__PACKAGE__->register_method(
+	method => 'retrieve_org_funds',
+	api_name	=> 'open-ils.acq.fund.org.retrieve',
+    stream => 1,
+	signature => {
+        desc => 'Retrieves all the funds associated with an org unit',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'List of org Unit IDs.  If no IDs are provided, this method returns the 
+                full set of funding sources this user has permission to view', type => 'number'},
+            {desc => q/Options hash.  
+                "limit_perm" -- this permission is used find the work-org tree from which  
+                the list of orgs is generated if no org ids are provided.  The default is ADMIN_FUND.
+                "flesh_summary" -- if true, the summary field on each fund is fleshed
+                The default is ADMIN_FUND/, type => 'string'},
+        ],
+        return => {desc => 'The fund objects on success, Event on failure'}
+    }
+);
+
+__PACKAGE__->register_method(
+	method => 'retrieve_org_funds',
+	api_name	=> 'open-ils.acq.fund.org.years.retrieve');
+
+
+sub retrieve_org_funds {
+    my($self, $conn, $auth, $filter, $options) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    $filter ||= {};
+    $options ||= {};
+
+    my $limit_perm = ($$options{limit_perm}) ? $$options{limit_perm} : 'ADMIN_FUND';
+    return OpenILS::Event->new('BAD_PARAMS') 
+        unless $limit_perm =~ /(ADMIN|MANAGE|VIEW)_FUND/;
+
+    $filter->{org}  = $filter->{org} || 
+        $U->user_has_work_perm_at($e, $limit_perm, {descendants =>1});
+    return undef unless @{$filter->{org}};
+
+    my $query = [
+        $filter,
+        {
+            limit => $$options{limit} || 50,
+            offset => $$options{offset} || 0,
+            order_by => $$options{order_by} || {acqf => 'name'}
+        }
+    ];
+
+    if($self->api_name =~ /years/) {
+        # return the distinct set of fund years covered by the selected funds
+        my $data = $e->json_query({
+            select => {
+                acqf => [{column => 'year', transform => 'distinct'}]
+            }, 
+            from => 'acqf', 
+            where => $filter}
+        );
+
+        return [map { $_->{year} } @$data];
+    }
+
+    my $funds = $e->search_acq_fund($query);
+
+    for my $fund (@$funds) {
+        $fund->summary(retrieve_fund_summary_impl($e, $fund))
+            if $$options{flesh_summary};
+        $conn->respond($fund);
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method(
+	method => 'retrieve_fund_summary',
+	api_name	=> 'open-ils.acq.fund.summary.retrieve',
+    authoritative => 1,
+	signature => {
+        desc => 'Returns a summary of credits/debits/encumbrances for a fund',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'fund id', type => 'number' }
+        ],
+        return => {desc => 'A hash of summary information, Event on failure'}
+    }
+);
+
+sub retrieve_fund_summary {
+    my($self, $conn, $auth, $fund_id) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    my $fund = $e->retrieve_acq_fund($fund_id) or return $e->event;
+    return $e->event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
+    return retrieve_fund_summary_impl($e, $fund);
+}
+
+
+sub retrieve_fund_summary_impl {
+    my($e, $fund) = @_;
+
+    my $at = $e->search_acq_fund_allocation_total({fund => $fund->id})->[0];
+    my $dt = $e->search_acq_fund_debit_total({fund => $fund->id})->[0];
+    my $et = $e->search_acq_fund_encumbrance_total({fund => $fund->id})->[0];
+    my $st = $e->search_acq_fund_spent_total({fund => $fund->id})->[0];
+    my $cb = $e->search_acq_fund_combined_balance({fund => $fund->id})->[0];
+    my $sb = $e->search_acq_fund_spent_balance({fund => $fund->id})->[0];
+
+    return {
+        allocation_total => ($at) ? $at->amount : 0,
+        debit_total => ($dt) ? $dt->amount : 0,
+        encumbrance_total => ($et) ? $et->amount : 0,
+        spent_total => ($st) ? $st->amount : 0,
+        combined_balance => ($cb) ? $cb->amount : 0,
+        spent_balance => ($sb) ? $sb->amount : 0,
+    };
+}
+
+__PACKAGE__->register_method(
+	method => 'transfer_money_between_funds',
+	api_name	=> 'open-ils.acq.funds.transfer_money',
+	signature => {
+        desc => 'Method for transfering money between funds',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Originating fund ID', type => 'number'},
+            {desc => 'Amount of money to transfer away from the originating fund, in the same currency as said fund', type => 'number'},
+            {desc => 'Destination fund ID', type => 'number'},
+            {desc => 'Amount of money to transfer to the destination fund, in the same currency as said fund.  If null, uses the same amount specified with the Originating Fund, and attempts a currency conversion if appropriate.', type => 'number'},
+            {desc => 'Transfer Note', type => 'string'}
+        ],
+        return => {desc => '1 on success, Event on failure'}
+    }
+);
+
+sub transfer_money_between_funds {
+    my($self, $conn, $auth, $ofund_id, $ofund_amount, $dfund_id, $dfund_amount, $note) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $ofund = $e->retrieve_acq_fund($ofund_id) or return $e->event;
+    return $e->die_event unless $e->allowed(['ADMIN_FUND','MANAGE_FUND'], $ofund->org, $ofund);
+    my $dfund = $e->retrieve_acq_fund($dfund_id) or return $e->event;
+    return $e->die_event unless $e->allowed(['ADMIN_FUND','MANAGE_FUND'], $dfund->org, $dfund);
+
+    if (!defined $dfund_amount) {
+        my $ratio = 1;
+        if ($ofund->currency_type ne $dfund->currency_type) {
+            my $exchange_rate = $e->json_query({
+                "select"=>{"acqexr"=>["ratio"]}, 
+                "from"=>"acqexr", 
+                "where"=>{
+                    "from_currency"=>$ofund->currency_type,
+                    "to_currency"=>$dfund->currency_type
+                }
+            });
+            if (scalar(@$exchange_rate)<1) {
+                $logger->error('Unable to find exchange rate for ' . $ofund->currency_type . ' to ' . $dfund->currency_type);
+                return $e->die_event;
+            }
+            $ratio = @{$exchange_rate}[0]->{ratio};
+        }
+        $dfund_amount = $ofund_amount * $ratio;
+    } else {
+        return $e->die_event unless $e->allowed("ACQ_XFER_MANUAL_DFUND_AMOUNT");
+    }
+
+    $e->json_query({
+        from => [
+            'acq.transfer_fund',
+            $ofund_id, $ofund_amount, $dfund_id, $dfund_amount, $e->requestor->id, $note
+        ]
+    });
+
+    $e->commit;
+
+    return 1;
+}
+
+
+
+# ---------------------------------------------------------------
+# fund Allocations
+# ---------------------------------------------------------------
+
+__PACKAGE__->register_method(
+	method => 'create_fund_alloc',
+	api_name	=> 'open-ils.acq.fund_allocation.create',
+	signature => {
+        desc => 'Creates a new fund_allocation',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'fund allocation object to create', type => 'object'}
+        ],
+        return => {desc => 'The ID of the new fund_allocation'}
+    }
+);
+
+sub create_fund_alloc {
+    my($self, $conn, $auth, $fund_alloc) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+
+    # this action is equivalent to both debiting a funding source and crediting a fund
+
+    my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source)
+        or return $e->die_event;
+    return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner);
+
+    my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event;
+    return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
+
+    $fund_alloc->allocator($e->requestor->id);
+    $e->create_acq_fund_allocation($fund_alloc) or return $e->die_event;
+    $e->commit;
+    return $fund_alloc->id;
+}
+
+
+__PACKAGE__->register_method(
+	method => 'delete_fund_alloc',
+	api_name	=> 'open-ils.acq.fund_allocation.delete',
+	signature => {
+        desc => 'Deletes a fund_allocation',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'fund Alocation ID', type => 'number'}
+        ],
+        return => {desc => '1 on success, Event on failure'}
+    }
+);
+
+sub delete_fund_alloc {
+    my($self, $conn, $auth, $fund_alloc_id) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $fund_alloc = $e->retrieve_acq_fund_allocation($fund_alloc_id) or return $e->die_event;
+
+    my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source)
+        or return $e->die_event;
+    return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner, $source);
+
+    my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event;
+    return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
+
+    $e->delete_acq_fund_allocation($fund_alloc) or return $e->die_event;
+    $e->commit;
+    return 1;
+}
+
+__PACKAGE__->register_method(
+	method => 'retrieve_fund_alloc',
+	api_name	=> 'open-ils.acq.fund_allocation.retrieve',
+    authoritative => 1,
+	signature => {
+        desc => 'Retrieves a new fund_allocation',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'fund Allocation ID', type => 'number'}
+        ],
+        return => {desc => 'The fund allocation object on success, Event on failure'}
+    }
+);
+
+sub retrieve_fund_alloc {
+    my($self, $conn, $auth, $fund_alloc_id) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    my $fund_alloc = $e->retrieve_acq_fund_allocation($fund_alloc_id) or return $e->event;
+
+    my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source)
+        or return $e->die_event;
+    return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner, $source);
+
+    my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event;
+    return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
+
+    return $fund_alloc;
+}
+
+
+__PACKAGE__->register_method(
+	method => 'retrieve_funding_source_allocations',
+	api_name	=> 'open-ils.acq.funding_source.allocations.retrieve',
+    authoritative => 1,
+	signature => {
+        desc => 'Retrieves a new fund_allocation',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'fund Allocation ID', type => 'number'}
+        ],
+        return => {desc => 'The fund allocation object on success, Event on failure'}
+    }
+);
+
+sub retrieve_funding_source_allocations {
+    my($self, $conn, $auth, $fund_alloc_id) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    my $fund_alloc = $e->retrieve_acq_fund_allocation($fund_alloc_id) or return $e->event;
+
+    my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source)
+        or return $e->die_event;
+    return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner, $source);
+
+    my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event;
+    return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
+
+    return $fund_alloc;
+}
+
+# ----------------------------------------------------------------------------
+# Currency
+# ----------------------------------------------------------------------------
+
+__PACKAGE__->register_method(
+	method => 'retrieve_all_currency_type',
+	api_name	=> 'open-ils.acq.currency_type.all.retrieve',
+    stream => 1,
+	signature => {
+        desc => 'Retrieves all currency_type objects',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+        ],
+        return => {desc => 'List of currency_type objects', type => 'list'}
+    }
+);
+
+sub retrieve_all_currency_type {
+    my($self, $conn, $auth, $fund_alloc_id) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('GENERAL_ACQ');
+    $conn->respond($_) for @{$e->retrieve_all_acq_currency_type()};
+}
+
+__PACKAGE__->register_method(
+	method => 'create_lineitem_assets',
+	api_name	=> 'open-ils.acq.lineitem.assets.create',
+	signature => {
+        desc => q/Creates the bibliographic data, volume, and copies associated with a lineitem./,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'The lineitem id', type => 'number'},
+            {desc => q/Options hash./}
+        ],
+        return => {desc => 'ID of newly created bib record, Event on error'}
+    }
+);
+
+sub create_lineitem_assets {
+    my($self, $conn, $auth, $li_id, $options) = @_;
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+    my ($count, $resp) = create_lineitem_assets_impl($e, $li_id, $options);
+    return $resp if $resp;
+    $e->commit;
+    return $count;
+}
+
+sub create_lineitem_assets_impl {
+    my($e, $li_id, $options) = @_;
+    $options ||= {};
+    my $evt;
+
+    my $li = $e->retrieve_acq_lineitem([
+        $li_id,
+        {   flesh => 1,
+            flesh_fields => {jub => ['purchase_order', 'attributes']}
+        }
+    ]) or return (undef, $e->die_event);
+
+    # -----------------------------------------------------------------
+    # first, create the bib record if necessary
+    # -----------------------------------------------------------------
+    unless($li->eg_bib_id) {
+
+       my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
+            $e, $li->marc); #$rec->bib_source
+
+        if($U->event_code($record)) {
+            $e->rollback;
+            return (undef, $record);
+        }
+
+        $li->editor($e->requestor->id);
+        $li->edit_time('now');
+        $li->eg_bib_id($record->id);
+        $e->update_acq_lineitem($li) or return (undef, $e->die_event);
+    }
+
+    my $li_details = $e->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
+
+    # -----------------------------------------------------------------
+    # for each lineitem_detail, create the volume if necessary, create 
+    # a copy, and link them all together.
+    # -----------------------------------------------------------------
+    my %volcache;
+    for my $li_detail_id (@{$li_details}) {
+
+        my $li_detail = $e->retrieve_acq_lineitem_detail($li_detail_id)
+            or return (undef, $e->die_event);
+
+        # Create the volume object if necessary
+        my $volume = $volcache{$li_detail->cn_label};
+        unless($volume and $volume->owning_lib == $li_detail->owning_lib) {
+            ($volume, $evt) =
+                OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
+                    $e, $li_detail->cn_label, $li->eg_bib_id, $li_detail->owning_lib);
+            return (undef, $evt) if $evt;
+            $volcache{$volume->id} = $volume;
+        }
+
+        my $copy = Fieldmapper::asset::copy->new;
+        $copy->isnew(1);
+        $copy->loan_duration(2);
+        $copy->fine_level(2);
+        $copy->status(OILS_COPY_STATUS_ON_ORDER);
+        $copy->barcode($li_detail->barcode);
+        $copy->location($li_detail->location);
+        $copy->call_number($volume->id);
+        $copy->circ_lib($volume->owning_lib);
+        $copy->circ_modifier($$options{circ_modifier} || 'book');
+
+        $evt = OpenILS::Application::Cat::AssetCommon->create_copy($e, $volume, $copy);
+        return (undef, $evt) if $evt;
+ 
+        $li_detail->eg_copy_id($copy->id);
+        $e->update_acq_lineitem_detail($li_detail) or return (undef, $e->die_event);
+    }
+
+    return (scalar @{$li_details});
+}
+
+
+
+
+sub create_purchase_order_impl {
+    my($e, $p_order) = @_;
+
+    $p_order->creator($e->requestor->id);
+    $p_order->editor($e->requestor->id);
+    $p_order->owner($e->requestor->id);
+    $p_order->edit_time('now');
+
+    return $e->die_event unless 
+        $e->allowed('CREATE_PURCHASE_ORDER', $p_order->ordering_agency);
+
+    my $provider = $e->retrieve_acq_provider($p_order->provider)
+        or return $e->die_event;
+    return $e->die_event unless 
+        $e->allowed('MANAGE_PROVIDER', $provider->owner, $provider);
+
+    $e->create_acq_purchase_order($p_order) or return $e->die_event;
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+	method => 'retrieve_all_user_purchase_order',
+	api_name	=> 'open-ils.acq.purchase_order.user.all.retrieve',
+    stream => 1,
+	signature => {
+        desc => 'Retrieves a purchase order',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'purchase_order to retrieve', type => 'number'},
+            {desc => q/Options hash.  flesh_lineitems: to get the lineitems and lineitem_attrs; 
+                clear_marc: to clear the MARC data from the lineitem (for reduced bandwidth);
+                limit: number of items to return ,defaults to 50;
+                offset: offset in the list of items to return
+                order_by: sort the result, provide one or more colunm names, separated by commas,
+                optionally followed by ASC or DESC as a single string 
+                li_limit : number of lineitems to return if fleshing line items;
+                li_offset : lineitem offset if fleshing line items
+                li_order_by : lineitem sort definition if fleshing line items
+                flesh_lineitem_detail_count : flesh lineitem_detail_count field
+                /,
+                type => 'hash'}
+        ],
+        return => {desc => 'The purchase order, Event on failure'}
+    }
+);
+
+sub retrieve_all_user_purchase_order {
+    my($self, $conn, $auth, $options) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    $options ||= {};
+
+    # grab purchase orders I have 
+    my $perm_orgs = $U->user_has_work_perm_at($e, 'MANAGE_PROVIDER', {descendants =>1});
+	return OpenILS::Event->new('PERM_FAILURE', ilsperm => 'MANAGE_PROVIDER')
+        unless @$perm_orgs;
+    my $provider_ids = $e->search_acq_provider({owner => $perm_orgs}, {idlist=>1});
+    my $po_ids = $e->search_acq_purchase_order({provider => $provider_ids}, {idlist=>1});
+
+    # grab my purchase orders
+    push(@$po_ids, @{$e->search_acq_purchase_order({owner => $e->requestor->id}, {idlist=>1})});
+
+    return undef unless @$po_ids;
+
+    # now get the db to limit/sort for us
+    $po_ids = $e->search_acq_purchase_order(
+        [   {id => $po_ids}, {
+                limit => $$options{limit} || 50,
+                offset => $$options{offset} || 0,
+                order_by => {acqpo => $$options{order_by} || 'create_time'}
+            }
+        ],
+        {idlist => 1}
+    );
+
+    $conn->respond(retrieve_purchase_order_impl($e, $_, $options)) for @$po_ids;
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+	method => 'search_purchase_order',
+	api_name	=> 'open-ils.acq.purchase_order.search',
+    stream => 1,
+	signature => {
+        desc => 'Search for a purchase order',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => q/Search hash.  Search fields include id, provider/, type => 'hash'}
+        ],
+        return => {desc => 'A stream of POs'}
+    }
+);
+
+sub search_purchase_order {
+    my($self, $conn, $auth, $search, $options) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    my $po_ids = $e->search_acq_purchase_order($search, {idlist=>1});
+    for my $po_id (@$po_ids) {
+        $conn->respond($e->retrieve_acq_purchase_order($po_id))
+            unless po_perm_failure($e, $po_id);
+    }
+
+    return undef;
+}
+
+
+
+__PACKAGE__->register_method(
+        method    => 'retrieve_purchase_order',
+        api_name  => 'open-ils.acq.purchase_order.retrieve',
+        stream    => 1,
+        signature => {
+                      desc      => 'Retrieves a purchase order',
+                      params    => [
+                                    {desc => 'Authentication token', type => 'string'},
+                                    {desc => 'purchase_order to retrieve', type => 'number'},
+                                    {desc => q/Options hash.  flesh_lineitems, to get the lineitems and lineitem_attrs;
+                clear_marc, to clear the MARC data from the lineitem (for reduced bandwidth)
+                li_limit : number of lineitems to return if fleshing line items;
+                li_offset : lineitem offset if fleshing line items
+                li_order_by : lineitem sort definition if fleshing line items,
+                flesh_po_items : po_item objects
+                /,
+                                     type => 'hash'}
+                                   ],
+                      return => {desc => 'The purchase order, Event on failure'}
+                     }
+);
+
+sub retrieve_purchase_order {
+    my($self, $conn, $auth, $po_id, $options) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+
+    $po_id = [ $po_id ] unless ref $po_id;
+    for ( @{$po_id} ) {
+        my $rv;
+        if ( po_perm_failure($e, $_) )
+          { $rv = $e->event }
+        else
+          { $rv =  retrieve_purchase_order_impl($e, $_, $options) }
+
+        $conn->respond($rv);
+    }
+
+    return undef;
+}
+
+
+# if the user does not have permission to perform actions on this PO, return the perm failure event
+sub po_perm_failure {
+    my($e, $po_id, $fund_id) = @_;
+    my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->event;
+    return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $po->ordering_agency, $po);
+    return undef;
+}
+
+sub build_price_summary {
+    my ($e, $po_id) = @_;
+
+    # TODO: Add summary value for estimated amount (pre-encumber)
+
+    # fetch the fund debits for this purchase order
+    my $debits = $e->json_query({
+        "select" => {"acqfdeb" => [qw/encumbrance amount/]},
+        "from" => {
+            "acqlid" => {
+                "jub" => {
+                    "fkey" => "lineitem",
+                    "field" => "id",
+                    "join" => {
+                        "acqpo" => {
+                            "fkey" => "purchase_order", "field" => "id"
+                        }
+                    }
+                },
+                "acqfdeb" => {"fkey" => "fund_debit", "field" => "id"}
+            }
+        },
+        "where" => {"+acqpo" => {"id" => $po_id}}
+    });
+
+    # add any debits for non-bib po_items
+    push(@$debits, @{
+        $e->json_query({
+            "select" => {"acqfdeb" => [qw/encumbrance amount/]},
+            "from" => {acqpoi => 'acqfdeb'},
+            "where" => {"+acqpoi" => {"purchase_order" => $po_id}}
+        })
+    });
+
+    my ($enc, $spent) = (0, 0);
+    for my $deb (@$debits) {
+        if($U->is_true($deb->{encumbrance})) {
+            $enc += $deb->{amount};
+        } else {
+            $spent += $deb->{amount};
+        }
+    }
+    ($enc, $spent);
+}
+
+
+sub retrieve_purchase_order_impl {
+    my($e, $po_id, $options) = @_;
+
+    my $flesh = {"flesh" => 1, "flesh_fields" => {"acqpo" => []}};
+
+    $options ||= {};
+    unless ($options->{"no_flesh_cancel_reason"}) {
+        push @{$flesh->{"flesh_fields"}->{"acqpo"}}, "cancel_reason";
+    }
+    if ($options->{"flesh_notes"}) {
+        push @{$flesh->{"flesh_fields"}->{"acqpo"}}, "notes";
+    }
+    if ($options->{"flesh_provider"}) {
+        push @{$flesh->{"flesh_fields"}->{"acqpo"}}, "provider";
+    }
+
+    push (@{$flesh->{flesh_fields}->{acqpo}}, 'po_items') if $options->{flesh_po_items};
+
+    my $args = (@{$flesh->{"flesh_fields"}->{"acqpo"}}) ?
+        [$po_id, $flesh] : $po_id;
+
+    my $po = $e->retrieve_acq_purchase_order($args)
+        or return $e->event;
+
+    if($$options{flesh_lineitems}) {
+
+        my $flesh_fields = { jub => ['attributes'] };
+        $flesh_fields->{jub}->[1] = 'lineitem_details' if $$options{flesh_lineitem_details};
+        $flesh_fields->{acqlid} = ['fund_debit'] if $$options{flesh_fund_debit};
+
+        my $items = $e->search_acq_lineitem([
+            {purchase_order => $po_id},
+            {
+                flesh => 3,
+                flesh_fields => $flesh_fields,
+                limit => $$options{li_limit} || 50,
+                offset => $$options{li_offset} || 0,
+                order_by => {jub => $$options{li_order_by} || 'create_time'}
+            }
+        ]);
+
+        if($$options{clear_marc}) {
+            $_->clear_marc for @$items;
+        }
+
+        $po->lineitems($items);
+        $po->lineitem_count(scalar(@$items));
+
+    } elsif( $$options{flesh_lineitem_ids} ) {
+        $po->lineitems($e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1}));
+
+    } elsif( $$options{flesh_lineitem_count} ) {
+
+        my $items = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist=>1});
+        $po->lineitem_count(scalar(@$items));
+    }
+
+    if($$options{flesh_price_summary}) {
+        my ($enc, $spent) = build_price_summary($e, $po_id);
+        $po->amount_encumbered($enc);
+        $po->amount_spent($spent);
+    }
+
+    return $po;
+}
+
+
+__PACKAGE__->register_method(
+	method => 'format_po',
+	api_name	=> 'open-ils.acq.purchase_order.format'
+);
+
+sub format_po {
+    my($self, $conn, $auth, $po_id, $format) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+
+    my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->event;
+    return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $po->ordering_agency);
+
+    my $hook = "format.po.$format";
+    return $U->fire_object_event(undef, $hook, $po, $po->ordering_agency);
+}
+
+__PACKAGE__->register_method(
+	method => 'format_lineitem',
+	api_name	=> 'open-ils.acq.lineitem.format'
+);
+
+sub format_lineitem {
+    my($self, $conn, $auth, $li_id, $format, $user_data) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+
+    my $li = $e->retrieve_acq_lineitem($li_id) or return $e->event;
+
+    my $context_org;
+    if (defined $li->purchase_order) {
+        my $po = $e->retrieve_acq_purchase_order($li->purchase_order) or return $e->die_event;
+        return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $po->ordering_agency);
+        $context_org = $po->ordering_agency;
+    } else {
+        my $pl = $e->retrieve_acq_picklist($li->picklist) or return $e->die_event;
+        if($e->requestor->id != $pl->owner) {
+            return $e->event unless
+                $e->allowed('VIEW_PICKLIST', $pl->org_unit, $pl);
+        }
+        $context_org = $pl->org_unit;
+    }
+
+    my $hook = "format.acqli.$format";
+    return $U->fire_object_event(undef, $hook, $li, $context_org, 'print-on-demand', $user_data);
+}
+
+__PACKAGE__->register_method (
+    method        => 'po_events',
+    api_name    => 'open-ils.acq.purchase_order.events.owner',
+    stream      => 1,
+    signature => q/
+        Retrieve EDI-related purchase order events (format.po.jedi), by default those which are pending.
+        @param authtoken Login session key
+        @param owner Id or array of id's for the purchase order Owner field.  Filters the events to just those pertaining to PO's meeting this criteria.
+        @param options Object for tweaking the selection criteria and fleshing options.
+    /
+);
+
+__PACKAGE__->register_method (
+    method        => 'po_events',
+    api_name    => 'open-ils.acq.purchase_order.events.ordering_agency',
+    stream      => 1,
+    signature => q/
+        Retrieve EDI-related purchase order events (format.po.jedi), by default those which are pending.
+        @param authtoken Login session key
+        @param owner Id or array of id's for the purchase order Ordering Agency field.  Filters the events to just those pertaining to PO's meeting this criteria.
+        @param options Object for tweaking the selection criteria and fleshing options.
+    /
+);
+
+__PACKAGE__->register_method (
+    method        => 'po_events',
+    api_name    => 'open-ils.acq.purchase_order.events.id',
+    stream      => 1,
+    signature => q/
+        Retrieve EDI-related purchase order events (format.po.jedi), by default those which are pending.
+        @param authtoken Login session key
+        @param owner Id or array of id's for the purchase order Id field.  Filters the events to just those pertaining to PO's meeting this criteria.
+        @param options Object for tweaking the selection criteria and fleshing options.
+    /
+);
+
+sub po_events {
+    my($self, $conn, $auth, $search_value, $options) = @_;
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    (my $search_field = $self->api_name) =~ s/.*\.([_a-z]+)$/$1/;
+    my $obj_type = 'acqpo';
+
+    if ($search_field eq 'ordering_agency') {
+        $search_value = $U->get_org_descendants($search_value);
+    }
+
+    my $query = {
+        "select"=>{"atev"=>["id"]}, 
+        "from"=>"atev", 
+        "where"=>{
+            "target"=>{
+                "in"=>{
+                    "select"=>{$obj_type=>["id"]}, 
+                    "from"=>$obj_type,
+                    "where"=>{$search_field=>$search_value}
+                }
+            }, 
+            "event_def"=>{
+                "in"=>{
+                    "select"=>{atevdef=>["id"]},
+                    "from"=>"atevdef",
+                    "where"=>{
+                        "hook"=>"format.po.jedi"
+                    }
+                }
+            },
+            "state"=>"pending" 
+        },
+        "order_by"=>[{"class"=>"atev", "field"=>"run_time", "direction"=>"desc"}]
+    };
+
+    if ($options && defined $options->{state}) {
+        $query->{'where'}{'state'} = $options->{state}
+    }
+
+    if ($options && defined $options->{start_time}) {
+        $query->{'where'}{'start_time'} = $options->{start_time};
+    }
+
+    if ($options && defined $options->{order_by}) {
+        $query->{'order_by'} = $options->{order_by};
+    }
+    my $po_events = $e->json_query($query);
+
+    my $flesh_fields = { 'atev' => [ 'event_def' ] };
+    my $flesh_depth = 1;
+
+    for my $id (@$po_events) {
+        my $event = $e->retrieve_action_trigger_event([
+            $id->{id},
+            {flesh => $flesh_depth, flesh_fields => $flesh_fields}
+        ]);
+        if (! $event) { next; }
+
+        my $po = retrieve_purchase_order_impl(
+            $e,
+            $event->target(),
+            {flesh_lineitem_count=>1,flesh_price_summary=>1}
+        );
+
+        if ($e->allowed( ['CREATE_PURCHASE_ORDER','VIEW_PURCHASE_ORDER'], $po->ordering_agency() )) {
+            $event->target( $po );
+            $conn->respond($event);
+        }
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method (
+	method		=> 'update_po_events',
+    api_name    => 'open-ils.acq.purchase_order.event.cancel.batch',
+    stream      => 1,
+);
+__PACKAGE__->register_method (
+	method		=> 'update_po_events',
+    api_name    => 'open-ils.acq.purchase_order.event.reset.batch',
+    stream      => 1,
+);
+
+sub update_po_events {
+    my($self, $conn, $auth, $event_ids) = @_;
+    my $e = new_editor(xact => 1, authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $x = 1;
+    for my $id (@$event_ids) {
+
+        # do a little dance to determine what libraries we are ultimately affecting
+        my $event = $e->retrieve_action_trigger_event([
+            $id,
+            {   flesh => 2,
+                flesh_fields => {atev => ['event_def'], atevdef => ['hook']}
+            }
+        ]) or return $e->die_event;
+
+        my $po = retrieve_purchase_order_impl(
+            $e,
+            $event->target(),
+            {}
+        );
+
+        return $e->die_event unless $e->allowed( ['CREATE_PURCHASE_ORDER','VIEW_PURCHASE_ORDER'], $po->ordering_agency() );
+
+        if($self->api_name =~ /cancel/) {
+            $event->state('invalid');
+        } elsif($self->api_name =~ /reset/) {
+            $event->clear_start_time;
+            $event->clear_update_time;
+            $event->state('pending');
+        }
+
+        $e->update_action_trigger_event($event) or return $e->die_event;
+        $conn->respond({maximum => scalar(@$event_ids), progress => $x++});
+    }
+
+    $e->commit;
+    return {complete => 1};
+}
+
+
+__PACKAGE__->register_method (
+	method		=> 'process_fiscal_rollover',
+    api_name    => 'open-ils.acq.fiscal_rollover.combined',
+    stream      => 1,
+	signature => {
+        desc => q/
+            Performs a combined fiscal fund rollover process.
+
+            Creates a new series of funds for the following year, copying the old years 
+            funds that are marked as propagable. They apply to the funds belonging to 
+            either an org unit or to an org unit and all of its dependent org units. 
+            The procedures may be run repeatedly; if any fund has already been propagated, 
+            both the old and the new funds will be left alone.
+
+            Closes out any applicable funds (by org unit or by org unit and dependents) 
+            that are marked as propagable. If such a fund has not already been propagated 
+            to the new year, it will be propagated at closing time.
+
+            If a fund is marked as subject to rollover, any unspent balance in the old year's 
+            fund (including money encumbered but not spent) is transferred to the new year's 
+            fund. Otherwise it is deallocated back to the funding source(s).
+
+            In either case, any encumbrance debits are transferred to the new fund, along 
+            with the corresponding lineitem details. The old year's fund is marked as inactive 
+            so that new debits may not be charged to it.
+        /,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Fund Year to roll over', type => 'integer'},
+            {desc => 'Org unit ID', type => 'integer'},
+            {desc => 'Include Descendant Orgs (boolean)', type => 'integer'},
+        ],
+        return => {desc => 'Returns a stream of all related funds for the next year including fund summary for each'}
+    }
+
+);
+
+__PACKAGE__->register_method (
+	method		=> 'process_fiscal_rollover',
+    api_name    => 'open-ils.acq.fiscal_rollover.combined.dry_run',
+    stream      => 1,
+	signature => {
+        desc => q/
+            @see open-ils.acq.fiscal_rollover.combined
+            This is the dry-run version.  The action is performed,
+            new fund information is returned, then all changes are rolled back.
+        /
+    }
+
+);
+
+__PACKAGE__->register_method (
+	method		=> 'process_fiscal_rollover',
+    api_name    => 'open-ils.acq.fiscal_rollover.propagate',
+    stream      => 1,
+	signature => {
+        desc => q/
+            @see open-ils.acq.fiscal_rollover.combined
+            This version performs fund propagation only.  I.e, creation of
+            the following year's funds.  It does not rollover over balances, encumbrances, 
+            or mark the previous year's funds as complete.
+        /
+    }
+);
+
+__PACKAGE__->register_method (
+	method		=> 'process_fiscal_rollover',
+    api_name    => 'open-ils.acq.fiscal_rollover.propagate.dry_run',
+    stream      => 1,
+	signature => { desc => q/ 
+        @see open-ils.acq.fiscal_rollover.propagate 
+        This is the dry-run version.  The action is performed,
+        new fund information is returned, then all changes are rolled back.
+    / }
+);
+
+
+
+sub process_fiscal_rollover {
+    my( $self, $conn, $auth, $year, $org_id, $descendants, $options ) = @_;
+
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('ADMIN_FUND', $org_id);
+    $options ||= {};
+
+    my $combined = ($self->api_name =~ /combined/); 
+
+    my $org_ids = ($descendants) ? 
+        [   
+            map 
+            { $_->{id} } # fetch my descendants
+            @{$e->json_query({from => ['actor.org_unit_descendants', $org_id]})}
+        ]
+        : [$org_id];
+
+    # Create next year's funds
+    # Note, it's safe to run this more than once.
+    # IOW, it will not create duplicate new funds.
+    $e->json_query({
+        from => [
+            ($descendants) ? 
+                'acq.propagate_funds_by_org_tree' :
+                'acq.propagate_funds_by_org_unit',
+            $year, $e->requestor->id, $org_id
+        ]
+    });
+
+    if($combined) {
+
+        # Roll the uncumbrances over to next year's funds
+        # Mark the funds for $year as inactive
+
+        $e->json_query({
+            from => [
+                ($descendants) ? 
+                    'acq.rollover_funds_by_org_tree' :
+                    'acq.rollover_funds_by_org_unit',
+                $year, $e->requestor->id, $org_id
+            ]
+        });
+    }
+
+    # Fetch all funds for the specified org units for the subsequent year
+    my $fund_ids = $e->search_acq_fund([
+        {
+            year => int($year) + 1, 
+            org => $org_ids,
+            propagate => 't'
+        }, {
+            limit => $$options{limit} || 20,
+            offset => $$options{offset} || 0,
+        }
+        ], 
+        {idlist => 1}
+    );
+
+    foreach (@$fund_ids) {
+        my $fund = $e->retrieve_acq_fund($_) or return $e->die_event;
+        $fund->summary(retrieve_fund_summary_impl($e, $fund));
+
+        my $amount = 0;
+        if($combined and $U->is_true($fund->rollover)) {
+            # see how much money was rolled over
+
+            my $sum = $e->json_query({
+                select => {acqftr => [{column => 'dest_amount', transform => 'sum'}]}, 
+                from => 'acqftr', 
+                where => {dest_fund => $fund->id, note => 'Rollover'}
+            })->[0];
+
+            $amount = $sum->{dest_amount} if $sum;
+        }
+
+        $conn->respond({fund => $fund, rollover_amount => $amount});
+    }
+
+    $self->api_name =~ /dry_run/ and $e->rollback or $e->commit;
+    return undef;
+}
+
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Invoice.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Invoice.pm
new file mode 100644
index 0000000000..305bd077e3
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Invoice.pm
@@ -0,0 +1,568 @@
+package OpenILS::Application::Acq::Invoice;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Application::AppUtils;
+use OpenILS::Event;
+my $U = 'OpenILS::Application::AppUtils';
+
+
+__PACKAGE__->register_method(
+	method => 'build_invoice_api',
+	api_name	=> 'open-ils.acq.invoice.update',
+	signature => {
+        desc => q/Creates, updates, and deletes invoices, and related invoice entries, and invoice items/,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => q/Invoice/, type => 'number'},
+            {desc => q/Entries.  Array of 'acqie' objects/, type => 'array'},
+            {desc => q/Items.  Array of 'acqii' objects/, type => 'array'},
+        ],
+        return => {desc => 'The invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
+    }
+);
+
+sub build_invoice_api {
+    my($self, $conn, $auth, $invoice, $entries, $items) = @_;
+
+    my $e = new_editor(xact => 1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $evt;
+
+    if(ref $invoice) {
+        if($invoice->isnew) {
+            $invoice->receiver($e->requestor->ws_ou) unless $invoice->receiver;
+            $invoice->recv_method('PPR') unless $invoice->recv_method;
+            $invoice->recv_date('now') unless $invoice->recv_date;
+            $e->create_acq_invoice($invoice) or return $e->die_event;
+        } elsif($invoice->isdeleted) {
+            i$e->delete_acq_invoice($invoice) or return $e->die_event;
+        } else {
+            $e->update_acq_invoice($invoice) or return $e->die_event;
+        }
+    } else {
+        # caller only provided the ID
+        $invoice = $e->retrieve_acq_invoice($invoice) or return $e->die_event;
+    }
+
+    return $e->die_event unless $e->allowed('CREATE_INVOICE', $invoice->receiver);
+
+    if($entries) {
+        for my $entry (@$entries) {
+            $entry->invoice($invoice->id);
+
+            if($entry->isnew) {
+
+                $e->create_acq_invoice_entry($entry) or return $e->die_event;
+                return $evt if $evt = update_entry_debits($e, $entry);
+
+            } elsif($entry->isdeleted) {
+
+                return $evt if $evt = rollback_entry_debits($e, $entry); 
+                $e->delete_acq_invoice_entry($entry) or return $e->die_event;
+
+            } elsif($entry->ischanged) {
+
+                my $orig_entry = $e->retrieve_acq_invoice_entry($entry->id) or return $e->die_event;
+
+                if($orig_entry->amount_paid != $entry->amount_paid or 
+                        $entry->phys_item_count != $orig_entry->phys_item_count) {
+
+                    return $evt if $evt = rollback_entry_debits($e, $orig_entry); 
+                    return $evt if $evt = update_entry_debits($e, $entry);
+
+                }
+
+                $e->update_acq_invoice_entry($entry) or return $e->die_event;
+            }
+        }
+    }
+
+    if($items) {
+        for my $item (@$items) {
+            $item->invoice($invoice->id);
+
+            if($item->isnew) {
+
+                $e->create_acq_invoice_item($item) or return $e->die_event;
+
+                # future: cache item types
+                my $item_type = $e->retrieve_acq_invoice_item_type(
+                    $item->inv_item_type) or return $e->die_event;
+
+                # prorated items are handled separately
+                unless($U->is_true($item_type->prorate)) {
+                    my $debit;
+                    if($item->po_item) {
+                        my $po_item = $e->retrieve_acq_po_item($item->po_item) or return $e->die_event;
+                        $debit = $e->retrieve_acq_fund_debit($po_item->fund_debit) or return $e->die_event;
+                    } else {
+                        $debit = Fieldmapper::acq::fund_debit->new;
+                        $debit->isnew(1);
+                    }
+                    $debit->fund($item->fund);
+                    $debit->amount($item->amount_paid);
+                    $debit->origin_amount($item->amount_paid);
+                    $debit->origin_currency_type($e->retrieve_acq_fund($item->fund)->currency_type); # future: cache funds locally
+                    $debit->encumbrance('f');
+                    $debit->debit_type('direct_charge');
+
+                    if($debit->isnew) {
+                        $e->create_acq_fund_debit($debit) or return $e->die_event;
+                    } else {
+                        $e->update_acq_fund_debit($debit) or return $e->die_event;
+                    }
+
+                    $item->fund_debit($debit->id);
+                    $e->update_acq_invoice_item($item) or return $e->die_event;
+                }
+
+            } elsif($item->isdeleted) {
+
+                $e->delete_acq_invoice_item($item) or return $e->die_event;
+
+                if($item->po_item and $e->retrieve_acq_po_item($item->po_item)->fund_debit == $item->fund_debit) {
+                    # the debit is attached to the po_item.  instead of deleting it, roll it back 
+                    # to being an encumbrance.  Note: a prorated invoice_item that points to a po_item 
+                    # could point to a different fund_debit.  We can't go back in time to collect all the
+                    # prorated invoice_items (nor is the caller asking us too), so when that happens, 
+                    # just delete the extraneous debit (in the else block).
+                    my $debit = $e->retrieve_acq_fund_debit($item->fund_debit);
+                    $debit->encumbrance('t');
+                    $e->update_acq_fund_debit($debit) or return $e->die_event;
+                } else {
+                    $e->delete_acq_fund_debit($e->retrieve_acq_fund_debit($item->fund_debit))
+                        or return $e->die_event;
+                }
+
+
+            } elsif($item->ischanged) {
+
+                my $debit = $e->retrieve_acq_fund_debit($item->fund_debit) or return $e->die_event;
+                $debit->amount($item->amount_paid);
+                $debit->fund($item->fund);
+                $e->update_acq_fund_debit($debit) or return $e->die_event;
+                $e->update_acq_invoice_item($item) or return $e->die_event;
+            }
+        }
+    }
+
+    $invoice = fetch_invoice_impl($e, $invoice->id);
+    $e->commit;
+
+    return $invoice;
+}
+
+
+sub rollback_entry_debits {
+    my($e, $entry) = @_;
+    my $debits = find_entry_debits($e, $entry, 'f', entry_amount_per_item($entry));
+    my $lineitem = $e->retrieve_acq_lineitem($entry->lineitem) or return $e->die_event;
+
+    for my $debit (@$debits) {
+        # revert to the original estimated amount re-encumber
+        $debit->encumbrance('t');
+        $debit->amount($lineitem->estimated_unit_price());
+        $e->update_acq_fund_debit($debit) or return $e->die_event;
+        update_copy_cost($e, $debit) or return $e->die_event; # clear the cost
+    }
+
+    return undef;
+}
+
+sub update_entry_debits {
+    my($e, $entry) = @_;
+
+    my $debits = find_entry_debits($e, $entry, 't');
+    return undef unless @$debits;
+
+    if($entry->phys_item_count > @$debits) {
+        $e->rollback;
+        # We can't invoice for more items than we have debits for
+        return OpenILS::Event->new(
+            'ACQ_INVOICE_ENTRY_COUNT_EXCEEDS_DEBITS', 
+            payload => {entry => $entry->id});
+    }
+
+    for my $debit (@$debits) {
+        my $amount = entry_amount_per_item($entry);
+        $debit->amount($amount);
+        $debit->encumbrance('f');
+        $e->update_acq_fund_debit($debit) or return $e->die_event;
+
+        # TODO: this does not reflect ancillary charges, like taxes, etc.
+        # We may need a way to indicate whether the amount attached to an 
+        # invoice_item should be prorated and included in the copy cost.
+        # Note that acq.invoice_item_type.prorate does not necessarily 
+        # mean a charge should be included in the copy price, only that 
+        # it should spread accross funds.
+        update_copy_cost($e, $debit, $amount) or return $e->die_event;
+    }
+
+    return undef;
+}
+
+# update the linked copy to reflect the amount paid for the item
+# returns true on success, false on error
+sub update_copy_cost {
+    my ($e, $debit, $amount) = @_;
+
+    my $lid = $e->search_acq_lineitem_detail([
+        {fund_debit => $debit->id},
+        {flesh => 1, flesh_fields => {acqlid => ['eg_copy_id']}}
+    ])->[0];
+
+    if($lid and my $copy = $lid->eg_copy_id) {
+        defined $amount and $copy->cost($amount) or $copy->clear_cost;
+        $copy->editor($e->requestor->id);
+        $copy->edit_date('now');
+        $e->update_asset_copy($copy) or return 0;
+    }
+
+    return 1;
+}
+
+
+sub entry_amount_per_item {
+    my $entry = shift;
+    return $entry->amount_paid if $U->is_true($entry->billed_per_item);
+    return 0 if $entry->phys_item_count == 0;
+    return $entry->amount_paid / $entry->phys_item_count;
+}
+
+sub easy_money { # TODO XXX replace with something from a library
+    my ($val) = @_;
+
+    my $rounded = int($val * 100) / 100.0;
+    if ($rounded == $val) {
+        return sprintf("%.02f", $val);
+    } else {
+        return sprintf("%g", $val);
+    }
+}
+
+# 0 on failure (caller should call $e->die_event), array on success
+sub amounts_spent_per_fund {
+    my ($e, $inv_id) = @_;
+
+    my $entries = $e->search_acq_invoice_entry({"invoice" => $inv_id}) or
+        return 0;
+
+    my $items = $e->search_acq_invoice_item({"invoice" => $inv_id}) or
+        return 0;
+
+    my %totals_by_fund;
+    foreach my $entry (@$entries) {
+        my $debits = find_entry_debits($e, $entry, "f") or return 0;
+        foreach (@$debits) {
+            $totals_by_fund{$_->fund} ||= 0.0;
+            $totals_by_fund{$_->fund} += $_->amount;
+        }
+    }
+
+    foreach my $item (@$items) {
+        next unless $item->fund and $item->amount_paid;
+        $totals_by_fund{$item->fund} ||= 0.0;
+        $totals_by_fund{$item->fund} += $item->amount_paid;
+    }
+
+    my @totals;
+    foreach my $fund_id (keys %totals_by_fund) {
+        my $fund = $e->retrieve_acq_fund($fund_id) or return 0;
+        push @totals, {
+            "fund" => $fund->to_bare_hash,
+            "total" => easy_money($totals_by_fund{$fund_id})
+        };
+    }
+
+    return \@totals;
+}
+
+# there is no direct link between invoice_entry and fund debits.
+# when we need to retrieve the related debits, we have to do some searching
+sub find_entry_debits {
+    my($e, $entry, $encumbrance, $amount) = @_;
+
+    my $query = {
+        select => {acqfdeb => ['id']},
+        from => {
+            acqfdeb => {
+                acqlid => {
+                    join => {
+                        jub =>  {
+                            join => {
+                                acqie => {
+                                    filter => {id => $entry->id}
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+        },
+        where => {'+acqfdeb' => {encumbrance => $encumbrance}},
+        order_by => {'acqlid' => ['recv_time']}, # un-received items will sort to the end
+        limit => $entry->phys_item_count
+    };
+
+    $query->{where}->{'+acqfdeb'}->{amount} = $amount if $amount;
+
+    my $debits = $e->json_query($query);
+    my $debit_ids = [map { $_->{id} } @$debits];
+    return (@$debit_ids) ? $e->search_acq_fund_debit({id => $debit_ids}) : [];
+}
+
+
+__PACKAGE__->register_method(
+	method => 'build_invoice_api',
+	api_name	=> 'open-ils.acq.invoice.retrieve',
+    authoritative => 1,
+	signature => {
+        desc => q/Creates a new stub invoice/,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => q/Invoice Id/, type => 'number'},
+        ],
+        return => {desc => 'The new invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
+    }
+);
+
+
+sub fetch_invoice_api {
+    my($self, $conn, $auth, $invoice_id, $options) = @_;
+
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+
+    my $invoice = fetch_invoice_impl($e, $invoice_id, $options) or
+        return $e->event;
+    return $e->event unless $e->allowed(['VIEW_INVOICE', 'CREATE_INVOICE'], $invoice->receiver);
+
+    return $invoice;
+}
+
+sub fetch_invoice_impl {
+    my ($e, $invoice_id, $options) = @_;
+
+    $options ||= {};
+
+    my $args = $options->{"no_flesh_misc"} ? $invoice_id : [
+        $invoice_id,
+        {
+            "flesh" => 6,
+            "flesh_fields" => {
+                "acqinv" => ["entries", "items"],
+                "acqii" => ["fund_debit", "purchase_order", "po_item"]
+            }
+        }
+    ];
+
+    return $e->retrieve_acq_invoice($args);
+}
+
+__PACKAGE__->register_method(
+	method => 'prorate_invoice',
+	api_name	=> 'open-ils.acq.invoice.apply_prorate',
+	signature => {
+        desc => q/
+            For all invoice items that have the prorate flag set to true, this will create the necessary 
+            additional invoice_item's to prorate the cost across all affected funds by percent spent for each fund.
+        /,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => q/Invoice Id/, type => 'number'},
+        ],
+        return => {desc => 'The updated invoice w/ entries and items attached', type => 'object', class => 'acqinv'}
+    }
+);
+
+
+sub prorate_invoice {
+    my($self, $conn, $auth, $invoice_id) = @_;
+
+    my $e = new_editor(xact => 1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $invoice = fetch_invoice_impl($e, $invoice_id) or return $e->die_event;
+    return $e->die_event unless $e->allowed('CREATE_INVOICE', $invoice->receiver);
+
+    my @lid_debits;
+    push(@lid_debits, @{find_entry_debits($e, $_, 'f', entry_amount_per_item($_))}) for @{$invoice->entries};
+
+    my $inv_items = $e->search_acq_invoice_item([
+        {"invoice" => $invoice_id, "fund_debit" => {"!=" => undef}},
+        {"flesh" => 1, "flesh_fields" => {"acqii" => ["fund_debit"]}}
+    ]) or return $e->die_event;
+
+    my @item_debits = map { $_->fund_debit } @$inv_items;
+
+    my %fund_totals;
+    my $total_entry_paid = 0;
+    for my $debit (@lid_debits, @item_debits) {
+        $fund_totals{$debit->fund} = 0 unless $fund_totals{$debit->fund};
+        $fund_totals{$debit->fund} += $debit->amount;
+        $total_entry_paid += $debit->amount;
+    }
+
+    $logger->info("invoice: prorating against invoice amount $total_entry_paid");
+
+    for my $item (@{$invoice->items}) {
+
+        next if $item->fund_debit; # item has already been processed
+
+        # future: cache item types locally
+        my $item_type = $e->retrieve_acq_invoice_item_type($item->inv_item_type) or return $e->die_event;
+        next unless $U->is_true($item_type->prorate);
+
+        # Prorate charges across applicable funds
+        my $full_item_paid = $item->amount_paid; # total amount paid for this item before splitting
+        my $full_item_cost = $item->cost_billed; # total amount invoiced for this item before splitting
+        my $first_round = 1;
+        my $largest_debit;
+        my $largest_item;
+        my $total_debited = 0;
+        my $total_costed = 0;
+
+        for my $fund_id (keys %fund_totals) {
+
+            my $spent_for_fund = $fund_totals{$fund_id};
+            next unless $spent_for_fund > 0;
+
+            my $prorated_amount = ($spent_for_fund / $total_entry_paid) * $full_item_paid;
+            my $prorated_cost = ($spent_for_fund / $total_entry_paid) * $full_item_cost;
+            $logger->info("invoice: attaching prorated amount $prorated_amount to fund $fund_id for invoice $invoice_id");
+
+            my $debit;
+            if($first_round and $item->po_item) {
+                # if this item is the result of a PO item, repurpose the original debit
+                # for the first chunk of the prorated amount
+                $debit = $e->retrieve_acq_fund_debit($item->po_item->fund_debit);
+            } else {
+                $debit = Fieldmapper::acq::fund_debit->new;
+                $debit->isnew(1);
+            }
+
+            $debit->fund($fund_id);
+            $debit->amount($prorated_amount);
+            $debit->origin_amount($prorated_amount);
+            $debit->origin_currency_type($e->retrieve_acq_fund($fund_id)->currency_type); # future: cache funds locally
+            $debit->encumbrance('f');
+            $debit->debit_type('prorated_charge');
+
+            if($debit->isnew) {
+                $e->create_acq_fund_debit($debit) or return $e->die_event;
+            } else {
+                $e->update_acq_fund_debit($debit) or return $e->die_event;
+            }
+
+            $total_debited += $prorated_amount;
+            $total_costed += $prorated_cost;
+            $largest_debit = $debit if !$largest_debit or $prorated_amount > $largest_debit->amount;
+
+            if($first_round) {
+
+                # re-purpose the original invoice_item for the first prorated amount
+                $item->fund($fund_id);
+                $item->fund_debit($debit->id);
+                $item->amount_paid($prorated_amount);
+                $item->cost_billed($prorated_cost);
+                $e->update_acq_invoice_item($item) or return $e->die_event;
+                $largest_item = $item if !$largest_item or $prorated_amount > $largest_item->amount_paid;
+
+            } else {
+
+                # for subsequent prorated amounts, create a new invoice_item
+                my $new_item = $item->clone;
+                $new_item->clear_id;
+                $new_item->fund($fund_id);
+                $new_item->fund_debit($debit->id);
+                $new_item->amount_paid($prorated_amount);
+                $new_item->cost_billed($prorated_cost);
+                $e->create_acq_invoice_item($new_item) or return $e->die_event;
+                $largest_item = $new_item if !$largest_item or $prorated_amount > $largest_item->amount_paid;
+            }
+
+            $first_round = 0;
+        }
+
+        # make sure the percentages didn't leave a small sliver of money over/under-debited
+        # if so, tweak the largest debit to smooth out the difference
+        if($total_debited != $full_item_paid or $total_costed != $full_item_cost) {
+            
+            my $paid_diff = $full_item_paid - $total_debited;
+            my $cost_diff = $full_item_cost - $total_debited;
+            $logger->info("invoice: repairing prorate descrepency of paid:$paid_diff and cost:$cost_diff");
+            my $new_paid = $largest_item->amount_paid + $paid_diff;
+            my $new_cost = $largest_item->cost_billed + $cost_diff;
+
+            $largest_debit = $e->retrieve_acq_fund_debit($largest_debit->id); # get latest copy
+            $largest_debit->amount($new_paid);
+            $e->update_acq_fund_debit($largest_debit) or return $e->die_event;
+
+            $largest_item = $e->retrieve_acq_invoice_item($largest_item->id); # get latest copy
+            $largest_item->amount_paid($new_paid);
+            $largest_item->cost_billed($new_cost);
+
+            $e->update_acq_invoice_item($largest_item) or return $e->die_event;
+        }
+    }
+
+    $invoice = fetch_invoice_impl($e, $invoice_id);
+    $e->commit;
+
+    return $invoice;
+}
+
+
+__PACKAGE__->register_method(
+    method      => "print_html_invoice",
+    api_name    => "open-ils.acq.invoice.print.html",
+    stream      => 1,
+    signature   => {
+        desc    => "Retrieve printable HTML vouchers for each given invoice",
+        params => [
+            {desc => "Authentication token", type => "string"},
+            {desc => "Invoice ID or a list of them", type => "mixed"},
+        ],
+        return => {
+            desc => q{One A/T event containing a printable HTML voucher for
+                each given invoice},
+            type => "object", class => "atev"}
+    }
+);
+
+
+sub print_html_invoice {
+    my ($self, $conn, $auth, $id_list) = @_;
+
+    my $e = new_editor("authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    $id_list = [$id_list] unless ref $id_list;
+
+    my $invoices = $e->search_acq_invoice({"id" => $id_list}) or
+        return $e->die_event;
+
+    foreach my $invoice (@$invoices) {
+        return $e->die_event unless
+            $e->allowed("VIEW_INVOICE", $invoice->receiver);
+
+        my $amounts = amounts_spent_per_fund($e, $invoice->id) or
+            return $e->die_event;
+
+        $conn->respond(
+            $U->fire_object_event(
+                undef, "format.acqinv.html", $invoice, $invoice->receiver,
+                "print-on-demand", $amounts
+            )
+        );
+    }
+
+    $e->disconnect;
+    undef;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Lineitem.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Lineitem.pm
new file mode 100644
index 0000000000..c36bf60b1d
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Lineitem.pm
@@ -0,0 +1,944 @@
+package OpenILS::Application::Acq::Lineitem;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+use OpenILS::Event;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Const qw/:const/;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Application::AppUtils;
+use OpenILS::Application::Acq::Financials;
+use OpenILS::Application::Cat::BibCommon;
+use OpenILS::Application::Cat::AssetCommon;
+my $U = 'OpenILS::Application::AppUtils';
+
+
+__PACKAGE__->register_method(
+    method    => 'create_lineitem',
+    api_name  => 'open-ils.acq.lineitem.create',
+    signature => {
+        desc   => 'Creates a lineitem',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'The lineitem object to create', type => 'object'},
+        ],
+        return => {desc => 'ID of newly created lineitem on success, Event on error'}
+    }
+);
+
+sub create_lineitem {
+    my($self, $conn, $auth, $li) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+
+
+    if($li->picklist) {
+        my $picklist = $e->retrieve_acq_picklist($li->picklist)
+            or return $e->die_event;
+
+        if($picklist->owner != $e->requestor->id) {
+            return $e->die_event unless 
+                $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
+        }
+    
+        # indicate the picklist was updated
+        $picklist->edit_time('now');
+        $picklist->editor($e->requestor->id);
+        $e->update_acq_picklist($picklist) or return $e->die_event;
+    }
+
+    if($li->purchase_order) {
+        my $po = $e->retrieve_acq_purchase_order($li->purchase_order)
+            or return $e->die_event;
+        return $e->die_event unless 
+            $e->allowed('MANAGE_PROVIDER', $po->ordering_agency, $po);
+
+        $li->provider($po->provider) unless defined $li->provider;
+    }
+
+    $li->selector($e->requestor->id);
+    $e->create_acq_lineitem($li) or return $e->die_event;
+
+    $e->commit;
+    return $li->id;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'retrieve_lineitem',
+    api_name  => 'open-ils.acq.lineitem.retrieve',
+    authoritative => 1,
+    signature => {
+        desc   => 'Retrieves a lineitem',
+        params => [
+            {desc => 'Authentication token',    type => 'string'},
+            {desc => 'lineitem ID to retrieve', type => 'number'},
+            {options => q/Hash of options, including:
+flesh_attrs         : for attributes,
+flesh_notes         : for notes,
+flesh_cancel_reason : for cancel reason,
+flesh_li_details    : for order details objects,
+clear_marc          : to clear marcxml from lineitem/, type => 'hash'},
+        ],
+        return => {desc => 'lineitem object on success, Event on error'}
+    }
+);
+
+
+sub retrieve_lineitem {
+    my($self, $conn, $auth, $li_id, $options) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    return retrieve_lineitem_impl($e, $li_id, $options);
+}
+
+sub retrieve_lineitem_impl {
+    my ($e, $li_id, $options, $no_auth) = @_;   # no_auth needed for EDI scripts
+    $options ||= {};
+
+    my $flesh = {
+        flesh => 3,
+        flesh_fields => {
+            jub => ['purchase_order', 'picklist'], # needed for permission check
+            acqlid => [],
+            acqlin => []
+        }
+    };
+
+    my $fields = $flesh->{flesh_fields};
+
+    push(@{$fields->{jub}   },    'attributes') if $$options{flesh_attrs};
+    push(@{$fields->{jub}   },'lineitem_notes') if $$options{flesh_notes};
+    push(@{$fields->{acqlin}},    'alert_text') if $$options{flesh_notes};
+    push(@{$fields->{jub}   }, 'order_summary') if $$options{flesh_order_summary};
+    push(@{$fields->{acqlin}}, 'cancel_reason') if $$options{flesh_cancel_reason};
+
+    if($$options{flesh_li_details}) {
+        push(@{$fields->{jub}   }, 'lineitem_details');
+        push(@{$fields->{acqlid}}, 'fund'         ) if $$options{flesh_fund};
+        push(@{$fields->{acqlid}}, 'fund_debit'   ) if $$options{flesh_fund_debit};
+        push(@{$fields->{acqlid}}, 'cancel_reason') if $$options{flesh_cancel_reason};
+    }
+
+    if($$options{clear_marc}) { # avoid fetching marc blob
+        my @fields = grep { $_ ne 'marc' } Fieldmapper::acq::lineitem->new->real_fields;
+        $flesh->{select} = {jub => [@fields]};
+    }
+
+    my $li = $e->retrieve_acq_lineitem([$li_id, $flesh]) or return $e->event;
+
+    # collect the # of lids
+    if($$options{flesh_li_details}) {
+        $li->item_count(scalar(@{$li->lineitem_details}));
+    } else {
+        my $details = $e->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
+        $li->item_count(scalar(@$details));
+    }
+
+    # attach claims to LIDs
+    if($$options{flesh_li_details}) {
+        foreach (@{$li->lineitem_details}) {
+            $_->claims(
+                $e->search_acq_claim([
+                    {"lineitem_detail", $_->id}, {
+                        "flesh" => 1, "flesh_fields" => {"acqcl" => ["type"]}
+                    }
+                ])
+            );
+        }
+    }
+
+    return $e->event unless ((
+        $li->purchase_order and 
+            ($no_auth or $e->allowed(['VIEW_PURCHASE_ORDER', 'CREATE_PURCHASE_ORDER'], 
+                $li->purchase_order->ordering_agency, $li->purchase_order))
+        ) or (
+        $li->picklist and !$li->purchase_order and # user doesn't have view_po perms
+            ($no_auth or $e->allowed(['VIEW_PICKLIST', 'CREATE_PICKLIST'], 
+                $li->picklist->org_unit, $li->picklist))
+    ));
+
+    unless ($$options{flesh_po}) {
+        $li->purchase_order(
+            $li->purchase_order ? $li->purchase_order->id : undef
+        );
+    }
+    unless ($$options{flesh_pl}) {
+        $li->picklist($li->picklist ? $li->picklist->id : undef);
+    }
+    return $li;
+}
+
+
+
+__PACKAGE__->register_method(
+    method    => 'delete_lineitem',
+    api_name  => 'open-ils.acq.lineitem.delete',
+    signature => {
+        desc   => 'Deletes a lineitem',
+        params => [
+            {desc => 'Authentication token',  type => 'string'},
+            {desc => 'lineitem ID to delete', type => 'number'},
+        ],
+        return => {desc => '1 on success, Event on error'}
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => 'delete_lineitem',
+    api_name  => 'open-ils.acq.purchase_order.lineitem.delete',
+    signature => {
+        desc   => 'Deletes a lineitem from a purchase order',
+        params => [
+            {desc => 'Authentication token',  type => 'string'},
+            {desc => 'lineitem ID to delete', type => 'number'},
+        ],
+        return => {desc => '1 on success, Event on error'}
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => 'delete_lineitem',
+    api_name  => 'open-ils.acq.picklist.lineitem.delete',
+    signature => {
+        desc   => 'Deletes a lineitem from a picklist',
+        params => [
+            {desc => 'Authentication token',  type => 'string'},
+            {desc => 'lineitem ID to delete', type => 'number'},
+        ],
+        return => {desc => '1 on success, Event on error'}
+    }
+);
+
+sub delete_lineitem {
+    my($self, $conn, $auth, $li_id) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $li = $e->retrieve_acq_lineitem($li_id)
+        or return $e->die_event;
+
+    # XXX check state
+
+    if($li->picklist) {
+        my $picklist = $e->retrieve_acq_picklist($li->picklist)
+            or return $e->die_event;
+        return OpenILS::Event->new('BAD_PARAMS') 
+            if $picklist->owner != $e->requestor->id;
+    } else {
+        # check PO perms
+    }
+
+    # once a LI is attached to a PO, deleting it
+    # from a picklist means *detaching* it from the picklist
+    if ($self->api_name =~ /picklist/ && $li->purchase_order) {
+        $li->clear_picklist;
+        my $evt = update_lineitem_impl($e, $li);
+        return $evt if $evt;
+        $e->commit;
+        return 1;
+    }
+
+    # delete the attached lineitem_details
+    my $lid_ids = $e->search_acq_lineitem_detail(
+        {lineitem => $li_id}, {idlist=>1});
+
+    for my $lid_id (@$lid_ids) {
+        $e->delete_acq_lineitem_detail(
+            $e->retrieve_acq_lineitem_detail($lid_id))
+            or return $e->die_event;
+    }
+
+    $e->delete_acq_lineitem($li) or return $e->die_event;
+    $e->commit;
+    return 1;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'update_lineitem',
+    api_name  => 'open-ils.acq.lineitem.update',
+    signature => {
+        desc   => 'Update one or many lineitems',
+        params => [
+            {desc => 'Authentication token',   type => 'string'},
+            {desc => 'lineitem object update', type => 'object'}
+        ],
+        return => {desc => '1 on success, Event on error'}
+    }
+);
+
+sub update_lineitem {
+    my($self, $conn, $auth, $li) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+
+    $li = [$li] unless ref $li eq "ARRAY";
+    foreach (@$li) {
+        my $evt = update_lineitem_impl($e, $_);
+        return $evt if $evt;
+    }
+
+    $e->commit;
+    return 1;
+}
+
+sub update_lineitem_impl {
+    my($e, $li) = @_;
+
+    my $orig_li = $e->retrieve_acq_lineitem([
+        $li->id,
+        {   flesh => 1, # grab the lineitem with picklist attached
+            flesh_fields => {jub => ['picklist', 'purchase_order']}
+        }
+    ]) or return $e->die_event;
+
+    # the marc may have been cleared on retrieval...
+    $li->marc($orig_li->marc) unless $li->marc;
+
+    $li->editor($e->requestor->id);
+    $li->edit_time('now');
+    $e->update_acq_lineitem($li) or return $e->die_event;
+    return undef;
+}
+
+__PACKAGE__->register_method(
+	method => 'lineitem_search',
+	api_name => 'open-ils.acq.lineitem.search',
+    stream => 1,
+	signature => {
+        desc => 'Searches lineitems',
+        params => [
+            {desc => 'Authentication token',       type => 'string'},
+            {desc => 'Search definition',          type => 'object'},
+            {desc => 'Options hash.  idlist=true', type => 'object'},
+            {desc => 'List of lineitems',          type => 'object/number'},
+        ]
+    }
+);
+
+sub lineitem_search {
+    my($self, $conn, $auth, $search, $options) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('CREATE_PICKLIST');
+    # XXX needs permissions consideration
+    my $lis = $e->search_acq_lineitem($search, {idlist=>1});
+    for my $li_id (@$lis) {
+        if($$options{idlist}) {
+            $conn->respond($li_id);
+        } else {
+            my $res = retrieve_lineitem($self, $conn, $auth, $li_id, $options);
+            $conn->respond($res) unless $U->event_code($res);
+        }
+    }
+    return undef;
+}
+
+__PACKAGE__->register_method (
+    method    => 'lineitems_related_by_bib',
+    api_name  => 'open-ils.acq.lineitems_for_bib.by_bib_id',
+    stream    => 1,
+    signature => q/
+        Retrieves lineitems attached to same bib record, subject to the PO ordering agency.  This variant takes the bib id.
+        @param authtoken Login session key
+        @param bib_id Id for the pertinent bib record.
+        @param options Object for tweaking the selection criteria and fleshing options.
+    /
+);
+
+__PACKAGE__->register_method (
+    method    => 'lineitems_related_by_bib',
+    api_name  => 'open-ils.acq.lineitems_for_bib.by_lineitem_id',
+    stream    => 1,
+    signature => q/
+        Retrieves lineitems attached to same bib record, subject to the PO ordering agency.  This variant takes the id for any of the pertinent lineitems.
+        @param authtoken Login session key
+        @param bib_id Id for a pertinent lineitem.
+        @param options Object for tweaking the selection criteria and fleshing options.
+    /
+);
+
+__PACKAGE__->register_method (
+    method    => 'lineitems_related_by_bib',
+    api_name  => 'open-ils.acq.lineitems_for_bib.by_lineitem_id.count',
+    stream    => 1,
+    signature => q/See open-ils.acq.lineitems_for_bib.by_lineitem_id. This version returns numbers of lineitems only (XXX may count lineitems we don't actually have permission to retrieve)/
+);
+
+sub lineitems_related_by_bib {
+    my($self, $conn, $auth, $test_value, $options) = @_;
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    my $perm_orgs = $U->user_has_work_perm_at($e, 'VIEW_PURCHASE_ORDER', {descendants =>1}, $e->requestor->id);
+
+    my $query = {
+        "select"=>{"jub"=>["id"]},
+        "from"=>{"jub" => {"acqpo" => {type => 'left'}, "acqpl" => {type => 'left'}}}, 
+        "where"=>{
+            '-or' => [
+                { "+acqpo"=>{ "ordering_agency" => $perm_orgs } },
+                { '+acqpl' => { org_unit => $perm_orgs } }
+            ]
+        },
+        "order_by"=>[{"class"=>"jub", "field"=>"create_time", "direction"=>"desc"}]
+    };
+
+    # Be sure we just return the original LI if no related bibs
+    if ($self->api_name =~ /by_lineitem_id/) {
+        my $orig = retrieve_lineitem($self, $conn, $auth, $test_value) or
+            return $e->die_event;
+        if ($test_value = $orig->eg_bib_id) {
+            $query->{"where"}->{"eg_bib_id"} = $test_value;
+        } else {
+            $query->{"where"}->{"id"} = $orig->id;
+        }
+    } elsif ($test_value) {
+        $query->{"where"}->{"eg_bib_id"} = $test_value;
+    } else {
+        $e->disconnect;
+        return new OpenILS::Event("BAD_PARAMS", "Null bib id");
+    }
+
+    if ($options && defined $options->{lineitem_state}) {
+        $query->{'where'}{'jub'}{'state'} = $options->{lineitem_state};
+    }
+
+    if ($options && defined $options->{po_state}) {
+        $query->{'where'}{'+acqpo'}{'state'} = $options->{po_state};
+    }
+
+    if ($options && defined $options->{order_by}) {
+        $query->{'order_by'} = $options->{order_by};
+    }
+
+    my $results = $e->json_query($query);
+    if ($self->api_name =~ /count$/) {
+        return scalar(@$results);
+    } else {
+        for my $result (@$results) {
+            # retrieve_lineitem takes care of POs and PLs and also handles
+            # options like flesh_notes and permissions checking.
+            $conn->respond(
+                retrieve_lineitem($self, $conn, $auth, $result->{"id"}, $options)
+            );
+        }
+    }
+
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+    method    => "lineitem_search_by_attributes",
+    api_name  => "open-ils.acq.lineitem.search.by_attributes",
+    stream    => 1,
+    signature => {
+        desc   => "Performs a search against lineitem_attrs",
+        params => [
+            {desc => "Authentication token", type => "string"},
+            {   desc => q/
+Search definition:
+    attr_value_pairs : list of pairs of (attr definition ID, attr value) where value can be scalar (fuzzy match) or array (exact match)
+    li_states        : list of lineitem states
+    po_agencies      : list of purchase order ordering agencies (org) ids
+
+At least one of these search terms is required.
+                /,
+                type => "object"},
+            {   desc => q/
+Options hash:
+    idlist      : if set, only return lineitem IDs
+    clear_marc  : if set, strip the MARC xml from the lineitem before delivery
+    flesh_attrs : flesh lineitem attributes;
+                /,
+                type => "object"}
+        ]
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "lineitem_search_by_attributes",
+    api_name  => "open-ils.acq.lineitem.search.by_attributes.ident",
+    stream    => 1,
+    signature => {
+        desc => "Performs a search against lineitem_attrs where ident is true.  ".
+            "See open-ils.acq.lineitem.search.by_attributes for params."
+    }
+);
+
+sub lineitem_search_by_attributes {
+    my ($self, $conn, $auth, $search, $options) = @_;
+
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+    # XXX needs permissions consideration
+
+    return [] unless $search;
+    my $attr_value_pairs = $search->{attr_value_pairs};
+    my $li_states = $search->{li_states};
+    my $po_agencies = $search->{po_agencies}; # XXX if none, base it on perms
+
+    my $query = {
+        "select" => {"acqlia" =>
+            [{"column" => "lineitem", "transform" => "distinct"}]
+        },
+        "from" => {
+            "acqlia" => {
+                "acqliad" => {"field" => "id", "fkey" => "definition"},
+                "jub" => {
+                    "field" => "id",
+                    "fkey" => "lineitem",
+                    "join" => {
+                        "acqpo" => {
+                            "type" => "left",
+                            "field" => "id",
+                            "fkey" => "purchase_order"
+                        }
+                    }
+                }
+            }
+        }
+    };
+
+    my $where = {};
+    $where->{"+acqliad"} = {"ident" => "t"}
+        if $self->api_name =~ /\.ident/;
+
+    my $searched_for_something = 0;
+
+    if (ref $attr_value_pairs eq "ARRAY") {
+        $where->{"-or"} = [];
+        foreach (@$attr_value_pairs) {
+            next if @$_ != 2;
+            my ($def, $value) = @$_;
+            push @{$where->{"-or"}}, {
+                "-and" => {
+                    "attr_value" => (ref $value) ?
+                        $value : {"ilike" => "%" . $value . "%"},
+                    "definition" => $def
+                }
+            };
+        }
+        $searched_for_something = 1;
+    }
+
+    if ($li_states and @$li_states) {
+        $where->{"+jub"} = {"state" => $li_states};
+        $searched_for_something = 1;
+    }
+
+    if ($po_agencies and @$po_agencies) {
+        $where->{"+acqpo"} = {"ordering_agency" => $po_agencies};
+        $searched_for_something = 1;
+    }
+
+    if (not $searched_for_something) {
+        $e->rollback;
+        return new OpenILS::Event(
+            "BAD_PARAMS", note => "You have provided no search terms."
+        );
+    }
+
+    $query->{"where"} = $where;
+    my $lis = $e->json_query($query);
+
+    for my $li_id_obj (@$lis) {
+        my $li_id = $li_id_obj->{"lineitem"};
+        if($options->{"idlist"}) {
+            $conn->respond($li_id);
+        } else {
+            $conn->respond(
+                retrieve_lineitem($self, $conn, $auth, $li_id, $options)
+            );
+        }
+    }
+    undef;
+}
+
+
+__PACKAGE__->register_method(
+	method    => 'lineitem_search_ident',
+	api_name  => 'open-ils.acq.lineitem.search.ident',
+    stream    => 1,
+	signature => {
+        desc => 'Performs a search against lineitem_attrs where ident is true',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {   desc => q/Search definition. Options are:
+                   attr_values : list of attribute values (required)
+                   li_states : list of lineitem states
+                   po_agencies : list of purchase order ordering agencies (org) ids
+                /,
+                type => 'object',
+            },
+            {   desc => q/
+                    Options hash.  Options are:
+                        idlist : if set, only return lineitem IDs
+                        clear_marc : if set, strip the MARC xml from the lineitem before delivery
+                        flesh_attrs : flesh lineitem attributes; 
+                /,
+                type => 'object',
+            }
+        ]
+    }
+);
+
+my $LI_ATTR_SEARCH = {
+    select => { acqlia => ['lineitem'] },
+    from   => {
+        acqlia => {
+            acqliad => {
+                field => 'id',
+                fkey  => 'definition'
+            },
+            jub => {
+                field => 'id',
+                fkey  => 'lineitem',
+                join  => {
+                    acqpo => {
+                        field => 'id',
+                        fkey  => 'purchase_order'
+                    }
+                }
+            }
+        }
+    }
+};
+
+sub lineitem_search_ident {
+    my($self, $conn, $auth, $search, $options) = @_;
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->event unless $e->checkauth;
+    # XXX needs permissions consideration
+
+    return [] unless $search;
+    my $attr_values = $search->{attr_values};
+    my $li_states = $search->{li_states};
+    my $po_agencies = $search->{po_agencies}; # XXX if none, base it on perms
+
+    my $where_clause = {
+        '-or' => [],
+        '+acqlia' => {
+            '+acqliad' => {ident => 't'},
+        }
+    };
+
+    push(@{$where_clause->{'-or'}}, {attr_value => {ilike => "%$_%"}}) for @$attr_values;
+
+    $where_clause->{'+jub'} = {state => {in => $li_states}}
+        if $li_states and @$li_states;
+
+    $where_clause->{'+acqpo'} = {ordering_agency => $po_agencies} 
+        if $po_agencies and @$po_agencies;
+
+    $LI_ATTR_SEARCH->{where} = $where_clause;
+
+    my $lis = $e->json_query($LI_ATTR_SEARCH);
+
+    for my $li_id_obj (@$lis) {
+        my $li_id = $li_id_obj->{lineitem};
+        if($$options{idlist}) {
+            $conn->respond($li_id);
+        } else {
+            my $li;
+            if($$options{flesh_attrs}) {
+                $li = $e->retrieve_acq_lineitem([
+                    $li_id, {flesh => 1, flesh_fields => {jub => ['attributes']}}])
+            } else {
+                $li = $e->retrieve_acq_lineitem($li_id);
+            }
+            $li->clear_marc if $$options{clear_marc};
+            $conn->respond($li);
+        }
+    }
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'retrieve_lineitem_detail',
+    api_name  => 'open-ils.acq.lineitem_detail.retrieve',
+    authoritative => 1,
+    signature => {
+        desc   => q/Updates a lineitem detail/,
+        params => [
+            { desc => 'Authentication token',              type => 'string' },
+            { desc => 'id of lineitem_detail to retrieve', type => 'number' },
+        ],
+        return => { desc => 'object on success, Event on failure' }
+    }
+);
+sub retrieve_lineitem_detail {
+    my($self, $conn, $auth, $li_detail_id) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+
+    my $li_detail = $e->retrieve_acq_lineitem_detail($li_detail_id)
+        or return $e->event;
+
+    if($li_detail->fund) {
+        my $fund = $e->retrieve_acq_fund($li_detail->fund) or return $e->event;
+        return $e->event unless 
+            $e->allowed('MANAGE_FUND', $fund->org, $fund);
+    }
+
+    # XXX check lineitem perms
+    return $li_detail;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'approve_lineitem',
+    api_name  => 'open-ils.acq.lineitem.approve',
+    signature => {
+        desc   => 'Mark a lineitem as approved',
+        params => [
+            { desc => 'Authentication token', type => 'string' },
+            { desc => 'lineitem ID',          type => 'number' }
+        ],
+        return => { desc => '1 on success, Event on error' }
+    }
+);
+sub approve_lineitem {
+    my($self, $conn, $auth, $li_id) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+
+    # XXX perm checks for each lineitem detail
+
+    my $li = $e->retrieve_acq_lineitem($li_id)
+        or return $e->die_event;
+
+    return OpenILS::Event->new('ACQ_LINEITEM_APPROVED', payload => $li_id)
+        if $li->state eq 'approved';
+
+    my $details = $e->search_acq_lineitem_detail({lineitem => $li_id});
+    return OpenILS::Event->new('ACQ_LINEITEM_NO_COPIES', payload => $li_id)
+        unless scalar(@$details) > 0;
+
+    for my $detail (@$details) {
+        return OpenILS::Event->new('ACQ_LINEITEM_DETAIL_NO_FUND', payload => $detail->id)
+            unless $detail->fund;
+
+        return OpenILS::Event->new('ACQ_LINEITEM_DETAIL_NO_ORG', payload => $detail->id)
+            unless $detail->owning_lib;
+    }
+    
+    $li->state('approved');
+    $li->edit_time('now');
+    $e->update_acq_lineitem($li) or return $e->die_event;
+
+    $e->commit;
+    return 1;
+}
+
+
+
+__PACKAGE__->register_method(
+    method    => 'set_lineitem_attr',
+    api_name  => 'open-ils.acq.lineitem_usr_attr.set',
+    signature => {
+        desc   => 'Sets a lineitem_usr_attr value',
+        params => [
+            { desc => 'Authentication token', type => 'string' },
+            { desc => 'Lineitem ID',          type => 'number' },
+            { desc => 'Attr name',            type => 'string' },
+            { desc => 'Attr value',           type => 'string' }
+        ],
+        return => { desc => '1 on success, Event on error' }
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => 'set_lineitem_attr',
+    api_name  => 'open-ils.acq.lineitem_local_attr.set',
+    signature => {
+        desc   => 'Sets a lineitem_local_attr value',
+        params => [
+            { desc => 'Authentication token', type => 'string' },
+            { desc => 'Lineitem ID',          type => 'number' },
+            { desc => 'Attr name',            type => 'string' },
+            { desc => 'Attr value',           type => 'string' }
+        ],
+        return => { desc => 'ID of the attr object on success, Event on error' }
+    }
+);
+
+
+sub set_lineitem_attr {
+    my($self, $conn, $auth, $li_id, $attr_name, $attr_value) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+
+    # XXX perm
+
+    my $attr_type = $self->api_name =~ /local_attr/ ?
+        'lineitem_local_attr_definition' : 'lineitem_usr_attr_definition';
+
+    my $attr = $e->search_acq_lineitem_attr({
+        lineitem => $li_id, 
+        attr_type => $attr_type,
+        attr_name => $attr_name})->[0];
+
+    my $find = "search_acq_$attr_type";
+
+    if($attr) {
+        $attr->attr_value($attr_value);
+        $e->update_acq_lineitem_attr($attr) or return $e->die_event;
+    } else {
+        $attr = Fieldmapper::acq::lineitem_attr->new;
+        $attr->lineitem($li_id);
+        $attr->attr_type($attr_type);
+        $attr->attr_name($attr_name);
+        $attr->attr_value($attr_value);
+
+        my $attr_def_id = $e->$find({code => $attr_name}, {idlist=>1})->[0] 
+            or return $e->die_event;
+        $attr->definition($attr_def_id);
+        $e->create_acq_lineitem_attr($attr) or return $e->die_event;
+    }
+
+    $e->commit;
+    return $attr->id;
+}
+
+__PACKAGE__->register_method(
+    method    => 'get_lineitem_attr_defs',
+    api_name  => 'open-ils.acq.lineitem_attr_definition.retrieve.all',
+    authoritative => 1,
+    signature => {
+        desc   => 'Retrieve lineitem attr definitions',
+        params => [ { desc => 'Authentication token', type => 'string' }, ],
+        return => { desc => 'List of attr definitions' }
+    }
+);
+
+sub get_lineitem_attr_defs {
+    my($self, $conn, $auth) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    my %results;
+    for my $type (qw/generated marc local usr provider/) {
+        my $call = "retrieve_all_acq_lineitem_${type}_attr_definition";
+        $results{$type} = $e->$call;
+    }
+    return \%results;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'lineitem_note_CUD_batch',
+    api_name  => 'open-ils.acq.lineitem_note.cud.batch',
+    stream    => 1,
+    signature => {
+        desc   => q/Manage lineitem notes/,
+        params => [
+            { desc => 'Authentication token',             type => 'string' },
+            { desc => 'List of lineitem_notes to manage', type => 'array'  },
+        ],
+        return =>
+          { desc => 'Streaming response of current position in the array' }
+    }
+);
+
+sub lineitem_note_CUD_batch {
+    my($self, $conn, $auth, $li_notes) = @_;
+
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    # XXX perms
+
+    my $total = @$li_notes;
+    my $count = 0;
+
+    for my $note (@$li_notes) {
+
+        $note->editor($e->requestor->id);
+        $note->edit_time('now');
+
+        if($note->isnew) {
+            $note->creator($e->requestor->id);
+            $note = $e->create_acq_lineitem_note($note) or return $e->die_event;
+
+        } elsif($note->isdeleted) {
+            $e->delete_acq_lineitem_note($note) or return $e->die_event;
+
+        } elsif($note->ischanged) {
+            $e->update_acq_lineitem_note($note) or return $e->die_event;
+        }
+
+        if(!$note->isdeleted) {
+            $note = $e->retrieve_acq_lineitem_note([
+                $note->id, {
+                    "flesh" => 1, "flesh_fields" => {"acqlin" => ["alert_text"]}
+                }
+            ]);
+        }
+
+        $conn->respond({maximum => $total, progress => ++$count, note => $note});
+    }
+
+    $e->commit;
+    return {complete => 1};
+}
+
+__PACKAGE__->register_method(
+    method => 'ranged_line_item_alert_text',
+    api_name => 'open-ils.acq.line_item_alert_text.ranged.retrieve.all');   # TODO: signature
+
+sub ranged_line_item_alert_text {
+    my($self, $conn, $auth, $org_id, $depth) = @_;
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('ADMIN_ACQ_LINEITEM_ALERT_TEXT', $org_id);
+    return $e->search_acq_lineitem_alert_text(
+        {owning_lib => $U->get_org_full_path($org_id, $depth)});
+}
+
+
+__PACKAGE__->register_method(
+    method => "retrieve_lineitem_by_copy_id",
+    api_name => "open-ils.acq.lineitem.retrieve.by_copy_id",
+    authoritative => 1,
+    signature => {
+        desc => q/Manage lineitem notes/,
+        params => [
+            {desc => "Authentication token", type => "string"},
+            {desc => "Evergreen internal copy ID", type => "number"},
+            {desc => "Hash of options (see open-ils.acq.lineitem.retrieve",
+                type => "object"}
+        ],
+        return => {
+            desc => "Lineitem associated with given copy",
+            type => "object", class => "jub"
+        }
+    }
+);
+
+sub retrieve_lineitem_by_copy_id {
+    my ($self, $conn, $auth, $object_id, $options) = @_;
+
+    my $e = new_editor("authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $result = $e->json_query({
+        "select" => {"acqlid" => ["lineitem"]},
+        "from" => "acqlid",
+        "where" => {"eg_copy_id" => $object_id}
+    })->[0] or do {
+        $e->disconnect;
+        return new OpenILS::Event("ACQ_LINEITEM_NOT_FOUND");
+    };
+
+    my $li = retrieve_lineitem_impl($e, $result->{"lineitem"}, $options) or
+        return $e->die_event;
+
+    $e->disconnect;
+    return $li;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Order.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Order.pm
new file mode 100644
index 0000000000..f37f89375b
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Order.pm
@@ -0,0 +1,3177 @@
+package OpenILS::Application::Acq::BatchManager;
+use OpenILS::Application::Acq::Financials;
+use OpenSRF::AppSession;
+use OpenSRF::EX qw/:try/;
+use strict; use warnings;
+
+sub new {
+    my($class, %args) = @_;
+    my $self = bless(\%args, $class);
+    $self->{args} = {
+        lid => 0,
+        li => 0,
+        copies => 0,
+        bibs => 0,
+        progress => 0,
+        debits_accrued => 0,
+        purchase_order => undef,
+        picklist => undef,
+        complete => 0,
+        indexed => 0,
+        total => 0
+    };
+    $self->{ingest_queue} = [];
+    $self->{cache} = {};
+    $self->throttle(5) unless $self->throttle;
+    $self->{post_proc_queue} = [];
+    $self->{last_respond_progress} = 0;
+    return $self;
+}
+
+sub conn {
+    my($self, $val) = @_;
+    $self->{conn} = $val if $val;
+    return $self->{conn};
+}
+sub throttle {
+    my($self, $val) = @_;
+    $self->{throttle} = $val if $val;
+    return $self->{throttle};
+}
+sub respond {
+    my($self, %other_args) = @_;
+    if($self->throttle and not %other_args) {
+        return unless (
+            ($self->{args}->{progress} - $self->{last_respond_progress}) >= $self->throttle
+        );
+    }
+    $self->conn->respond({ %{$self->{args}}, %other_args });
+    $self->{last_respond_progress} = $self->{args}->{progress};
+}
+sub respond_complete {
+    my($self, %other_args) = @_;
+    $self->complete;
+    $self->conn->respond_complete({ %{$self->{args}}, %other_args });
+    $self->run_post_response_hooks;
+    return undef;
+}
+
+# run the post response hook subs, shifting them off as we go
+sub run_post_response_hooks {
+    my($self) = @_;
+    (shift @{$self->{post_proc_queue}})->() while @{$self->{post_proc_queue}};
+}
+
+# any subs passed to this method will be run after the call to respond_complete
+sub post_process {
+    my($self, $sub) = @_;
+    push(@{$self->{post_proc_queue}}, $sub);
+}
+
+sub total {
+    my($self, $val) = @_;
+    $self->{args}->{total} = $val if defined $val;
+    $self->{args}->{maximum} = $self->{args}->{total};
+    return $self->{args}->{total};
+}
+sub purchase_order {
+    my($self, $val) = @_;
+    $self->{args}->{purchase_order} = $val if $val;
+    return $self;
+}
+sub picklist {
+    my($self, $val) = @_;
+    $self->{args}->{picklist} = $val if $val;
+    return $self;
+}
+sub add_lid {
+    my $self = shift;
+    $self->{args}->{lid} += 1;
+    $self->{args}->{progress} += 1;
+    return $self;
+}
+sub add_li {
+    my $self = shift;
+    $self->{args}->{li} += 1;
+    $self->{args}->{progress} += 1;
+    return $self;
+}
+sub add_copy {
+    my $self = shift;
+    $self->{args}->{copies} += 1;
+    $self->{args}->{progress} += 1;
+    return $self;
+}
+sub add_bib {
+    my $self = shift;
+    $self->{args}->{bibs} += 1;
+    $self->{args}->{progress} += 1;
+    return $self;
+}
+sub add_debit {
+    my($self, $amount) = @_;
+    $self->{args}->{debits_accrued} += $amount;
+    $self->{args}->{progress} += 1;
+    return $self;
+}
+sub editor {
+    my($self, $editor) = @_;
+    $self->{editor} = $editor if defined $editor;
+    return $self->{editor};
+}
+sub complete {
+    my $self = shift;
+    $self->{args}->{complete} = 1;
+    return $self;
+}
+
+sub ingest_ses {
+    my($self, $val) = @_;
+    $self->{ingest_ses} = $val if $val;
+    return $self->{ingest_ses};
+}
+
+sub push_ingest_queue {
+    my($self, $rec_id) = @_;
+
+    $self->ingest_ses(OpenSRF::AppSession->connect('open-ils.ingest'))
+        unless $self->ingest_ses;
+
+    my $req = $self->ingest_ses->request('open-ils.ingest.full.biblio.record', $rec_id);
+
+    push(@{$self->{ingest_queue}}, $req);
+}
+
+sub process_ingest_records {
+    my $self = shift;
+    return unless @{$self->{ingest_queue}};
+
+    for my $req (@{$self->{ingest_queue}}) {
+
+        try { 
+            $req->gather(1); 
+            $self->{args}->{indexed} += 1;
+            $self->{args}->{progress} += 1;
+        } otherwise {};
+
+        $self->respond;
+    }
+    $self->ingest_ses->disconnect;
+}
+
+
+sub cache {
+    my($self, $org, $key, $val) = @_;
+    $self->{cache}->{$org} = {} unless $self->{cache}->{org};
+    $self->{cache}->{$org}->{$key} = $val if defined $val;
+    return $self->{cache}->{$org}->{$key};
+}
+
+
+package OpenILS::Application::Acq::Order;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+# ----------------------------------------------------------------------------
+# Break up each component of the order process and pieces into managable
+# actions that can be shared across different workflows
+# ----------------------------------------------------------------------------
+use OpenILS::Event;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenSRF::Utils::JSON;
+use OpenSRF::AppSession;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Const qw/:const/;
+use OpenSRF::EX q/:try/;
+use OpenILS::Application::AppUtils;
+use OpenILS::Application::Cat::BibCommon;
+use OpenILS::Application::Cat::AssetCommon;
+use MARC::Record;
+use MARC::Batch;
+use MARC::File::XML;
+my $U = 'OpenILS::Application::AppUtils';
+
+
+# ----------------------------------------------------------------------------
+# Lineitem
+# ----------------------------------------------------------------------------
+sub create_lineitem {
+    my($mgr, %args) = @_;
+    my $li = Fieldmapper::acq::lineitem->new;
+    $li->creator($mgr->editor->requestor->id);
+    $li->selector($li->creator);
+    $li->editor($li->creator);
+    $li->create_time('now');
+    $li->edit_time('now');
+    $li->state('new');
+    $li->$_($args{$_}) for keys %args;
+    $li->clear_id;
+    $mgr->add_li;
+    $mgr->editor->create_acq_lineitem($li) or return 0;
+    
+    unless($li->estimated_unit_price) {
+        # extract the price from the MARC data
+        my $price = get_li_price_from_attr($mgr->editor, $li) or return $li;
+        $li->estimated_unit_price($price);
+        return update_lineitem($mgr, $li);
+    }
+
+    return $li;
+}
+
+sub get_li_price_from_attr {
+    my($e, $li) = @_;
+    my $attrs = $li->attributes || $e->search_acq_lineitem_attr({lineitem => $li->id});
+
+    for my $attr_type (qw/    
+            lineitem_local_attr_definition 
+            lineitem_prov_attr_definition 
+            lineitem_marc_attr_definition/) {
+
+        my ($attr) = grep {
+            $_->attr_name eq 'estimated_price' and 
+            $_->attr_type eq $attr_type } @$attrs;
+
+        return $attr->attr_value if $attr;
+    }
+
+    return undef;
+}
+
+
+sub update_lineitem {
+    my($mgr, $li) = @_;
+    $li->edit_time('now');
+    $li->editor($mgr->editor->requestor->id);
+    $mgr->add_li;
+    return $mgr->editor->retrieve_acq_lineitem($mgr->editor->data) if
+        $mgr->editor->update_acq_lineitem($li);
+    return undef;
+}
+
+
+# ----------------------------------------------------------------------------
+# Create real holds from patron requests for a given lineitem
+# ----------------------------------------------------------------------------
+sub promote_lineitem_holds {
+    my($mgr, $li) = @_;
+
+    my $requests = $mgr->editor->search_acq_user_request(
+        { lineitem => $li->id,
+          '-or' =>
+            [ { need_before => {'>' => 'now'} },
+              { need_before => undef }
+            ]
+        }
+    );
+
+    for my $request ( @$requests ) {
+
+        $request->eg_bib( $li->eg_bib_id );
+        $mgr->editor->update_acq_user_request( $request ) or return 0;
+
+        next unless ($U->is_true( $request->hold ));
+
+        my $hold = Fieldmapper::action::hold_request->new;
+        $hold->usr( $request->usr );
+        $hold->requestor( $request->usr );
+        $hold->request_time( $request->request_date );
+        $hold->pickup_lib( $request->pickup_lib );
+        $hold->request_lib( $request->pickup_lib );
+        $hold->selection_ou( $request->pickup_lib );
+        $hold->phone_notify( $request->phone_notify );
+        $hold->email_notify( $request->email_notify );
+        $hold->expire_time( $request->need_before );
+
+        if ($request->holdable_formats) {
+            my $mrm = $mgr->editor->search_metabib_metarecord_source_map( { source => $li->eg_bib_id } )->[0];
+            if ($mrm) {
+                $hold->hold_type( 'M' );
+                $hold->holdable_formats( $request->holdable_formats );
+                $hold->target( $mrm->metarecord );
+            }
+        }
+
+        if (!$hold->target) {
+            $hold->hold_type( 'T' );
+            $hold->target( $li->eg_bib_id );
+        }
+
+        $mgr->editor->create_actor_hold_request( $hold ) or return 0;
+    }
+
+    return $li;
+}
+
+sub delete_lineitem {
+    my($mgr, $li) = @_;
+    $li = $mgr->editor->retrieve_acq_lineitem($li) unless ref $li;
+
+    # delete the attached lineitem_details
+    my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
+    for my $lid_id (@$lid_ids) {
+        return 0 unless delete_lineitem_detail($mgr, $lid_id);
+    }
+
+    $mgr->add_li;
+    return $mgr->editor->delete_acq_lineitem($li);
+}
+
+# begins and commit transactions as it goes
+sub create_lineitem_list_assets {
+    my($mgr, $li_ids) = @_;
+    return undef if check_import_li_marc_perms($mgr, $li_ids);
+
+    # create the bibs/volumes/copies and ingest the records
+    for my $li_id (@$li_ids) {
+        $mgr->editor->xact_begin;
+        my $data = create_lineitem_assets($mgr, $li_id) or return undef;
+        $mgr->editor->xact_commit;
+        # XXX ingest is in-db now
+        #$mgr->push_ingest_queue($data->{li}->eg_bib_id) if $data->{new_bib};
+        $mgr->respond;
+    }
+    $mgr->process_ingest_records;
+    return 1;
+}
+
+# returns event on error, undef on success
+sub check_import_li_marc_perms {
+    my($mgr, $li_ids) = @_;
+
+    # if there are any order records that are not linked to 
+    # in-db bib records, verify staff has perms to import order records
+    my $order_li = $mgr->editor->search_acq_lineitem(
+        [{id => $li_ids, eg_bib_id => undef}, {limit => 1}], {idlist => 1})->[0];
+
+    if($order_li) {
+        return $mgr->editor->die_event unless 
+            $mgr->editor->allowed('IMPORT_ACQ_LINEITEM_BIB_RECORD');
+    }
+
+    return undef;
+}
+
+
+# ----------------------------------------------------------------------------
+# if all of the lineitem details for this lineitem have 
+# been received, mark the lineitem as received
+# returns 1 on non-received, li on received, 0 on error
+# ----------------------------------------------------------------------------
+
+sub describe_affected_po {
+    my ($e, $po) = @_;
+
+    my ($enc, $spent) =
+        OpenILS::Application::Acq::Financials::build_price_summary(
+            $e, $po->id
+        );
+
+    +{$po->id => {
+            "state" => $po->state,
+            "amount_encumbered" => $enc,
+            "amount_spent" => $spent
+        }
+    };
+}
+
+sub check_lineitem_received {
+    my($mgr, $li_id) = @_;
+
+    my $non_recv = $mgr->editor->search_acq_lineitem_detail(
+        {recv_time => undef, lineitem => $li_id}, {idlist=>1});
+
+    return 1 if @$non_recv;
+
+    my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
+    $li->state('received');
+    return update_lineitem($mgr, $li);
+}
+
+sub receive_lineitem {
+    my($mgr, $li_id, $skip_complete_check) = @_;
+    my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
+
+    my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
+        {lineitem => $li_id, recv_time => undef}, {idlist => 1});
+
+    for my $lid_id (@$lid_ids) {
+       receive_lineitem_detail($mgr, $lid_id, 1) or return 0; 
+    }
+
+    $mgr->add_li;
+    $li->state('received');
+
+    $li = update_lineitem($mgr, $li) or return 0;
+    $mgr->post_process( sub { create_lineitem_status_events($mgr, $li_id, 'aur.received'); });
+
+    my $po;
+    return 0 unless
+        $skip_complete_check or (
+            $po = check_purchase_order_received($mgr, $li->purchase_order)
+        );
+
+    my $result = {"li" => {$li->id => {"state" => $li->state}}};
+    $result->{"po"} = describe_affected_po($mgr->editor, $po) if ref $po;
+    return $result;
+}
+
+sub rollback_receive_lineitem {
+    my($mgr, $li_id) = @_;
+    my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
+
+    my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
+        {lineitem => $li_id, recv_time => {'!=' => undef}}, {idlist => 1});
+
+    for my $lid_id (@$lid_ids) {
+       rollback_receive_lineitem_detail($mgr, $lid_id, 1) or return 0; 
+    }
+
+    $mgr->add_li;
+    $li->state('on-order');
+    return update_lineitem($mgr, $li);
+}
+
+
+sub create_lineitem_status_events {
+    my($mgr, $li_id, $hook) = @_;
+
+    my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+    $ses->connect;
+    my $user_reqs = $mgr->editor->search_acq_user_request([
+        {lineitem => $li_id}, 
+        {flesh => 1, flesh_fields => {aur => ['usr']}}
+    ]);
+
+    for my $user_req (@$user_reqs) {
+        my $req = $ses->request('open-ils.trigger.event.autocreate', $hook, $user_req, $user_req->usr->home_ou);
+        $req->recv; 
+    }
+
+    $ses->disconnect;
+    return undef;
+}
+
+# ----------------------------------------------------------------------------
+# Lineitem Detail
+# ----------------------------------------------------------------------------
+sub create_lineitem_detail {
+    my($mgr, %args) = @_;
+    my $lid = Fieldmapper::acq::lineitem_detail->new;
+    $lid->$_($args{$_}) for keys %args;
+    $lid->clear_id;
+    $mgr->add_lid;
+    return $mgr->editor->create_acq_lineitem_detail($lid);
+}
+
+
+# flesh out any required data with default values where appropriate
+sub complete_lineitem_detail {
+    my($mgr, $lid) = @_;
+    unless($lid->barcode) {
+        my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ';
+        $lid->barcode($pfx.$lid->id);
+    }
+
+    unless($lid->cn_label) {
+        my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ';
+        $lid->cn_label($pfx.$lid->id);
+    }
+
+    if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) {
+        $lid->location($loc);
+    }
+
+    $lid->circ_modifier(get_default_circ_modifier($mgr, $lid->owning_lib))
+        unless defined $lid->circ_modifier;
+
+    $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
+    return $lid;
+}
+
+sub get_default_circ_modifier {
+    my($mgr, $org) = @_;
+    my $code = $mgr->cache($org, 'def_circ_mod');
+    $code = $U->ou_ancestor_setting_value($org, 'acq.default_circ_modifier') unless defined $code;
+    return $mgr->cache($org, 'def_circ_mod', $code) if defined $code;
+    return undef;
+}
+
+sub delete_lineitem_detail {
+    my($mgr, $lid) = @_;
+    $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid;
+    return $mgr->editor->delete_acq_lineitem_detail($lid);
+}
+
+
+sub receive_lineitem_detail {
+    my($mgr, $lid_id, $skip_complete_check) = @_;
+    my $e = $mgr->editor;
+
+    my $lid = $e->retrieve_acq_lineitem_detail([
+        $lid_id,
+        {   flesh => 1,
+            flesh_fields => {
+                acqlid => ['fund_debit']
+            }
+        }
+    ]) or return 0;
+
+    return 1 if $lid->recv_time;
+
+    $lid->recv_time('now');
+    $e->update_acq_lineitem_detail($lid) or return 0;
+
+    my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
+    $copy->status(OILS_COPY_STATUS_IN_PROCESS);
+    $copy->edit_date('now');
+    $copy->editor($e->requestor->id);
+    $e->update_asset_copy($copy) or return 0;
+
+    $mgr->add_lid;
+
+    return 1 if $skip_complete_check;
+
+    my $li = check_lineitem_received($mgr, $lid->lineitem) or return 0;
+    return 1 if $li == 1; # li not received
+
+    return check_purchase_order_received($mgr, $li->purchase_order) or return 0;
+}
+
+
+sub rollback_receive_lineitem_detail {
+    my($mgr, $lid_id) = @_;
+    my $e = $mgr->editor;
+
+    my $lid = $e->retrieve_acq_lineitem_detail([
+        $lid_id,
+        {   flesh => 1,
+            flesh_fields => {
+                acqlid => ['fund_debit']
+            }
+        }
+    ]) or return 0;
+
+    return 1 unless $lid->recv_time;
+
+    $lid->clear_recv_time;
+    $e->update_acq_lineitem_detail($lid) or return 0;
+
+    my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
+    $copy->status(OILS_COPY_STATUS_ON_ORDER);
+    $copy->edit_date('now');
+    $copy->editor($e->requestor->id);
+    $e->update_asset_copy($copy) or return 0;
+
+    $mgr->add_lid;
+    return $lid;
+}
+
+# ----------------------------------------------------------------------------
+# Lineitem Attr
+# ----------------------------------------------------------------------------
+sub set_lineitem_attr {
+    my($mgr, %args) = @_;
+    my $attr_type = $args{attr_type};
+
+    # first, see if it's already set.  May just need to overwrite it
+    my $attr = $mgr->editor->search_acq_lineitem_attr({
+        lineitem => $args{lineitem},
+        attr_type => $args{attr_type},
+        attr_name => $args{attr_name}
+    })->[0];
+
+    if($attr) {
+        $attr->attr_value($args{attr_value});
+        return $attr if $mgr->editor->update_acq_lineitem_attr($attr);
+        return undef;
+
+    } else {
+
+        $attr = Fieldmapper::acq::lineitem_attr->new;
+        $attr->$_($args{$_}) for keys %args;
+        
+        unless($attr->definition) {
+            my $find = "search_acq_$attr_type";
+            my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0;
+            $attr->definition($attr_def_id);
+        }
+        return $mgr->editor->create_acq_lineitem_attr($attr);
+    }
+}
+
+# ----------------------------------------------------------------------------
+# Lineitem Debits
+# ----------------------------------------------------------------------------
+sub create_lineitem_debits {
+    my ($mgr, $li, $dry_run) = @_; 
+
+    unless($li->estimated_unit_price) {
+        $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id));
+        $mgr->editor->rollback;
+        return 0;
+    }
+
+    unless($li->provider) {
+        $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id));
+        $mgr->editor->rollback;
+        return 0;
+    }
+
+    my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
+        {lineitem => $li->id}, 
+        {idlist=>1}
+    );
+
+    for my $lid_id (@$lid_ids) {
+
+        my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
+            $lid_id,
+            {   flesh => 1, 
+                flesh_fields => {acqlid => ['fund']}
+            }
+        ]);
+
+        create_lineitem_detail_debit($mgr, $li, $lid, $dry_run) or return 0;
+    }
+
+    return 1;
+}
+
+
+# flesh li->provider
+# flesh lid->fund
+sub create_lineitem_detail_debit {
+    my ($mgr, $li, $lid, $dry_run, $no_translate) = @_;
+
+    # don't create the debit if one already exists
+    return $mgr->editor->retrieve_acq_fund_debit($lid->fund_debit) if $lid->fund_debit;
+
+    my $li_id = ref($li) ? $li->id : $li;
+
+    unless(ref $li and ref $li->provider) {
+       $li = $mgr->editor->retrieve_acq_lineitem([
+            $li_id,
+            {   flesh => 1,
+                flesh_fields => {jub => ['provider']},
+            }
+        ]);
+    }
+
+    if(ref $lid) {
+        $lid->fund($mgr->editor->retrieve_acq_fund($lid->fund)) unless(ref $lid->fund);
+    } else {
+        $lid = $mgr->editor->retrieve_acq_lineitem_detail([
+            $lid,
+            {   flesh => 1, 
+                flesh_fields => {acqlid => ['fund']}
+            }
+        ]);
+    }
+
+    unless ($lid->fund) {
+        $mgr->editor->event(
+            new OpenILS::Event("ACQ_FUND_NOT_FOUND") # close enough
+        );
+        return 0;
+    }
+
+    my $amount = $li->estimated_unit_price;
+    if($li->provider->currency_type ne $lid->fund->currency_type and !$no_translate) {
+
+        # At Fund debit creation time, translate into the currency of the fund
+        # TODO: org setting to disable automatic currency conversion at debit create time?
+
+        $amount = $mgr->editor->json_query({
+            from => [
+                'acq.exchange_ratio', 
+                $li->provider->currency_type, # source currency
+                $lid->fund->currency_type, # destination currency
+                $li->estimated_unit_price # source amount
+            ]
+        })->[0]->{value};
+    }
+
+    my $debit = create_fund_debit(
+        $mgr, 
+        $dry_run,
+        fund => $lid->fund->id,
+        origin_amount => $li->estimated_unit_price,
+        origin_currency_type => $li->provider->currency_type,
+        amount => $amount
+    ) or return 0;
+
+    $lid->fund_debit($debit->id);
+    $lid->fund($lid->fund->id);
+    $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
+    return $debit;
+}
+
+
+__PACKAGE__->register_method(
+	"method" => "fund_exceeds_balance_percent_api",
+	"api_name" => "open-ils.acq.fund.check_balance_percentages",
+	"signature" => {
+        "desc" => q/Determine whether a given fund exceeds its defined
+            "balance stop and warning percentages"/,
+        "params" => [
+            {"desc" => "Authentication token", "type" => "string"},
+            {"desc" => "Fund ID", "type" => "number"},
+            {"desc" => "Theoretical debit amount (optional)",
+                "type" => "number"}
+        ],
+        "return" => {"desc" => q/An array of two values, for stop and warning,
+            in that order: 1 if fund exceeds that balance percentage, else 0/}
+    }
+);
+
+sub fund_exceeds_balance_percent_api {
+    my ($self, $conn, $auth, $fund_id, $debit_amount) = @_;
+
+    $debit_amount ||= 0;
+
+    my $e = new_editor("authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $fund = $e->retrieve_acq_fund($fund_id) or return $e->die_event;
+    return $e->die_event unless $e->allowed("VIEW_FUND", $fund->org);
+
+    my $result = [
+        fund_exceeds_balance_percent($fund, $debit_amount, $e, "stop"),
+        fund_exceeds_balance_percent($fund, $debit_amount, $e, "warning")
+    ];
+
+    $e->disconnect;
+    return $result;
+}
+
+sub fund_exceeds_balance_percent {
+    my ($fund, $debit_amount, $e, $which) = @_;
+
+    my ($method_name, $event_name) = @{{
+        "warning" => [
+            "balance_warning_percent", "ACQ_FUND_EXCEEDS_WARN_PERCENT"
+        ],
+        "stop" => [
+            "balance_stop_percent", "ACQ_FUND_EXCEEDS_STOP_PERCENT"
+        ]
+    }->{$which}};
+
+    if ($fund->$method_name) {
+        my $balance =
+            $e->search_acq_fund_combined_balance({"fund" => $fund->id})->[0];
+        my $allocations =
+            $e->search_acq_fund_allocation_total({"fund" => $fund->id})->[0];
+
+        $balance = ($balance) ? $balance->amount : 0;
+        $allocations = ($allocations) ? $allocations->amount : 0;
+
+        if ( 
+            $allocations == 0 || # if no allocations were ever made, assume we have hit the stop percent
+            ((($allocations - $balance + $debit_amount) / $allocations) * 100) > $fund->$method_name
+        ) {
+            $logger->info("fund would hit a limit: " . $fund->id . ", $balance, $debit_amount, $allocations, $method_name");
+            $e->event(
+                new OpenILS::Event(
+                    $event_name,
+                    "payload" => {
+                        "fund" => $fund, "debit_amount" => $debit_amount
+                    }
+                )
+            );
+            return 1;
+        }
+    }
+    return 0;
+}
+
+# ----------------------------------------------------------------------------
+# Fund Debit
+# ----------------------------------------------------------------------------
+sub create_fund_debit {
+    my($mgr, $dry_run, %args) = @_;
+
+    # Verify the fund is not being spent beyond the hard stop amount
+    my $fund = $mgr->editor->retrieve_acq_fund($args{fund}) or return 0;
+
+    return 0 if
+        fund_exceeds_balance_percent(
+            $fund, $args{"amount"}, $mgr->editor, "stop"
+        );
+    return 0 if
+        $dry_run and fund_exceeds_balance_percent(
+            $fund, $args{"amount"}, $mgr->editor, "warning"
+        );
+
+    my $debit = Fieldmapper::acq::fund_debit->new;
+    $debit->debit_type('purchase');
+    $debit->encumbrance('t');
+    $debit->$_($args{$_}) for keys %args;
+    $debit->clear_id;
+    $mgr->add_debit($debit->amount);
+    return $mgr->editor->create_acq_fund_debit($debit);
+}
+
+
+# ----------------------------------------------------------------------------
+# Picklist
+# ----------------------------------------------------------------------------
+sub create_picklist {
+    my($mgr, %args) = @_;
+    my $picklist = Fieldmapper::acq::picklist->new;
+    $picklist->creator($mgr->editor->requestor->id);
+    $picklist->owner($picklist->creator);
+    $picklist->editor($picklist->creator);
+    $picklist->create_time('now');
+    $picklist->edit_time('now');
+    $picklist->org_unit($mgr->editor->requestor->ws_ou);
+    $picklist->owner($mgr->editor->requestor->id);
+    $picklist->$_($args{$_}) for keys %args;
+    $picklist->clear_id;
+    $mgr->picklist($picklist);
+    return $mgr->editor->create_acq_picklist($picklist);
+}
+
+sub update_picklist {
+    my($mgr, $picklist) = @_;
+    $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
+    $picklist->edit_time('now');
+    $picklist->editor($mgr->editor->requestor->id);
+    if ($mgr->editor->update_acq_picklist($picklist)) {
+        $picklist = $mgr->editor->retrieve_acq_picklist($mgr->editor->data);
+        $mgr->picklist($picklist);
+        return $picklist;
+    } else {
+        return undef;
+    }
+}
+
+sub delete_picklist {
+    my($mgr, $picklist) = @_;
+    $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
+
+    # delete all 'new' lineitems
+    my $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => 'new'}, {idlist => 1});
+    for my $li_id (@$li_ids) {
+        my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
+        return 0 unless delete_lineitem($mgr, $li);
+        $mgr->respond;
+    }
+
+    # detach all non-'new' lineitems
+    $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}}, {idlist => 1});
+    for my $li_id (@$li_ids) {
+        my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
+        $li->clear_picklist;
+        return 0 unless update_lineitem($mgr, $li);
+        $mgr->respond;
+    }
+
+    # remove any picklist-specific object perms
+    my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id});
+    for my $op (@$ops) {
+        return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
+    }
+
+    return $mgr->editor->delete_acq_picklist($picklist);
+}
+
+# ----------------------------------------------------------------------------
+# Purchase Order
+# ----------------------------------------------------------------------------
+sub update_purchase_order {
+    my($mgr, $po) = @_;
+    $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
+    $po->editor($mgr->editor->requestor->id);
+    $po->edit_time('now');
+    $mgr->purchase_order($po);
+    return $mgr->editor->retrieve_acq_purchase_order($mgr->editor->data)
+        if $mgr->editor->update_acq_purchase_order($po);
+    return undef;
+}
+
+sub create_purchase_order {
+    my($mgr, %args) = @_;
+
+    # verify the chosen provider is still active
+    my $provider = $mgr->editor->retrieve_acq_provider($args{provider}) or return 0;
+    unless($U->is_true($provider->active)) {
+        $logger->error("provider is not active.  cannot create PO");
+        $mgr->editor->event(OpenILS::Event->new('ACQ_PROVIDER_INACTIVE'));
+        return 0;
+    }
+
+    my $po = Fieldmapper::acq::purchase_order->new;
+    $po->creator($mgr->editor->requestor->id);
+    $po->editor($mgr->editor->requestor->id);
+    $po->owner($mgr->editor->requestor->id);
+    $po->edit_time('now');
+    $po->create_time('now');
+    $po->state('pending');
+    $po->ordering_agency($mgr->editor->requestor->ws_ou);
+    $po->$_($args{$_}) for keys %args;
+    $po->clear_id;
+    $mgr->purchase_order($po);
+    return $mgr->editor->create_acq_purchase_order($po);
+}
+
+# ----------------------------------------------------------------------------
+# if all of the lineitems for this PO are received,
+# mark the PO as received
+# ----------------------------------------------------------------------------
+sub check_purchase_order_received {
+    my($mgr, $po_id) = @_;
+
+    my $non_recv_li = $mgr->editor->search_acq_lineitem(
+        {   purchase_order => $po_id,
+            state => {'!=' => 'received'}
+        }, {idlist=>1});
+
+    my $po = $mgr->editor->retrieve_acq_purchase_order($po_id);
+    return $po if @$non_recv_li;
+
+    $po->state('received');
+    return update_purchase_order($mgr, $po);
+}
+
+
+# ----------------------------------------------------------------------------
+# Bib, Callnumber, and Copy data
+# ----------------------------------------------------------------------------
+
+sub create_lineitem_assets {
+    my($mgr, $li_id) = @_;
+    my $evt;
+
+    my $li = $mgr->editor->retrieve_acq_lineitem([
+        $li_id,
+        {   flesh => 1,
+            flesh_fields => {jub => ['purchase_order', 'attributes']}
+        }
+    ]) or return 0;
+
+    # -----------------------------------------------------------------
+    # first, create the bib record if necessary
+    # -----------------------------------------------------------------
+    my $new_bib = 0;
+    unless($li->eg_bib_id) {
+        create_bib($mgr, $li) or return 0;
+        $new_bib = 1;
+    }
+
+
+    # -----------------------------------------------------------------
+    # The lineitem is going live, promote user request holds to real holds
+    # -----------------------------------------------------------------
+    promote_lineitem_holds($mgr, $li) or return 0;
+
+    my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
+
+    # -----------------------------------------------------------------
+    # for each lineitem_detail, create the volume if necessary, create 
+    # a copy, and link them all together.
+    # -----------------------------------------------------------------
+    my $first_cn;
+    for my $lid_id (@{$li_details}) {
+
+        my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
+        next if $lid->eg_copy_id;
+
+        # use the same callnumber label for all items within this lineitem
+        $lid->cn_label($first_cn) if $first_cn and not $lid->cn_label;
+
+        # apply defaults if necessary
+        return 0 unless complete_lineitem_detail($mgr, $lid);
+
+        $first_cn = $lid->cn_label unless $first_cn;
+
+        my $org = $lid->owning_lib;
+        my $label = $lid->cn_label;
+        my $bibid = $li->eg_bib_id;
+
+        my $volume = $mgr->cache($org, "cn.$bibid.$label");
+        unless($volume) {
+            $volume = create_volume($mgr, $li, $lid) or return 0;
+            $mgr->cache($org, "cn.$bibid.$label", $volume);
+        }
+        create_copy($mgr, $volume, $lid, $li) or return 0;
+    }
+
+    return { li => $li, new_bib => $new_bib };
+}
+
+sub create_bib {
+    my($mgr, $li) = @_;
+
+    my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
+        $mgr->editor, 
+        $li->marc, 
+        undef, # bib source
+        undef, 
+        1, # override tcn collisions
+    ); 
+
+    if($U->event_code($record)) {
+        $mgr->editor->event($record);
+        $mgr->editor->rollback;
+        return 0;
+    }
+
+    $li->eg_bib_id($record->id);
+    $mgr->add_bib;
+    return update_lineitem($mgr, $li);
+}
+
+sub create_volume {
+    my($mgr, $li, $lid) = @_;
+
+    my ($volume, $evt) = 
+        OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
+            $mgr->editor, 
+            $lid->cn_label, 
+            $li->eg_bib_id, 
+            $lid->owning_lib
+        );
+
+    if($evt) {
+        $mgr->editor->event($evt);
+        return 0;
+    }
+
+    return $volume;
+}
+
+sub create_copy {
+    my($mgr, $volume, $lid, $li) = @_;
+    my $copy = Fieldmapper::asset::copy->new;
+    $copy->isnew(1);
+    $copy->loan_duration(2);
+    $copy->fine_level(2);
+    $copy->status(($lid->recv_time) ? OILS_COPY_STATUS_IN_PROCESS : OILS_COPY_STATUS_ON_ORDER);
+    $copy->barcode($lid->barcode);
+    $copy->location($lid->location);
+    $copy->call_number($volume->id);
+    $copy->circ_lib($volume->owning_lib);
+    $copy->circ_modifier($lid->circ_modifier);
+
+    # AKA list price.  We might need a $li->list_price field since 
+    # estimated price is not necessarily the same as list price
+    $copy->price($li->estimated_unit_price); 
+
+    my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
+    if($evt) {
+        $mgr->editor->event($evt);
+        return 0;
+    }
+
+    $mgr->add_copy;
+    $lid->eg_copy_id($copy->id);
+    $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
+}
+
+
+
+
+
+
+# ----------------------------------------------------------------------------
+# Workflow: Build a selection list from a Z39.50 search
+# ----------------------------------------------------------------------------
+
+__PACKAGE__->register_method(
+	method => 'zsearch',
+	api_name => 'open-ils.acq.picklist.search.z3950',
+    stream => 1,
+	signature => {
+        desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Search definition', type => 'object'},
+            {desc => 'Picklist name, optional', type => 'string'},
+        ]
+    }
+);
+
+sub zsearch {
+    my($self, $conn, $auth, $search, $name, $options) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('CREATE_PICKLIST');
+
+    $search->{limit} ||= 10;
+    $options ||= {};
+
+    my $ses = OpenSRF::AppSession->create('open-ils.search');
+    my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
+
+    my $first = 1;
+    my $picklist;
+    my $mgr;
+    while(my $resp = $req->recv(timeout=>60)) {
+
+        if($first) {
+            my $e = new_editor(requestor=>$e->requestor, xact=>1);
+            $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+            $picklist = zsearch_build_pl($mgr, $name);
+            $first = 0;
+        }
+
+        my $result = $resp->content;
+        my $count = $result->{count} || 0;
+        $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
+
+        for my $rec (@{$result->{records}}) {
+
+            my $li = create_lineitem($mgr, 
+                picklist => $picklist->id,
+                source_label => $result->{service},
+                marc => $rec->{marcxml},
+                eg_bib_id => $rec->{bibid}
+            );
+
+            if($$options{respond_li}) {
+                $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
+                    if $$options{flesh_attrs};
+                $li->clear_marc if $$options{clear_marc};
+                $mgr->respond(lineitem => $li);
+            } else {
+                $mgr->respond;
+            }
+        }
+    }
+
+    $mgr->editor->commit;
+    return $mgr->respond_complete;
+}
+
+sub zsearch_build_pl {
+    my($mgr, $name) = @_;
+    $name ||= '';
+
+    my $picklist = $mgr->editor->search_acq_picklist({
+        owner => $mgr->editor->requestor->id, 
+        name => $name
+    })->[0];
+
+    if($name eq '' and $picklist) {
+        return 0 unless delete_picklist($mgr, $picklist);
+        $picklist = undef;
+    }
+
+    return update_picklist($mgr, $picklist) if $picklist;
+    return create_picklist($mgr, name => $name);
+}
+
+
+# ----------------------------------------------------------------------------
+# Workflow: Build a selection list / PO by importing a batch of MARC records
+# ----------------------------------------------------------------------------
+
+__PACKAGE__->register_method(
+    method   => 'upload_records',
+    api_name => 'open-ils.acq.process_upload_records',
+    stream   => 1,
+);
+
+sub upload_records {
+    my($self, $conn, $auth, $key) = @_;
+
+	my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+
+    my $cache = OpenSRF::Utils::Cache->new;
+
+    my $data = $cache->get_cache("vandelay_import_spool_$key");
+    my $purpose         = $data->{purpose};
+    my $filename        = $data->{path};
+    my $provider        = $data->{provider};
+    my $picklist        = $data->{picklist};
+    my $create_po       = $data->{create_po};
+    my $activate_po     = $data->{activate_po};
+    my $ordering_agency = $data->{ordering_agency};
+    my $create_assets   = $data->{create_assets};
+    my $po;
+    my $evt;
+
+    unless(-r $filename) {
+        $logger->error("unable to read MARC file $filename");
+        $e->rollback;
+        return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
+    }
+
+    $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
+
+    if($picklist) {
+        $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
+        if($picklist->owner != $e->requestor->id) {
+            return $e->die_event unless 
+                $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
+        }
+        $mgr->picklist($picklist);
+    }
+
+    if($create_po) {
+
+        $po = create_purchase_order($mgr, 
+            ordering_agency => $ordering_agency,
+            provider => $provider->id,
+            state => 'on-order'
+        ) or return $mgr->editor->die_event;
+    }
+
+    $logger->info("acq processing MARC file=$filename");
+
+	my $batch = new MARC::Batch ('USMARC', $filename);
+	$batch->strict_off;
+
+	my $count = 0;
+    my @li_list;
+
+	while(1) {
+
+	    my ($err, $xml, $r);
+		$count++;
+
+		try {
+            $r = $batch->next;
+        } catch Error with {
+            $err = shift;
+			$logger->warn("Proccessing of record $count in set $key failed with error $err.  Skipping this record");
+        };
+
+        next if $err;
+        last unless $r;
+
+		try {
+            ($xml = $r->as_xml_record()) =~ s/\n//sog;
+            $xml =~ s/^<\?xml.+\?\s*>//go;
+            $xml =~ s/>\s+entityize($xml);
+            $xml =~ s/[\x00-\x1f]//go;
+
+		} catch Error with {
+			$err = shift;
+			$logger->warn("Proccessing XML of record $count in set $key failed with error $err.  Skipping this record");
+		};
+
+        next if $err or not $xml;
+
+        my %args = (
+            source_label => $provider->code,
+            provider => $provider->id,
+            marc => $xml,
+        );
+
+        $args{picklist} = $picklist->id if $picklist;
+        if($po) {
+            $args{purchase_order} = $po->id;
+            $args{state} = 'pending-order';
+        }
+
+        my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
+        $mgr->respond;
+        $li->provider($provider); # flesh it, we'll need it later
+
+        import_lineitem_details($mgr, $ordering_agency, $li) or return $mgr->editor->die_event;
+        $mgr->respond;
+
+        push(@li_list, $li->id);
+        $mgr->respond;
+	}
+
+    my $die_event = activate_purchase_order_impl($mgr, $po->id) if $po and $activate_po;
+    return $die_event if $die_event;
+
+	$e->commit;
+    unlink($filename);
+    $cache->delete_cache('vandelay_import_spool_' . $key);
+
+    if ($create_assets) {
+        create_lineitem_list_assets($mgr, \@li_list) or return $e->die_event;
+    }
+
+    return $mgr->respond_complete;
+}
+
+sub import_lineitem_details {
+    my($mgr, $ordering_agency, $li) = @_;
+
+    my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
+    return 1 unless @$holdings;
+    my $org_path = $U->get_org_ancestors($ordering_agency);
+    $org_path = [ reverse (@$org_path) ];
+    my $price;
+
+
+    my $idx = 1;
+    while(1) {
+        # create a lineitem detail for each copy in the data
+
+        my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx);
+        last unless defined $compiled;
+        return 0 unless $compiled;
+
+        # this takes the price of the last copy and uses it as the lineitem price
+        # need to determine if a given record would include different prices for the same item
+        $price = $$compiled{estimated_price};
+
+        last unless $$compiled{quantity};
+
+        for(1..$$compiled{quantity}) {
+            my $lid = create_lineitem_detail(
+                $mgr, 
+                lineitem        => $li->id,
+                owning_lib      => $$compiled{owning_lib},
+                cn_label        => $$compiled{call_number},
+                fund            => $$compiled{fund},
+                circ_modifier   => $$compiled{circ_modifier},
+                note            => $$compiled{note},
+                location        => $$compiled{copy_location},
+                collection_code => $$compiled{collection_code}
+            ) or return 0;
+        }
+
+        $mgr->respond;
+        $idx++;
+    }
+
+    $li->estimated_unit_price($price);
+    update_lineitem($mgr, $li) or return 0;
+    return 1;
+}
+
+# return hash on success, 0 on error, undef on no more holdings
+sub extract_lineitem_detail_data {
+    my($mgr, $org_path, $holdings, $index) = @_;
+
+    my @data_list = grep { $_->{holding} eq $index } @$holdings;
+    return undef unless @data_list;
+
+    my %compiled = map { $_->{attr} => $_->{data} } @data_list;
+    my $base_org = $$org_path[0];
+
+    my $killme = sub {
+        my $msg = shift;
+        $logger->error("Item import extraction error: $msg");
+        $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
+        $mgr->editor->rollback;
+        $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
+        return 0;
+    };
+
+    # ---------------------------------------------------------------------
+    # Fund
+    if(my $code = $compiled{fund_code}) {
+
+        my $fund = $mgr->cache($base_org, "fund.$code");
+        unless($fund) {
+            # search up the org tree for the most appropriate fund
+            for my $org (@$org_path) {
+                $fund = $mgr->editor->search_acq_fund(
+                    {org => $org, code => $code, year => DateTime->now->year}, {idlist => 1})->[0];
+                last if $fund;
+            }
+        }
+        return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
+        $compiled{fund} = $fund;
+        $mgr->cache($base_org, "fund.$code", $fund);
+    }
+
+
+    # ---------------------------------------------------------------------
+    # Owning lib
+    if(my $sn = $compiled{owning_lib}) {
+        my $org_id = $mgr->cache($base_org, "orgsn.$sn") ||
+            $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
+        return $killme->("invalid owning_lib defined: $sn") unless $org_id;
+        $compiled{owning_lib} = $org_id;
+        $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
+    }
+
+
+    # ---------------------------------------------------------------------
+    # Circ Modifier
+    my $code = $compiled{circ_modifier};
+
+    if(defined $code) {
+
+        # verify this is a valid circ modifier
+        return $killme->("invlalid circ_modifier $code") unless 
+            defined $mgr->cache($base_org, "mod.$code") or 
+            $mgr->editor->retrieve_config_circ_modifier($code);
+
+            # if valid, cache for future tests
+            $mgr->cache($base_org, "mod.$code", $code);
+
+    } else {
+        $compiled{circ_modifier} = get_default_circ_modifier($mgr, $base_org);
+    }
+
+
+    # ---------------------------------------------------------------------
+    # Shelving Location
+    if( my $name = $compiled{copy_location}) {
+        my $loc = $mgr->cache($base_org, "copy_loc.$name");
+        unless($loc) {
+            for my $org (@$org_path) {
+                $loc = $mgr->editor->search_asset_copy_location(
+                    {owning_lib => $org, name => $name}, {idlist => 1})->[0];
+                last if $loc;
+            }
+        }
+        return $killme->("Invalid copy location $name") unless $loc;
+        $compiled{copy_location} = $loc;
+        $mgr->cache($base_org, "copy_loc.$name", $loc);
+    }
+
+    return \%compiled;
+}
+
+
+
+# ----------------------------------------------------------------------------
+# Workflow: Given an existing purchase order, import/create the bibs, 
+# callnumber and copy objects
+# ----------------------------------------------------------------------------
+
+__PACKAGE__->register_method(
+	method => 'create_po_assets',
+	api_name	=> 'open-ils.acq.purchase_order.assets.create',
+	signature => {
+        desc => q/Creates assets for each lineitem in the purchase order/,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'The purchase order id', type => 'number'},
+        ],
+        return => {desc => 'Streams a total versus completed counts object, event on error'}
+    }
+);
+
+sub create_po_assets {
+    my($self, $conn, $auth, $po_id) = @_;
+
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+
+    my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
+
+    my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
+
+    # it's ugly, but it's fast.  Get the total count of lineitem detail objects to process
+    my $lid_total = $e->json_query({
+        select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] }, 
+        from => {
+            acqlid => {
+                jub => {
+                    fkey => 'lineitem', 
+                    field => 'id', 
+                    join => {acqpo => {fkey => 'purchase_order', field => 'id'}}
+                }
+            }
+        }, 
+        where => {'+acqpo' => {id => $po_id}}
+    })->[0]->{id};
+
+    $mgr->total(scalar(@$li_ids) + $lid_total);
+
+    create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
+
+    $e->xact_begin;
+    update_purchase_order($mgr, $po) or return $e->die_event;
+    $e->commit;
+
+    return $mgr->respond_complete;
+}
+
+
+
+__PACKAGE__->register_method(
+    method    => 'create_purchase_order_api',
+    api_name  => 'open-ils.acq.purchase_order.create',
+    signature => {
+        desc   => 'Creates a new purchase order',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'purchase_order to create', type => 'object'}
+        ],
+        return => {desc => 'The purchase order id, Event on failure'}
+    }
+);
+
+sub create_purchase_order_api {
+    my($self, $conn, $auth, $po, $args) = @_;
+    $args ||= {};
+
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+
+    # create the PO
+    my %pargs = (ordering_agency => $e->requestor->ws_ou); # default
+    $pargs{provider}            = $po->provider            if $po->provider;
+    $pargs{ordering_agency}     = $po->ordering_agency     if $po->ordering_agency;
+    $pargs{prepayment_required} = $po->prepayment_required if $po->prepayment_required;
+        
+    $po = create_purchase_order($mgr, %pargs) or return $e->die_event;
+
+    my $li_ids = $$args{lineitems};
+
+    if($li_ids) {
+
+        for my $li_id (@$li_ids) { 
+
+            my $li = $e->retrieve_acq_lineitem([
+                $li_id,
+                {flesh => 1, flesh_fields => {jub => ['attributes']}}
+            ]) or return $e->die_event;
+
+            $li->provider($po->provider);
+            $li->purchase_order($po->id);
+            $li->state('pending-order');
+            update_lineitem($mgr, $li) or return $e->die_event;
+            $mgr->respond;
+        }
+    }
+
+    # commit before starting the asset creation
+    $e->xact_commit;
+
+    if($li_ids and $$args{create_assets}) {
+        create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
+    }
+
+    return $mgr->respond_complete;
+}
+
+
+
+__PACKAGE__->register_method(
+    method   => 'update_lineitem_fund_batch',
+    api_name => 'open-ils.acq.lineitem.fund.update.batch',
+    stream   => 1,
+    signature => { 
+        desc => q/Given a set of lineitem IDS, updates the fund for all attached lineitem details/
+    }
+);
+
+sub update_lineitem_fund_batch {
+    my($self, $conn, $auth, $li_ids, $fund_id) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+    for my $li_id (@$li_ids) {
+        my ($li, $evt) = fetch_and_check_li($e, $li_id, 'write');
+        return $evt if $evt;
+        my $li_details = $e->search_acq_lineitem_detail({lineitem => $li_id});
+        $_->fund($fund_id) and $_->ischanged(1) for @$li_details;
+        $evt = lineitem_detail_CUD_batch($mgr, $li_details);
+        return $evt if $evt;
+        $mgr->add_li;
+        $mgr->respond;
+    }
+    $e->commit;
+    return $mgr->respond_complete;
+}
+
+
+
+__PACKAGE__->register_method(
+    method    => 'lineitem_detail_CUD_batch_api',
+    api_name  => 'open-ils.acq.lineitem_detail.cud.batch',
+    stream    => 1,
+    signature => {
+        desc   => q/Creates a new purchase order line item detail. / .
+                  q/Additionally creates the associated fund_debit/,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'List of lineitem_details to create', type => 'array'},
+            {desc => 'Create Debits.  Used for creating post-po-asset-creation debits', type => 'bool'},
+        ],
+        return => {desc => 'Streaming response of current position in the array'}
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => 'lineitem_detail_CUD_batch_api',
+    api_name  => 'open-ils.acq.lineitem_detail.cud.batch.dry_run',
+    stream    => 1,
+    signature => { 
+        desc => q/
+            Dry run version of open-ils.acq.lineitem_detail.cud.batch.
+            In dry_run mode, updated fund_debit's the exceed the warning
+            percent return an event.  
+        /
+    }
+);
+
+
+sub lineitem_detail_CUD_batch_api {
+    my($self, $conn, $auth, $li_details, $create_debits) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+    my $dry_run = ($self->api_name =~ /dry_run/o);
+    my $evt = lineitem_detail_CUD_batch($mgr, $li_details, $create_debits, $dry_run);
+    return $evt if $evt;
+    $e->commit;
+    return $mgr->respond_complete;
+}
+
+
+sub lineitem_detail_CUD_batch {
+    my($mgr, $li_details, $create_debits, $dry_run) = @_;
+
+    $mgr->total(scalar(@$li_details));
+    my $e = $mgr->editor;
+    
+    my $li;
+    my %li_cache;
+    my $fund_cache = {};
+    my $evt;
+
+    for my $lid (@$li_details) {
+
+        unless($li = $li_cache{$lid->lineitem}) {
+            ($li, $evt) = fetch_and_check_li($e, $lid->lineitem, 'write');
+            return $evt if $evt;
+        }
+
+        if($lid->isnew) {
+            $lid = create_lineitem_detail($mgr, %{$lid->to_bare_hash}) or return $e->die_event;
+            if($create_debits) {
+                $li->provider($e->retrieve_acq_provider($li->provider)) or return $e->die_event;
+                $lid->fund($e->retrieve_acq_fund($lid->fund)) or return $e->die_event;
+                create_lineitem_detail_debit($mgr, $li, $lid, 0, 1) or return $e->die_event;
+            }
+
+        } elsif($lid->ischanged) {
+            return $evt if $evt = handle_changed_lid($e, $lid, $dry_run, $fund_cache);
+
+        } elsif($lid->isdeleted) {
+            delete_lineitem_detail($mgr, $lid) or return $e->die_event;
+        }
+
+        $mgr->respond(li => $li);
+        $li_cache{$lid->lineitem} = $li;
+    }
+
+    return undef;
+}
+
+sub handle_changed_lid {
+    my($e, $lid, $dry_run, $fund_cache) = @_;
+
+    my $orig_lid = $e->retrieve_acq_lineitem_detail($lid->id) or return $e->die_event;
+
+    # updating the fund, so update the debit
+    if($orig_lid->fund_debit and $orig_lid->fund != $lid->fund) {
+
+        my $debit = $e->retrieve_acq_fund_debit($orig_lid->fund_debit);
+        my $new_fund = $$fund_cache{$lid->fund} = 
+            $$fund_cache{$lid->fund} || $e->retrieve_acq_fund($lid->fund);
+
+        # check the thresholds
+        return $e->die_event if
+            fund_exceeds_balance_percent($new_fund, $debit->amount, $e, "stop");
+        return $e->die_event if $dry_run and 
+            fund_exceeds_balance_percent($new_fund, $debit->amount, $e, "warning");
+
+        $debit->fund($new_fund->id);
+        $e->update_acq_fund_debit($debit) or return $e->die_event;
+    }
+
+    $e->update_acq_lineitem_detail($lid) or return $e->die_event;
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+    method   => 'receive_po_api',
+    api_name => 'open-ils.acq.purchase_order.receive'
+);
+
+sub receive_po_api {
+    my($self, $conn, $auth, $po_id) = @_;
+    my $e = new_editor(xact => 1, authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+
+    my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
+    return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
+
+    my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
+
+    for my $li_id (@$li_ids) {
+        receive_lineitem($mgr, $li_id) or return $e->die_event;
+        $mgr->respond;
+    }
+
+    $po->state('received');
+    update_purchase_order($mgr, $po) or return $e->die_event;
+
+    $e->commit;
+    return $mgr->respond_complete;
+}
+
+
+# At the moment there's a lack of parallelism between the receive and unreceive
+# API methods for POs and the API methods for LIs and LIDs.  The methods for
+# POs stream back objects as they act, whereas the methods for LIs and LIDs
+# atomically return an object that describes only what changed (in LIs and LIDs
+# themselves or in the objects to which to LIs and LIDs belong).
+#
+# The methods for LIs and LIDs work the way they do to faciliate the UI's
+# maintaining correct information about the state of these things when a user
+# wants to receive or unreceive these objects without refreshing their whole
+# display.  The UI feature for receiving and un-receiving a whole PO just
+# refreshes the whole display, so this absence of parallelism in the UI is also
+# relected in this module.
+#
+# This could be neatened in the future by making POs receive and unreceive in
+# the same way the LIs and LIDs do.
+
+__PACKAGE__->register_method(
+	method => 'receive_lineitem_detail_api',
+	api_name	=> 'open-ils.acq.lineitem_detail.receive',
+	signature => {
+        desc => 'Mark a lineitem_detail as received',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'lineitem detail ID', type => 'number'}
+        ],
+        return => {desc =>
+            "on success, object describing changes to LID and possibly " .
+            "to LI and PO; on error, Event"
+        }
+    }
+);
+
+sub receive_lineitem_detail_api {
+    my($self, $conn, $auth, $lid_id) = @_;
+
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+
+    my $fleshing = {
+        "flesh" => 2, "flesh_fields" => {
+            "acqlid" => ["lineitem"], "jub" => ["purchase_order"]
+        }
+    };
+
+    my $lid = $e->retrieve_acq_lineitem_detail([$lid_id, $fleshing]);
+
+    return $e->die_event unless $e->allowed(
+        'RECEIVE_PURCHASE_ORDER', $lid->lineitem->purchase_order->ordering_agency);
+
+    # update ...
+    my $recvd = receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
+
+    # .. and re-retrieve
+    $lid = $e->retrieve_acq_lineitem_detail([$lid_id, $fleshing]);
+
+    # Now build result data structure.
+    my $result = {"lid" => {$lid->id => {"recv_time" => $lid->recv_time}}};
+
+    if (ref $recvd) {
+        if ($recvd->class_name =~ /::purchase_order/) {
+            $result->{"po"} = describe_affected_po($e, $recvd);
+            $result->{"li"} = {
+                $lid->lineitem->id => {"state" => $lid->lineitem->state}
+            };
+        } elsif ($recvd->class_name =~ /::lineitem/) {
+            $result->{"li"} = {$recvd->id => {"state" => $recvd->state}};
+        }
+    }
+    $result->{"po"} ||=
+        describe_affected_po($e, $lid->lineitem->purchase_order);
+
+    $e->commit;
+    return $result;
+}
+
+__PACKAGE__->register_method(
+	method => 'receive_lineitem_api',
+	api_name	=> 'open-ils.acq.lineitem.receive',
+	signature => {
+        desc => 'Mark a lineitem as received',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'lineitem ID', type => 'number'}
+        ],
+        return => {desc =>
+            "on success, object describing changes to LI and possibly PO; " .
+            "on error, Event"
+        }
+    }
+);
+
+sub receive_lineitem_api {
+    my($self, $conn, $auth, $li_id) = @_;
+
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+
+    my $li = $e->retrieve_acq_lineitem([
+        $li_id, {
+            flesh => 1,
+            flesh_fields => {
+                jub => ['purchase_order']
+            }
+        }
+    ]) or return $e->die_event;
+
+    return $e->die_event unless $e->allowed(
+        'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);
+
+    my $res = receive_lineitem($mgr, $li_id) or return $e->die_event;
+    $e->commit;
+    $conn->respond_complete($res);
+    $mgr->run_post_response_hooks;
+}
+
+
+__PACKAGE__->register_method(
+    method   => 'rollback_receive_po_api',
+    api_name => 'open-ils.acq.purchase_order.receive.rollback'
+);
+
+sub rollback_receive_po_api {
+    my($self, $conn, $auth, $po_id) = @_;
+    my $e = new_editor(xact => 1, authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+
+    my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
+    return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
+
+    my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
+
+    for my $li_id (@$li_ids) {
+        rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
+        $mgr->respond;
+    }
+
+    $po->state('on-order');
+    update_purchase_order($mgr, $po) or return $e->die_event;
+
+    $e->commit;
+    return $mgr->respond_complete;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'rollback_receive_lineitem_detail_api',
+    api_name  => 'open-ils.acq.lineitem_detail.receive.rollback',
+    signature => {
+        desc   => 'Mark a lineitem_detail as Un-received',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'lineitem detail ID', type => 'number'}
+        ],
+        return => {desc =>
+            "on success, object describing changes to LID and possibly " .
+            "to LI and PO; on error, Event"
+        }
+    }
+);
+
+sub rollback_receive_lineitem_detail_api {
+    my($self, $conn, $auth, $lid_id) = @_;
+
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+
+    my $lid = $e->retrieve_acq_lineitem_detail([
+        $lid_id, {
+            flesh => 2,
+            flesh_fields => {
+                acqlid => ['lineitem'],
+                jub => ['purchase_order']
+            }
+        }
+    ]);
+    my $li = $lid->lineitem;
+    my $po = $li->purchase_order;
+
+    return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
+
+    my $result = {};
+
+    my $recvd = rollback_receive_lineitem_detail($mgr, $lid_id)
+        or return $e->die_event;
+
+    if (ref $recvd) {
+        $result->{"lid"} = {$recvd->id => {"recv_time" => $recvd->recv_time}};
+    } else {
+        $result->{"lid"} = {$lid->id => {"recv_time" => $lid->recv_time}};
+    }
+
+    if ($li->state eq "received") {
+        $li->state("on-order");
+        $li = update_lineitem($mgr, $li) or return $e->die_event;
+        $result->{"li"} = {$li->id => {"state" => $li->state}};
+    }
+
+    if ($po->state eq "received") {
+        $po->state("on-order");
+        $po = update_purchase_order($mgr, $po) or return $e->die_event;
+    }
+    $result->{"po"} = describe_affected_po($e, $po);
+
+    $e->commit and return $result or return $e->die_event;
+}
+
+__PACKAGE__->register_method(
+    method    => 'rollback_receive_lineitem_api',
+    api_name  => 'open-ils.acq.lineitem.receive.rollback',
+    signature => {
+        desc   => 'Mark a lineitem as Un-received',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'lineitem ID',          type => 'number'}
+        ],
+        return => {desc =>
+            "on success, object describing changes to LI and possibly PO; " .
+            "on error, Event"
+        }
+    }
+);
+
+sub rollback_receive_lineitem_api {
+    my($self, $conn, $auth, $li_id) = @_;
+
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+
+    my $li = $e->retrieve_acq_lineitem([
+        $li_id, {
+            "flesh" => 1, "flesh_fields" => {"jub" => ["purchase_order"]}
+        }
+    ]);
+    my $po = $li->purchase_order;
+
+    return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
+
+    $li = rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
+
+    my $result = {"li" => {$li->id => {"state" => $li->state}}};
+    if ($po->state eq "received") {
+        $po->state("on-order");
+        $po = update_purchase_order($mgr, $po) or return $e->die_event;
+    }
+    $result->{"po"} = describe_affected_po($e, $po);
+
+    $e->commit and return $result or return $e->die_event;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'set_lineitem_price_api',
+    api_name  => 'open-ils.acq.lineitem.price.set',
+    signature => {
+        desc   => 'Set lineitem price.  If debits already exist, update them as well',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'lineitem ID',          type => 'number'}
+        ],
+        return => {desc => 'status blob, Event on error'}
+    }
+);
+
+sub set_lineitem_price_api {
+    my($self, $conn, $auth, $li_id, $price) = @_;
+
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+
+    my ($li, $evt) = fetch_and_check_li($e, $li_id, 'write');
+    return $evt if $evt;
+
+    $li->estimated_unit_price($price);
+    update_lineitem($mgr, $li) or return $e->die_event;
+
+    my $lid_ids = $e->search_acq_lineitem_detail(
+        {lineitem => $li_id, fund_debit => {'!=' => undef}}, 
+        {idlist => 1}
+    );
+
+    for my $lid_id (@$lid_ids) {
+
+        my $lid = $e->retrieve_acq_lineitem_detail([
+            $lid_id, {
+            flesh => 1, flesh_fields => {acqlid => ['fund', 'fund_debit']}}
+        ]);
+
+        $lid->fund_debit->amount($price);
+        $e->update_acq_fund_debit($lid->fund_debit) or return $e->die_event;
+        $mgr->add_lid;
+        $mgr->respond;
+    }
+
+    $e->commit;
+    return $mgr->respond_complete;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'clone_picklist_api',
+    api_name  => 'open-ils.acq.picklist.clone',
+    signature => {
+        desc   => 'Clones a picklist, including lineitem and lineitem details',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Picklist ID', type => 'number'},
+            {desc => 'New Picklist Name', type => 'string'}
+        ],
+        return => {desc => 'status blob, Event on error'}
+    }
+);
+
+sub clone_picklist_api {
+    my($self, $conn, $auth, $pl_id, $name) = @_;
+
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+
+    my $old_pl = $e->retrieve_acq_picklist($pl_id);
+    my $new_pl = create_picklist($mgr, %{$old_pl->to_bare_hash}, name => $name) or return $e->die_event;
+
+    my $li_ids = $e->search_acq_lineitem({picklist => $pl_id}, {idlist => 1});
+
+    for my $li_id (@$li_ids) {
+
+        # copy the lineitems
+        my $li = $e->retrieve_acq_lineitem($li_id);
+        my $new_li = create_lineitem($mgr, %{$li->to_bare_hash}, picklist => $new_pl->id) or return $e->die_event;
+
+        my $lid_ids = $e->search_acq_lineitem_detail({lineitem => $li_id}, {idlist => 1});
+        for my $lid_id (@$lid_ids) {
+
+            # copy the lineitem details
+            my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
+            create_lineitem_detail($mgr, %{$lid->to_bare_hash}, lineitem => $new_li->id) or return $e->die_event;
+        }
+
+        $mgr->respond;
+    }
+
+    $e->commit;
+    return $mgr->respond_complete;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'merge_picklist_api',
+    api_name  => 'open-ils.acq.picklist.merge',
+    signature => {
+        desc   => 'Merges 2 or more picklists into a single list',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Lead Picklist ID', type => 'number'},
+            {desc => 'List of subordinate picklist IDs', type => 'array'}
+        ],
+        return => {desc => 'status blob, Event on error'}
+    }
+);
+
+sub merge_picklist_api {
+    my($self, $conn, $auth, $lead_pl, $pl_list) = @_;
+
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+
+    # XXX perms on each picklist modified
+
+    $lead_pl = $e->retrieve_acq_picklist($lead_pl) or return $e->die_event;
+    # point all of the lineitems at the lead picklist
+    my $li_ids = $e->search_acq_lineitem({picklist => $pl_list}, {idlist => 1});
+
+    for my $li_id (@$li_ids) {
+        my $li = $e->retrieve_acq_lineitem($li_id);
+        $li->picklist($lead_pl);
+        update_lineitem($mgr, $li) or return $e->die_event;
+        $mgr->respond;
+    }
+
+    # now delete the subordinate lists
+    for my $pl_id (@$pl_list) {
+        my $pl = $e->retrieve_acq_picklist($pl_id);
+        $e->delete_acq_picklist($pl) or return $e->die_event;
+    }
+
+    update_picklist($mgr, $lead_pl) or return $e->die_event;
+
+    $e->commit;
+    return $mgr->respond_complete;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'delete_picklist_api',
+    api_name  => 'open-ils.acq.picklist.delete',
+    signature => {
+        desc   => q/Deletes a picklist.  It also deletes any lineitems in the "new" state. / .
+                  q/Other attached lineitems are detached/,
+        params => [
+            {desc => 'Authentication token',  type => 'string'},
+            {desc => 'Picklist ID to delete', type => 'number'}
+        ],
+        return => {desc => '1 on success, Event on error'}
+    }
+);
+
+sub delete_picklist_api {
+    my($self, $conn, $auth, $picklist_id) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+    my $pl = $e->retrieve_acq_picklist($picklist_id) or return $e->die_event;
+    delete_picklist($mgr, $pl) or return $e->die_event;
+    $e->commit;
+    return $mgr->respond_complete;
+}
+
+
+
+__PACKAGE__->register_method(
+    method   => 'activate_purchase_order',
+    api_name => 'open-ils.acq.purchase_order.activate.dry_run'
+);
+
+__PACKAGE__->register_method(
+    method    => 'activate_purchase_order',
+    api_name  => 'open-ils.acq.purchase_order.activate',
+    signature => {
+        desc => q/Activates a purchase order.  This updates the status of the PO / .
+                q/and Lineitems to 'on-order'.  Activated PO's are ready for EDI delivery if appropriate./,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Purchase ID', type => 'number'}
+        ],
+        return => {desc => '1 on success, Event on error'}
+    }
+);
+
+sub activate_purchase_order {
+    my($self, $conn, $auth, $po_id) = @_;
+
+    my $dry_run = ($self->api_name =~ /\.dry_run/) ? 1 : 0;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
+    my $die_event = activate_purchase_order_impl($mgr, $po_id, $dry_run);
+    return $e->die_event if $die_event;
+    if ($dry_run) {
+        $e->rollback;
+    } else {
+        $e->commit;
+    }
+    $conn->respond_complete(1);
+    $mgr->run_post_response_hooks;
+    return undef;
+}
+
+sub activate_purchase_order_impl {
+    my ($mgr, $po_id, $dry_run) = @_;
+    my $e = $mgr->editor;
+
+    my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
+    return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
+
+    my $provider = $e->retrieve_acq_provider($po->provider);
+
+    $po->state('on-order');
+    $po->order_date('now');
+    update_purchase_order($mgr, $po) or return $e->die_event;
+
+    my $query = [
+        {
+            purchase_order => $po_id, 
+            state => [qw/pending-order new order-ready/]
+        },
+        {limit => 1}
+    ];
+
+    while( my $li_id = $e->search_acq_lineitem($query, {idlist => 1})->[0] ) {
+
+        my $li;
+        if($dry_run) {
+            $li = $e->retrieve_acq_lineitem($li_id);
+        } else {
+            # can't activate a PO w/o assets.  Create lineitem assets as necessary
+            my $data = create_lineitem_assets($mgr, $li_id) or return $e->die_event;
+            $li = $data->{li};
+        }
+
+        $li->state('on-order');
+        $li->claim_policy($provider->default_claim_policy)
+            if $provider->default_claim_policy and !$li->claim_policy;
+        create_lineitem_debits($mgr, $li, $dry_run) or return $e->die_event;
+        update_lineitem($mgr, $li) or return $e->die_event;
+        $mgr->post_process( sub { create_lineitem_status_events($mgr, $li->id, 'aur.ordered'); });
+        $mgr->respond;
+    }
+
+    for my $po_item (@{$e->search_acq_po_item({purchase_order => $po_id})}) {
+
+        my $debit = create_fund_debit(
+            $mgr, 
+            $dry_run, 
+            debit_type => 'direct_charge', # to match invoicing
+            origin_amount => $po_item->estimated_cost,
+            origin_currency_type => $e->retrieve_acq_fund($po_item->fund)->currency_type,
+            amount => $po_item->estimated_cost,
+            fund => $po_item->fund
+        ) or return $e->die_event;
+        $po_item->fund_debit($debit->id);
+        $e->update_acq_po_item($po_item) or return $e->die_event;
+        $mgr->respond;
+    }
+
+    # tell the world we activated a PO
+    $U->create_events_for_hook('acqpo.activated', $po, $po->ordering_agency) unless $dry_run;
+
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'split_purchase_order_by_lineitems',
+    api_name  => 'open-ils.acq.purchase_order.split_by_lineitems',
+    signature => {
+        desc   => q/Splits a PO into many POs, 1 per lineitem.  Only works for / .
+                  q/POs a) with more than one lineitems, and b) in the "pending" state./,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Purchase order ID',    type => 'number'}
+        ],
+        return => {desc => 'list of new PO IDs on success, Event on error'}
+    }
+);
+
+sub split_purchase_order_by_lineitems {
+    my ($self, $conn, $auth, $po_id) = @_;
+
+    my $e = new_editor("xact" => 1, "authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $po = $e->retrieve_acq_purchase_order([
+        $po_id, {
+            "flesh" => 1,
+            "flesh_fields" => {"acqpo" => [qw/lineitems notes/]}
+        }
+    ]) or return $e->die_event;
+
+    return $e->die_event
+        unless $e->allowed("CREATE_PURCHASE_ORDER", $po->ordering_agency);
+
+    unless ($po->state eq "pending") {
+        $e->rollback;
+        return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_LATE");
+    }
+
+    unless (@{$po->lineitems} > 1) {
+        $e->rollback;
+        return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_SHORT");
+    }
+
+    # To split an existing PO into many, it seems unwise to just delete the
+    # original PO, so we'll instead detach all of the original POs' lineitems
+    # but the first, then create new POs for each of the remaining LIs, and
+    # then attach the LIs to their new POs.
+
+    my @po_ids = ($po->id);
+    my @moving_li = @{$po->lineitems};
+    shift @moving_li;    # discard first LI
+
+    foreach my $li (@moving_li) {
+        my $new_po = $po->clone;
+        $new_po->clear_id;
+        $new_po->clear_name;
+        $new_po->creator($e->requestor->id);
+        $new_po->editor($e->requestor->id);
+        $new_po->owner($e->requestor->id);
+        $new_po->edit_time("now");
+        $new_po->create_time("now");
+
+        $new_po = $e->create_acq_purchase_order($new_po);
+
+        # Clone any notes attached to the old PO and attach to the new one.
+        foreach my $note (@{$po->notes}) {
+            my $new_note = $note->clone;
+            $new_note->clear_id;
+            $new_note->edit_time("now");
+            $new_note->purchase_order($new_po->id);
+            $e->create_acq_po_note($new_note);
+        }
+
+        $li->edit_time("now");
+        $li->purchase_order($new_po->id);
+        $e->update_acq_lineitem($li);
+
+        push @po_ids, $new_po->id;
+    }
+
+    $po->edit_time("now");
+    $e->update_acq_purchase_order($po);
+
+    return \@po_ids if $e->commit;
+    return $e->die_event;
+}
+
+
+sub not_cancelable {
+    my $o = shift;
+    (ref $o eq "HASH" and $o->{"textcode"} eq "ACQ_NOT_CANCELABLE");
+}
+
+__PACKAGE__->register_method(
+	method => "cancel_purchase_order_api",
+	api_name	=> "open-ils.acq.purchase_order.cancel",
+	signature => {
+        desc => q/Cancels an on-order purchase order/,
+        params => [
+            {desc => "Authentication token", type => "string"},
+            {desc => "PO ID to cancel", type => "number"},
+            {desc => "Cancel reason ID", type => "number"}
+        ],
+        return => {desc => q/Object describing changed POs, LIs and LIDs
+            on success; Event on error./}
+    }
+);
+
+sub cancel_purchase_order_api {
+    my ($self, $conn, $auth, $po_id, $cancel_reason) = @_;
+
+    my $e = new_editor("xact" => 1, "authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = new OpenILS::Application::Acq::BatchManager(
+        "editor" => $e, "conn" => $conn
+    );
+
+    $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or
+        return new OpenILS::Event(
+            "BAD_PARAMS", "note" => "Provide cancel reason ID"
+        );
+
+    my $result = cancel_purchase_order($mgr, $po_id, $cancel_reason) or
+        return $e->die_event;
+    if (not_cancelable($result)) { # event not from CStoreEditor
+        $e->rollback;
+        return $result;
+    } elsif ($result == -1) {
+        $e->rollback;
+        return new OpenILS::Event("ACQ_ALREADY_CANCELED");
+    }
+
+    $e->commit or return $e->die_event;
+
+    # XXX create purchase order status events?
+
+    if ($mgr->{post_commit}) {
+        foreach my $func (@{$mgr->{post_commit}}) {
+            $func->();
+        }
+    }
+
+    return $result;
+}
+
+sub cancel_purchase_order {
+    my ($mgr, $po_id, $cancel_reason) = @_;
+
+    my $po = $mgr->editor->retrieve_acq_purchase_order($po_id) or return 0;
+
+    # XXX is "cancelled" a typo?  It's not correct US spelling, anyway.
+    # Depending on context, this may not warrant an event.
+    return -1 if $po->state eq "cancelled";
+
+    # But this always does.
+    return new OpenILS::Event(
+        "ACQ_NOT_CANCELABLE", "note" => "purchase_order $po_id"
+    ) unless ($po->state eq "on-order" or $po->state eq "pending");
+
+    return 0 unless
+        $mgr->editor->allowed("CREATE_PURCHASE_ORDER", $po->ordering_agency);
+
+    $po->state("cancelled");
+    $po->cancel_reason($cancel_reason->id);
+
+    my $li_ids = $mgr->editor->search_acq_lineitem(
+        {"purchase_order" => $po_id}, {"idlist" => 1}
+    );
+
+    my $result = {"li" => {}, "lid" => {}};
+    foreach my $li_id (@$li_ids) {
+        my $li_result = cancel_lineitem($mgr, $li_id, $cancel_reason)
+            or return 0;
+
+        next if $li_result == -1; # already canceled:skip.
+        return $li_result if not_cancelable($li_result); # not cancelable:stop.
+
+        # Merge in each LI result (there's only going to be
+        # one per call to cancel_lineitem).
+        my ($k, $v) = each %{$li_result->{"li"}};
+        $result->{"li"}->{$k} = $v;
+
+        # Merge in each LID result (there may be many per call to
+        # cancel_lineitem).
+        while (($k, $v) = each %{$li_result->{"lid"}}) {
+            $result->{"lid"}->{$k} = $v;
+        }
+    }
+
+    # TODO who/what/where/how do we indicate this change for electronic orders?
+    # TODO return changes to encumbered/spent
+    # TODO maybe cascade up from smaller object to container object if last
+    # smaller object in the container has been canceled?
+
+    update_purchase_order($mgr, $po) or return 0;
+    $result->{"po"} = {
+        $po_id => {"state" => $po->state, "cancel_reason" => $cancel_reason}
+    };
+    return $result;
+}
+
+
+__PACKAGE__->register_method(
+	method => "cancel_lineitem_api",
+	api_name	=> "open-ils.acq.lineitem.cancel",
+	signature => {
+        desc => q/Cancels an on-order lineitem/,
+        params => [
+            {desc => "Authentication token", type => "string"},
+            {desc => "Lineitem ID to cancel", type => "number"},
+            {desc => "Cancel reason ID", type => "number"}
+        ],
+        return => {desc => q/Object describing changed LIs and LIDs on success;
+            Event on error./}
+    }
+);
+
+__PACKAGE__->register_method(
+	method => "cancel_lineitem_api",
+	api_name	=> "open-ils.acq.lineitem.cancel.batch",
+	signature => {
+        desc => q/Batched version of open-ils.acq.lineitem.cancel/,
+        return => {desc => q/Object describing changed LIs and LIDs on success;
+            Event on error./}
+    }
+);
+
+sub cancel_lineitem_api {
+    my ($self, $conn, $auth, $li_id, $cancel_reason) = @_;
+
+    my $batched = $self->api_name =~ /\.batch/;
+
+    my $e = new_editor("xact" => 1, "authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = new OpenILS::Application::Acq::BatchManager(
+        "editor" => $e, "conn" => $conn
+    );
+
+    $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or
+        return new OpenILS::Event(
+            "BAD_PARAMS", "note" => "Provide cancel reason ID"
+        );
+
+    my ($result, $maybe_event);
+
+    if ($batched) {
+        $result = {"li" => {}, "lid" => {}};
+        foreach my $one_li_id (@$li_id) {
+            my $one = cancel_lineitem($mgr, $one_li_id, $cancel_reason) or
+                return $e->die_event;
+            if (not_cancelable($one)) {
+                $maybe_event = $one;
+            } elsif ($result == -1) {
+                $maybe_event = new OpenILS::Event("ACQ_ALREADY_CANCELED");
+            } else {
+                my ($k, $v);
+                if ($one->{"li"}) {
+                    while (($k, $v) = each %{$one->{"li"}}) {
+                        $result->{"li"}->{$k} = $v;
+                    }
+                }
+                if ($one->{"lid"}) {
+                    while (($k, $v) = each %{$one->{"lid"}}) {
+                        $result->{"lid"}->{$k} = $v;
+                    }
+                }
+            }
+        }
+    } else {
+        $result = cancel_lineitem($mgr, $li_id, $cancel_reason) or
+            return $e->die_event;
+
+        if (not_cancelable($result)) {
+            $e->rollback;
+            return $result;
+        } elsif ($result == -1) {
+            $e->rollback;
+            return new OpenILS::Event("ACQ_ALREADY_CANCELED");
+        }
+    }
+
+    if ($batched and not scalar keys %{$result->{"li"}}) {
+        $e->rollback;
+        return $maybe_event;
+    } else {
+        $e->commit or return $e->die_event;
+        # create_lineitem_status_events should handle array li_id ok
+        create_lineitem_status_events($mgr, $li_id, "aur.cancelled");
+
+        if ($mgr->{post_commit}) {
+            foreach my $func (@{$mgr->{post_commit}}) {
+                $func->();
+            }
+        }
+
+        return $result;
+    }
+}
+
+sub cancel_lineitem {
+    my ($mgr, $li_id, $cancel_reason) = @_;
+    my $li = $mgr->editor->retrieve_acq_lineitem([
+        $li_id, {flesh => 1, flesh_fields => {jub => ['purchase_order']}}
+    ]) or return 0;
+
+    return 0 unless $mgr->editor->allowed(
+        "CREATE_PURCHASE_ORDER", $li->purchase_order->ordering_agency
+    );
+
+    # Depending on context, this may not warrant an event.
+    return -1 if $li->state eq "cancelled";
+
+    # But this always does.
+    return new OpenILS::Event(
+        "ACQ_NOT_CANCELABLE", "note" => "lineitem $li_id"
+    ) unless (
+        (! $li->purchase_order) or (
+            $li->purchase_order and (
+                $li->state eq "on-order" or $li->state eq "pending-order"
+            )
+        )
+    );
+
+    $li->state("cancelled");
+    $li->cancel_reason($cancel_reason->id);
+
+    my $lids = $mgr->editor->search_acq_lineitem_detail([{
+        "lineitem" => $li_id
+    }, {
+        flesh => 1,
+        flesh_fields => { acqlid => ['eg_copy_id'] }
+    }]);
+
+    my $result = {"lid" => {}};
+    my $copies = [];
+    foreach my $lid (@$lids) {
+        my $lid_result = cancel_lineitem_detail($mgr, $lid->id, $cancel_reason)
+            or return 0;
+
+        # gathering any real copies for deletion
+        if ($lid->eg_copy_id) {
+            $lid->eg_copy_id->isdeleted('t');
+            push @$copies, $lid->eg_copy_id;
+        }
+
+        next if $lid_result == -1; # already canceled: just skip it.
+        return $lid_result if not_cancelable($lid_result); # not cxlable: stop.
+
+        # Merge in each LID result (there's only going to be one per call to
+        # cancel_lineitem_detail).
+        my ($k, $v) = each %{$lid_result->{"lid"}};
+        $result->{"lid"}->{$k} = $v;
+    }
+
+    # Attempt to delete the gathered copies (this will also handle volume deletion and bib deletion)
+    # Delete empty bibs according org unit setting
+    my $force_delete_empty_bib = $U->ou_ancestor_setting_value(
+        $mgr->editor->requestor->ws_ou, 'cat.bib.delete_on_no_copy_via_acq_lineitem_cancel', $mgr->editor);
+    if (scalar(@$copies)>0) {
+        my $override = 1;
+        my $delete_stats = undef;
+        my $retarget_holds = [];
+        my $cat_evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
+            $mgr->editor, $override, undef, $copies, $delete_stats, $retarget_holds,$force_delete_empty_bib);
+
+        if( $cat_evt ) {
+            $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($cat_evt));
+            return new OpenILS::Event(
+                "ACQ_NOT_CANCELABLE", "note" => "lineitem $li_id", "payload" => $cat_evt
+            );
+        }
+
+        # We can't do the following and stay within the same transaction, but that's okay, the hold targeter will pick these up later.
+        #my $ses = OpenSRF::AppSession->create('open-ils.circ');
+        #$ses->request('open-ils.circ.hold.reset.batch', $auth, $retarget_holds);
+    }
+
+    # if we have a bib, check to see whether it has been deleted.  if so, cancel any active holds targeting that bib
+    if ($li->eg_bib_id) {
+        my $bib = $mgr->editor->retrieve_biblio_record_entry($li->eg_bib_id) or return new OpenILS::Event(
+            "ACQ_NOT_CANCELABLE", "note" => "Could not retrieve bib " . $li->eg_bib_id . " for lineitem $li_id"
+        );
+        if ($U->is_true($bib->deleted)) {
+            my $holds = $mgr->editor->search_action_hold_request(
+                {   cancel_time => undef,
+                    fulfillment_time => undef,
+                    target => $li->eg_bib_id
+                }
+            );
+
+            my %cached_usr_home_ou = ();
+
+            for my $hold (@$holds) {
+
+                $logger->info("Cancelling hold ".$hold->id.
+                    " due to acq lineitem cancellation.");
+
+                $hold->cancel_time('now');
+                $hold->cancel_cause(5); # 'Staff forced'--we may want a new hold cancel cause reason for this
+                $hold->cancel_note('Corresponding Acquistion Lineitem/Purchase Order was cancelled.');
+                unless($mgr->editor->update_action_hold_request($hold)) {
+                    my $evt = $mgr->editor->event;
+                    $logger->error("Error updating hold ". $evt->textcode .":". $evt->desc .":". $evt->stacktrace);
+                    return new OpenILS::Event(
+                        "ACQ_NOT_CANCELABLE", "note" => "Could not cancel hold " . $hold->id . " for lineitem $li_id", "payload" => $evt
+                    );
+                }
+                if (! defined $mgr->{post_commit}) { # we need a mechanism for creating trigger events, but only if the transaction gets committed
+                    $mgr->{post_commit} = [];
+                }
+                push @{ $mgr->{post_commit} }, sub {
+                    my $home_ou = $cached_usr_home_ou{$hold->usr};
+                    if (! $home_ou) {
+                        my $user = $mgr->editor->retrieve_actor_user($hold->usr); # FIXME: how do we want to handle failures here?
+                        $home_ou = $user->home_ou;
+                        $cached_usr_home_ou{$hold->usr} = $home_ou;
+                    }
+                    $U->create_events_for_hook('hold_request.cancel.cancelled_order', $hold, $home_ou);
+                };
+            }
+        }
+    }
+
+    update_lineitem($mgr, $li) or return 0;
+    $result->{"li"} = {
+        $li_id => {
+            "state" => $li->state,
+            "cancel_reason" => $cancel_reason
+        }
+    };
+    return $result;
+}
+
+
+__PACKAGE__->register_method(
+	method => "cancel_lineitem_detail_api",
+	api_name	=> "open-ils.acq.lineitem_detail.cancel",
+	signature => {
+        desc => q/Cancels an on-order lineitem detail/,
+        params => [
+            {desc => "Authentication token", type => "string"},
+            {desc => "Lineitem detail ID to cancel", type => "number"},
+            {desc => "Cancel reason ID", type => "number"}
+        ],
+        return => {desc => q/Object describing changed LIDs on success;
+            Event on error./}
+    }
+);
+
+sub cancel_lineitem_detail_api {
+    my ($self, $conn, $auth, $lid_id, $cancel_reason) = @_;
+
+    my $e = new_editor("xact" => 1, "authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+    my $mgr = new OpenILS::Application::Acq::BatchManager(
+        "editor" => $e, "conn" => $conn
+    );
+
+    $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or
+        return new OpenILS::Event(
+            "BAD_PARAMS", "note" => "Provide cancel reason ID"
+        );
+
+    my $result = cancel_lineitem_detail($mgr, $lid_id, $cancel_reason) or
+        return $e->die_event;
+
+    if (not_cancelable($result)) {
+        $e->rollback;
+        return $result;
+    } elsif ($result == -1) {
+        $e->rollback;
+        return new OpenILS::Event("ACQ_ALREADY_CANCELED");
+    }
+
+    $e->commit or return $e->die_event;
+
+    # XXX create lineitem detail status events?
+    return $result;
+}
+
+sub cancel_lineitem_detail {
+    my ($mgr, $lid_id, $cancel_reason) = @_;
+    my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
+        $lid_id, {
+            "flesh" => 2,
+            "flesh_fields" => {
+                "acqlid" => ["lineitem"], "jub" => ["purchase_order"]
+            }
+        }
+    ]) or return 0;
+
+    # Depending on context, this may not warrant an event.
+    return -1 if $lid->cancel_reason;
+
+    # But this always does.
+    return new OpenILS::Event(
+        "ACQ_NOT_CANCELABLE", "note" => "lineitem_detail $lid_id"
+    ) unless (
+        (! $lid->lineitem->purchase_order) or
+        (
+            (not $lid->recv_time) and
+            $lid->lineitem and
+            $lid->lineitem->purchase_order and (
+                $lid->lineitem->state eq "on-order" or
+                $lid->lineitem->state eq "pending-order"
+            )
+        )
+    );
+
+    return 0 unless $mgr->editor->allowed(
+        "CREATE_PURCHASE_ORDER",
+        $lid->lineitem->purchase_order->ordering_agency
+    ) or (! $lid->lineitem->purchase_order);
+
+    $lid->cancel_reason($cancel_reason->id);
+
+    unless($U->is_true($cancel_reason->keep_debits)) {
+        my $debit_id = $lid->fund_debit;
+        $lid->clear_fund_debit;
+
+        if($debit_id) {
+            # item is cancelled.  Remove the fund debit.
+            my $debit = $mgr->editor->retrieve_acq_fund_debit($debit_id);
+            if (!$U->is_true($debit->encumbrance)) {
+                $mgr->editor->rollback;
+                return OpenILS::Event->new('ACQ_NOT_CANCELABLE', 
+                    note => "Debit is marked as paid: $debit_id");
+            }
+            $mgr->editor->delete_acq_fund_debit($debit) or return $mgr->editor->die_event;
+        }
+    }
+
+    # XXX LIDs don't have either an editor or a edit_time field. Should we
+    # update these on the LI when we alter an LID?
+    $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
+
+    return {"lid" => {$lid_id => {"cancel_reason" => $cancel_reason}}};
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'user_requests',
+    api_name  => 'open-ils.acq.user_request.retrieve.by_user_id',
+    stream    => 1,
+    signature => {
+        desc   => 'Retrieve fleshed user requests and related data for a given user.',
+        params => [
+            { desc => 'Authentication token',      type => 'string' },
+            { desc => 'User ID of the owner, or array of IDs',      },
+            { desc => 'Options hash (optional) with any of the keys: order_by, limit, offset, state (of the lineitem)',
+              type => 'object'
+            }
+        ],
+        return => {
+            desc => 'Fleshed user requests and related data',
+            type => 'object'
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => 'user_requests',
+    api_name  => 'open-ils.acq.user_request.retrieve.by_home_ou',
+    stream    => 1,
+    signature => {
+        desc   => 'Retrieve fleshed user requests and related data for a given org unit or units.',
+        params => [
+            { desc => 'Authentication token',      type => 'string' },
+            { desc => 'Org unit ID, or array of IDs',               },
+            { desc => 'Options hash (optional) with any of the keys: order_by, limit, offset, state (of the lineitem)',
+              type => 'object'
+            }
+        ],
+        return => {
+            desc => 'Fleshed user requests and related data',
+            type => 'object'
+        }
+    }
+);
+
+sub user_requests {
+    my($self, $conn, $auth, $search_value, $options) = @_;
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+    my $rid = $e->requestor->id;
+    $options ||= {};
+
+    my $query = {
+        "select"=>{"aur"=>["id"],"au"=>["home_ou", {column => 'id', alias => 'usr_id'} ]},
+        "from"=>{ "aur" => { "au" => {}, "jub" => { "type" => "left" } } },
+        "where"=>{
+            "+jub"=> {
+                "-or" => [
+                    {"id"=>undef}, # this with the left-join pulls in requests without lineitems
+                    {"state"=>["new","on-order","pending-order"]} # FIXME - probably needs softcoding
+                ]
+            }
+        },
+        "order_by"=>[{"class"=>"aur", "field"=>"request_date", "direction"=>"desc"}]
+    };
+
+    foreach (qw/ order_by limit offset /) {
+        $query->{$_} = $options->{$_} if defined $options->{$_};
+    }
+    if (defined $options->{'state'}) {
+        $query->{'where'}->{'+jub'}->{'-or'}->[1]->{'state'} = $options->{'state'};        
+    }
+
+    if ($self->api_name =~ /by_user_id/) {
+        $query->{'where'}->{'usr'} = $search_value;
+    } else {
+        $query->{'where'}->{'+au'} = { 'home_ou' => $search_value };
+    }
+
+    my $pertinent_ids = $e->json_query($query);
+
+    my %perm_test = ();
+    for my $id_blob (@$pertinent_ids) {
+        if ($rid != $id_blob->{usr_id}) {
+            if (!defined $perm_test{ $id_blob->{home_ou} }) {
+                $perm_test{ $id_blob->{home_ou} } = $e->allowed( ['user_request.view'], $id_blob->{home_ou} );
+            }
+            if (!$perm_test{ $id_blob->{home_ou} }) {
+                next; # failed test
+            }
+        }
+        my $aur_obj = $e->retrieve_acq_user_request([
+            $id_blob->{id},
+            {flesh => 1, flesh_fields => { "aur" => [ 'lineitem' ] } }
+        ]);
+        if (! $aur_obj) { next; }
+
+        if ($aur_obj->lineitem()) {
+            $aur_obj->lineitem()->clear_marc();
+        }
+        $conn->respond($aur_obj);
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method (
+    method    => 'update_user_request',
+    api_name  => 'open-ils.acq.user_request.cancel.batch',
+    stream    => 1,
+    signature => {
+        desc   => 'If given a cancel reason, will update the request with that reason, otherwise, this will delete the request altogether.  The '    .
+                  'intention is for staff interfaces or processes to provide cancel reasons, and for patron interfaces to just delete the requests.' ,
+        params => [
+            { desc => 'Authentication token',              type => 'string' },
+            { desc => 'ID or array of IDs for the user requests to cancel'  },
+            { desc => 'Cancel Reason ID (optional)',       type => 'string' }
+        ],
+        return => {
+            desc => 'progress object, event on error',
+        }
+    }
+);
+__PACKAGE__->register_method (
+    method    => 'update_user_request',
+    api_name  => 'open-ils.acq.user_request.set_no_hold.batch',
+    stream    => 1,
+    signature => {
+        desc   => 'Remove the hold from a user request or set of requests',
+        params => [
+            { desc => 'Authentication token',              type => 'string' },
+            { desc => 'ID or array of IDs for the user requests to modify'  }
+        ],
+        return => {
+            desc => 'progress object, event on error',
+        }
+    }
+);
+
+sub update_user_request {
+    my($self, $conn, $auth, $aur_ids, $cancel_reason) = @_;
+    my $e = new_editor(xact => 1, authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+    my $rid = $e->requestor->id;
+
+    my $x = 1;
+    my %perm_test = ();
+    for my $id (@$aur_ids) {
+
+        my $aur_obj = $e->retrieve_acq_user_request([
+            $id,
+            {   flesh => 1,
+                flesh_fields => { "aur" => ['lineitem', 'usr'] }
+            }
+        ]) or return $e->die_event;
+
+        my $context_org = $aur_obj->usr()->home_ou();
+        $aur_obj->usr( $aur_obj->usr()->id() );
+
+        if ($rid != $aur_obj->usr) {
+            if (!defined $perm_test{ $context_org }) {
+                $perm_test{ $context_org } = $e->allowed( ['user_request.update'], $context_org );
+            }
+            if (!$perm_test{ $context_org }) {
+                next; # failed test
+            }
+        }
+
+        if($self->api_name =~ /set_no_hold/) {
+            if ($U->is_true($aur_obj->hold)) { 
+                $aur_obj->hold(0); 
+                $e->update_acq_user_request($aur_obj) or return $e->die_event;
+            }
+        }
+
+        if($self->api_name =~ /cancel/) {
+            if ( $cancel_reason ) {
+                $aur_obj->cancel_reason( $cancel_reason );
+                $e->update_acq_user_request($aur_obj) or return $e->die_event;
+                create_user_request_events( $e, [ $aur_obj ], 'aur.rejected' );
+            } else {
+                $e->delete_acq_user_request($aur_obj);
+            }
+        }
+
+        $conn->respond({maximum => scalar(@$aur_ids), progress => $x++});
+    }
+
+    $e->commit;
+    return {complete => 1};
+}
+
+__PACKAGE__->register_method (
+    method    => 'new_user_request',
+    api_name  => 'open-ils.acq.user_request.create',
+    signature => {
+        desc   => 'Create a new user request object in the DB',
+        param  => [
+            { desc => 'Authentication token',   type => 'string' },
+            { desc => 'User request data hash.  Hash keys match the fields for the "aur" object', type => 'object' }
+        ],
+        return => {
+            desc => 'The created user request object, or event on error'
+        }
+    }
+);
+
+sub new_user_request {
+    my($self, $conn, $auth, $form_data) = @_;
+    my $e = new_editor(xact => 1, authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+    my $rid = $e->requestor->id;
+    my $target_user_fleshed;
+    if (! defined $$form_data{'usr'}) {
+        $$form_data{'usr'} = $rid;
+    }
+    if ($$form_data{'usr'} != $rid) {
+        # See if the requestor can place the request on behalf of a different user.
+        $target_user_fleshed = $e->retrieve_actor_user($$form_data{'usr'}) or return $e->die_event;
+        $e->allowed('user_request.create', $target_user_fleshed->home_ou) or return $e->die_event;
+    } else {
+        $target_user_fleshed = $e->requestor;
+        $e->allowed('CREATE_PURCHASE_REQUEST') or return $e->die_event;
+    }
+    if (! defined $$form_data{'pickup_lib'}) {
+        if ($target_user_fleshed->ws_ou) {
+            $$form_data{'pickup_lib'} = $target_user_fleshed->ws_ou;
+        } else {
+            $$form_data{'pickup_lib'} = $target_user_fleshed->home_ou;
+        }
+    }
+    if (! defined $$form_data{'request_type'}) {
+        $$form_data{'request_type'} = 1; # Books
+    }
+    my $aur_obj = new Fieldmapper::acq::user_request; 
+    $aur_obj->isnew(1);
+    $aur_obj->usr( $$form_data{'usr'} );
+    $aur_obj->request_date( 'now' );
+    for my $field ( keys %$form_data ) {
+        if (defined $$form_data{$field} and $field !~ /^(id|lineitem|eg_bib|request_date|cancel_reason)$/) {
+            $aur_obj->$field( $$form_data{$field} );
+        }
+    }
+
+    $aur_obj = $e->create_acq_user_request($aur_obj) or return $e->die_event;
+
+    $e->commit and create_user_request_events( $e, [ $aur_obj ], 'aur.created' );
+
+    return $aur_obj;
+}
+
+sub create_user_request_events {
+    my($e, $user_reqs, $hook) = @_;
+
+    my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+    $ses->connect;
+
+    my %cached_usr_home_ou = ();
+    for my $user_req (@$user_reqs) {
+        my $home_ou = $cached_usr_home_ou{$user_req->usr};
+        if (! $home_ou) {
+            my $user = $e->retrieve_actor_user($user_req->usr) or return $e->die_event;
+            $home_ou = $user->home_ou;
+            $cached_usr_home_ou{$user_req->usr} = $home_ou;
+        }
+        my $req = $ses->request('open-ils.trigger.event.autocreate', $hook, $user_req, $home_ou);
+        $req->recv;
+    }
+
+    $ses->disconnect;
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+	method => "po_note_CUD_batch",
+	api_name => "open-ils.acq.po_note.cud.batch",
+    stream => 1,
+	signature => {
+        desc => q/Manage purchase order notes/,
+        params => [
+            {desc => "Authentication token", type => "string"},
+            {desc => "List of po_notes to manage", type => "array"},
+        ],
+        return => {desc => "Stream of successfully managed objects"}
+    }
+);
+
+sub po_note_CUD_batch {
+    my ($self, $conn, $auth, $notes) = @_;
+
+    my $e = new_editor("xact"=> 1, "authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+    # XXX perms
+
+    my $total = @$notes;
+    my $count = 0;
+
+    foreach my $note (@$notes) {
+
+        $note->editor($e->requestor->id);
+        $note->edit_time("now");
+
+        if ($note->isnew) {
+            $note->creator($e->requestor->id);
+            $note = $e->create_acq_po_note($note) or return $e->die_event;
+        } elsif ($note->isdeleted) {
+            $e->delete_acq_po_note($note) or return $e->die_event;
+        } elsif ($note->ischanged) {
+            $e->update_acq_po_note($note) or return $e->die_event;
+        }
+
+        unless ($note->isdeleted) {
+            $note = $e->retrieve_acq_po_note($note->id) or
+                return $e->die_event;
+        }
+
+        $conn->respond(
+            {"maximum" => $total, "progress" => ++$count, "note" => $note}
+        );
+    }
+
+    $e->commit and $conn->respond_complete or return $e->die_event;
+}
+
+
+# retrieves a lineitem, fleshes its PO and PL, checks perms
+sub fetch_and_check_li {
+    my $e = shift;
+    my $li_id = shift;
+    my $perm_mode = shift || 'read';
+
+    my $li = $e->retrieve_acq_lineitem([
+        $li_id,
+        {   flesh => 1,
+            flesh_fields => {jub => ['purchase_order', 'picklist']}
+        }
+    ]) or return $e->die_event;
+
+    if(my $po = $li->purchase_order) {
+        my $perms = ($perm_mode eq 'read') ? 'VIEW_PURCHASE_ORDER' : 'CREATE_PURCHASE_ORDER';
+        return ($li, $e->die_event) unless $e->allowed($perms, $po->ordering_agency);
+
+    } elsif(my $pl = $li->picklist) {
+        my $perms = ($perm_mode eq 'read') ? 'VIEW_PICKLIST' : 'CREATE_PICKLIST';
+        return ($li, $e->die_event) unless $e->allowed($perms, $pl->org_unit);
+    }
+
+    return ($li);
+}
+
+
+__PACKAGE__->register_method(
+	method => "clone_distrib_form",
+	api_name => "open-ils.acq.distribution_formula.clone",
+    stream => 1,
+	signature => {
+        desc => q/Clone a distribution formula/,
+        params => [
+            {desc => "Authentication token", type => "string"},
+            {desc => "Original formula ID", type => 'integer'},
+            {desc => "Name of new formula", type => 'string'},
+        ],
+        return => {desc => "ID of newly created formula"}
+    }
+);
+
+sub clone_distrib_form {
+    my($self, $client, $auth, $form_id, $new_name) = @_;
+
+    my $e = new_editor("xact"=> 1, "authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $old_form = $e->retrieve_acq_distribution_formula($form_id) or return $e->die_event;
+    return $e->die_event unless $e->allowed('ADMIN_ACQ_DISTRIB_FORMULA', $old_form->owner);
+
+    my $new_form = Fieldmapper::acq::distribution_formula->new;
+
+    $new_form->owner($old_form->owner);
+    $new_form->name($new_name);
+    $e->create_acq_distribution_formula($new_form) or return $e->die_event;
+
+    my $entries = $e->search_acq_distribution_formula_entry({formula => $form_id});
+    for my $entry (@$entries) {
+       my $new_entry = Fieldmapper::acq::distribution_formula_entry->new;
+       $new_entry->$_($entry->$_()) for $entry->real_fields;
+       $new_entry->formula($new_form->id);
+       $new_entry->clear_id;
+       $e->create_acq_distribution_formula_entry($new_entry) or return $e->die_event;
+    }
+
+    $e->commit;
+    return $new_form->id;
+}
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Picklist.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Picklist.pm
new file mode 100644
index 0000000000..3780d933b3
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Picklist.pm
@@ -0,0 +1,558 @@
+package OpenILS::Application::Acq::Picklist;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+use OpenSRF::EX q/:try/;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Const qw/:const/;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Event;
+use OpenILS::Application::AppUtils;
+use OpenSRF::Utils::Cache;
+use MARC::Record;
+use MARC::Batch;
+use MARC::File::XML;
+use MIME::Base64;
+use Digest::MD5 qw/md5_hex/;
+use OpenILS::Application::Acq::Financials;
+use DateTime;
+
+my $U = 'OpenILS::Application::AppUtils';
+
+
+__PACKAGE__->register_method(
+	method => 'create_picklist',
+	api_name	=> 'open-ils.acq.picklist.create',
+	signature => {
+        desc => 'Creates a new picklist',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Picklist object to create', type => 'object'}
+        ],
+        return => {desc => 'The ID of the new picklist'}
+    }
+);
+
+sub create_picklist {
+    my($self, $conn, $auth, $picklist) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    $picklist->creator($e->requestor->id);
+    $picklist->editor($e->requestor->id);
+    $picklist->org_unit($e->requestor->ws_ou) unless $picklist->org_unit;
+    return $e->die_event unless $e->allowed('CREATE_PICKLIST', $picklist->org_unit);
+    return OpenILS::Event->new('BAD_PARAMS')
+        unless $e->requestor->id == $picklist->owner;
+    $e->create_acq_picklist($picklist) or return $e->die_event;
+    $e->commit;
+    return $picklist->id;
+}
+
+
+__PACKAGE__->register_method(
+	method => 'update_picklist',
+	api_name	=> 'open-ils.acq.picklist.update',
+	signature => {
+        desc => 'Updates a new picklist',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Picklist object to update', type => 'object'}
+        ],
+        return => {desc => '1 on success, Event on error'}
+    }
+);
+
+sub update_picklist {
+    my($self, $conn, $auth, $picklist) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+
+    # don't let them change the owner
+    my $o_picklist = $e->retrieve_acq_picklist($picklist->id)
+        or return $e->die_event;
+    if($o_picklist->owner != $e->requestor->id) {
+        return $e->die_event unless 
+            $e->allowed('UPDATE_PICKLIST', $o_picklist->org_unit);
+    }
+    return OpenILS::Event->new('BAD_PARAMS') unless $o_picklist->org_unit == $picklist->org_unit;
+
+    $picklist->edit_time('now');
+    $picklist->editor($e->requestor->id);
+    $e->update_acq_picklist($picklist) or return $e->die_event;
+    $e->commit;
+    return 1;
+}
+
+__PACKAGE__->register_method(
+	method => 'retrieve_picklist',
+	api_name	=> 'open-ils.acq.picklist.retrieve',
+    authoritative => 1,
+	signature => {
+        desc => 'Retrieves a picklist',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Picklist ID to retrieve', type => 'number'},
+            {desc => 'Options hash, including "flesh_lineitem_count" to get the count of attached entries', type => 'hash'},
+        ],
+        return => {desc => 'Picklist object on success, Event on error'}
+    }
+);
+
+sub retrieve_picklist {
+    my($self, $conn, $auth, $picklist_id, $options) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+
+    return retrieve_picklist_impl($e, $picklist_id, $options);
+}
+
+sub retrieve_picklist_impl {
+    my ($e, $picklist_id, $options) = @_;
+    $options ||= {};
+
+    my $picklist = $e->retrieve_acq_picklist($picklist_id)
+        or return $e->event;
+
+    $picklist->entry_count(retrieve_lineitem_count($e, $picklist_id))
+        if $$options{flesh_lineitem_count};
+
+    if($e->requestor->id != $picklist->owner) {
+        return $e->event unless 
+            $e->allowed('VIEW_PICKLIST', $picklist->org_unit, $picklist);
+    }
+
+    $picklist->owner($e->retrieve_actor_user($picklist->owner)) 
+        if($$options{flesh_owner});
+    $picklist->owner($e->retrieve_actor_user($picklist->owner)->usrname) 
+        if($$options{flesh_username});
+
+    return $picklist;
+}
+
+
+# Returns the number of entries associated with this picklist
+sub retrieve_lineitem_count {
+    my($e, $picklist_id) = @_;
+    my $count = $e->json_query({
+        select => { 
+            jub => [{transform => 'count', column => 'id', alias => 'count'}]
+        }, 
+        from => 'jub', 
+        where => {picklist => $picklist_id}}
+    );
+    return $count->[0]->{count};
+}
+
+
+
+__PACKAGE__->register_method(
+	method => 'retrieve_picklist_name',
+	api_name	=> 'open-ils.acq.picklist.name.retrieve',
+    authoritative => 1,
+	signature => {
+        desc => 'Retrieves a picklist by name.  Owner is implied by the caller',
+        params => [
+            {desc => 'Authentication token',      type => 'string'},
+            {desc => 'Picklist name to retrieve', type => 'string'},
+        ],
+        return => {desc => 'Picklist object on success, null on not found'}
+    }
+);
+
+sub retrieve_picklist_name {
+    my($self, $conn, $auth, $name) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    my $picklist = $e->search_acq_picklist(
+        {name => $name, owner => $e->requestor->id})->[0];
+    if($e->requestor->id != $picklist->owner) {
+        return $e->event unless 
+            $e->allowed('VIEW_PICKLIST', $picklist->org_unit, $picklist);
+    }
+    return $picklist;
+}
+
+
+
+__PACKAGE__->register_method(
+	method => 'retrieve_user_picklist',
+	api_name	=> 'open-ils.acq.picklist.user.retrieve',
+    stream => 1,
+	signature => {
+        desc => 'Retrieves a  user\'s picklists',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Options, including "idlist", whch forces the return
+                of a list of IDs instead of objects', type => 'hash'},
+        ],
+        return => {desc => 'Picklist object on success, Event on error'}
+    }
+);
+
+sub retrieve_user_picklist {
+    my($self, $conn, $auth, $options) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    $options ||= {};
+
+    # don't grab the PL with name == "", because that is the designated temporary picklist
+    my $list = $e->search_acq_picklist([
+            {
+                owner => $e->requestor->id, 
+                name => {'!=' => ''}
+            }, {
+                order_by => $$options{order_by} || {acqpl => 'edit_time DESC'},
+                limit => $$options{limit} || 10,
+                offset => $$options{offset} || 0,
+            }
+        ],
+        {idlist=>1}
+    );
+
+    for my $id (@$list) {
+        if($$options{idlist}) {
+            $conn->respond($id);
+        } else {
+            my $pl = $e->retrieve_acq_picklist($id);
+            $pl->entry_count(retrieve_lineitem_count($e, $id)) if $$options{flesh_lineitem_count};
+            $pl->owner($e->retrieve_actor_user($pl->owner)) if $$options{flesh_owner};
+            $pl->owner($e->retrieve_actor_user($pl->owner)->usrname) if $$options{flesh_username};
+            $conn->respond($pl);
+        }
+    }
+
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+	method => 'retrieve_all_user_picklist',
+	api_name	=> 'open-ils.acq.picklist.user.all.retrieve',
+    stream => 1,
+	signature => {
+        desc => 'Retrieves all of the picklists a user is allowed to see',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Options, including "idlist", whch forces the return
+                of a list of IDs instead of objects', type => 'hash'},
+        ],
+        return => {desc => 'Picklist objects on success, Event on error'}
+    }
+);
+
+sub retrieve_all_user_picklist {
+    my($self, $conn, $auth, $options) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+
+    my $my_list = $e->search_acq_picklist(
+        {owner=>$e->requestor->id, name=>{'!='=>''}}, {idlist=>1});
+
+    my $picklist_ids = $e->objects_allowed('VIEW_PICKLIST', 'acqpl');
+    my $p_orgs = $U->user_has_work_perm_at($e, 'VIEW_PICKLIST', {descendants =>1});
+    my $picklist_ids_2 = $e->search_acq_picklist(
+        {name=>{'!='=>''}, org_unit => $p_orgs}, {idlist=>1});
+
+    return undef unless @$my_list or @$picklist_ids or @$picklist_ids_2;
+
+    my @list = (@$my_list, @$picklist_ids, @$picklist_ids_2);
+    my %dedup;
+    $dedup{$_} = 1 for @list;
+    @list = keys %dedup;
+
+    return \@list if $$options{idlist};
+
+    for my $pl (@list) {
+        my $picklist = $e->retrieve_acq_picklist($pl) or return $e->event;
+        $picklist->entry_count(retrieve_lineitem_count($e, $picklist->id))
+            if($$options{flesh_lineitem_count});
+        $picklist->owner($e->retrieve_actor_user($picklist->owner))
+            if $$options{flesh_owner};
+        $picklist->owner($e->retrieve_actor_user($picklist->owner)->usrname)
+            if $$options{flesh_username};
+        $conn->respond($picklist);
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method(
+	method => 'retrieve_pl_lineitem',
+	api_name	=> 'open-ils.acq.lineitem.picklist.retrieve',
+    stream => 1,
+	signature => {
+        desc => 'Retrieves lineitem objects according to picklist',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Picklist ID whose entries to retrieve', type => 'number'},
+            {desc => q/Options, including 
+                "sort_attr", which defines the attribute to sort on; 
+                "sort_attr_type", which defines the attribute type sort on; 
+                "sort_dir", which defines the sort order between "asc" and "desc";
+                "limit", retrieval limit;
+                "offset", retrieval offset;
+                "idlist", return a list of IDs instead of objects
+                "flesh_attrs", additionaly return the list of flattened attributes
+                "clear_marc", discards the raw MARC data to reduce data size
+                "flesh_notes", flesh lineitem notes
+                "flesh_cancel_reason", flesh cancel_reason
+                /, 
+                type => 'hash'}
+        ],
+        return => {desc => 'Array of lineitem objects or IDs,  on success, Event on error'}
+    }
+);
+
+
+my $PL_ENTRY_JSON_QUERY = {
+    select => {jub => ["id"], "acqlia" => ["attr_value"]},
+    "from" => {
+        "jub" => {
+            "acqlia" => {
+                "fkey" => "id", 
+                "field" => "lineitem", 
+                "type" => "left", 
+                "filter" => {
+                    "attr_type" => "lineitem_marc_attr_definition", 
+                    "attr_name" => "author" 
+                }
+            }
+        }
+    }, 
+    "order_by" => {"acqlia" => {"attr_value" => {"direction"=>"asc"}}}, 
+    "limit" => 10,
+    "where" => {"+jub" => {"picklist"=>2}},
+    "offset" => 0
+};
+
+sub retrieve_pl_lineitem {
+    my($self, $conn, $auth, $picklist_id, $options) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+
+    # collect the retrieval options
+    my $sort_attr = $$options{sort_attr} || 'title';
+    my $sort_attr_type = $$options{sort_attr_type} || 'lineitem_marc_attr_definition';
+    my $sort_dir = $$options{sort_dir} || 'asc';
+    my $limit = $$options{limit} || 10;
+    my $offset = $$options{offset} || 0;
+
+    $PL_ENTRY_JSON_QUERY->{where}->{'+jub'}->{picklist} = $picklist_id;
+    $PL_ENTRY_JSON_QUERY->{from}->{jub}->{acqlia}->{filter}->{attr_name} = $sort_attr;
+    $PL_ENTRY_JSON_QUERY->{from}->{jub}->{acqlia}->{filter}->{attr_type} = $sort_attr_type;
+    $PL_ENTRY_JSON_QUERY->{order_by}->{acqlia}->{attr_value}->{direction} = $sort_dir;
+    $PL_ENTRY_JSON_QUERY->{limit} = $limit;
+    $PL_ENTRY_JSON_QUERY->{offset} = $offset;
+
+    my $entries = $e->json_query($PL_ENTRY_JSON_QUERY);
+
+    my @ids;
+    for my $entry (@$entries) {
+        push(@ids, $entry->{id}) unless grep { $_ eq $entry->{id} } @ids;
+    }
+
+    for my $id (@ids) {
+        if($$options{idlist}) {
+            $conn->respond($id);
+            next;
+        } 
+
+        my $entry;
+        my $flesh = {};
+        if($$options{flesh_attrs} or $$options{flesh_notes} or $$options{flesh_cancel_reason}) {
+            $flesh = {flesh => 2, flesh_fields => {jub => []}};
+            if($$options{flesh_notes}) {
+                push(@{$flesh->{flesh_fields}->{jub}}, 'lineitem_notes');
+                $flesh->{flesh_fields}->{acqlin} = ['alert_text'];
+            }
+            push(@{$flesh->{flesh_fields}->{jub}}, 'attributes') if $$options{flesh_attrs};
+            push @{$flesh->{flesh_fields}->{jub}}, 'cancel_reason' if $$options{flesh_cancel_reason};
+        }
+
+        $entry = $e->retrieve_acq_lineitem([$id, $flesh]);
+        my $details = $e->search_acq_lineitem_detail({lineitem => $id}, {idlist=>1});
+        $entry->item_count(scalar(@$details));
+        $entry->clear_marc if $$options{clear_marc};
+        $conn->respond($entry);
+    }
+
+    return undef;
+}
+
+=head comment
+request open-ils.cstore open-ils.cstore.json_query.atomic {"select":{"jub":[{"transform":"count", "attregate":1, "column":"id","alias":"count"}]}, "from":"jub","where":{"picklist":1}}
+=cut
+
+
+
+__PACKAGE__->register_method(
+    method    => "record_distribution_formula_application",
+    api_name  => "open-ils.acq.distribution_formula.record_application",
+    signature => {
+        desc  => "Record the application (which actually happens on the " .
+            "client side) of a distribution formula to a PO or a PL",
+        params => [
+            {desc => "Authentication token", type => "string"},
+            {desc => "Formulae applied", "type" => "array"},
+            {desc => "Lineitem ID", "type" => "number"}
+        ],
+        return => {desc => "acqdfa IDs on success; event on failure"}
+    }
+);
+
+sub record_distribution_formula_application {
+    my ($self, $conn, $auth, $formulae, $li_id) = @_;
+
+    my $e = new_editor("authtoken" => $auth, "xact" => 1);
+    return $e->die_event unless $e->checkauth;
+
+    # We need this to determine relevant OU for testing permissions...
+    my $li = $e->retrieve_acq_lineitem([
+        $li_id, {
+            "flesh" => 1,
+            "flesh_fields" => {"jub" => [qw/purchase_order picklist/]}
+        }
+    ]) or return $e->die_event;
+
+    # ... which we do here.
+    my $ou;
+    if ($li->purchase_order) {
+        $ou = $li->purchase_order->ordering_agency;
+    } elsif ($li->picklist) {
+        $ou = $li->picklist->org_unit;
+    } else {
+        $e->rollback;
+        return new OpenILS::Event("BAD_PARAMS");
+    }
+
+    return $e->die_event unless $e->allowed("CREATE_PURCHASE_ORDER", $ou);
+
+    # Just deal with it if $formulate is a scalar instead of an array.
+    $formulae = [ $formulae ] if not ref $formulae;
+
+    my @results = ();
+    foreach (@{$formulae}) {
+        my $acqdfa = new Fieldmapper::acq::distribution_formula_application;
+
+        $acqdfa->creator($e->requestor->id);
+        $acqdfa->formula($_);
+        $acqdfa->lineitem($li_id);
+
+        $acqdfa = $e->create_acq_distribution_formula_application($acqdfa)
+            or return $e->die_event;
+        push @results, $acqdfa->id;
+    }
+
+    $e->commit or return $e->die_event;
+    \@results;
+}
+
+
+__PACKAGE__->register_method(
+	method => 'ranged_distrib_formulas',
+	api_name	=> 'open-ils.acq.distribution_formula.ranged.retrieve',
+    stream => 1,
+	signature => {
+        desc => 'Ranged distribution formulas, fleshed with entries',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => "offset", type => "number"},
+            {desc => "limit", type => "number"}
+        ],
+        return => {desc => 'List of distribution formulas'}
+    }
+);
+
+sub ranged_distrib_formulas {
+    my ($self, $conn, $auth, $offset, $limit) = @_;
+
+    $offset ||= 0;
+    $limit ||= 10;
+
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    my $orgs = $U->user_has_work_perm_at($e, 'CREATE_PICKLIST', {descendants =>1});
+
+    my $forms = $e->search_acq_distribution_formula([
+        {owner => $orgs},
+        {
+            flesh => 1, 
+            flesh_fields => {acqdf => ['entries']},
+            order_by => {acqdf => "name"},
+            limit => $limit,
+            offset => $offset
+        }
+    ]) or return $e->die_event;
+
+    for (@$forms) {
+
+        # how many times has this DF been used
+        my $count = $e->json_query({
+            select => {acqdfa => [{column => 'formula', aggregate => 1, transform => 'count', alias => 'count'}]}, 
+            from => 'acqdfa', 
+            where => {formula => $_->id}
+        })->[0];
+
+        $_->use_count($count->{count});
+        $conn->respond($_);
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method(
+	method => "ranged_distrib_formula_applications",
+	api_name => "open-ils.acq.distribution_formula_application.ranged.retrieve",
+    stream => 1,
+	signature => {
+        desc => "Ranged distribution formulas applications, fleshed with formulas and users",
+        params => [
+            {desc => "Authentication token", type => "string"},
+            {desc => "Lineitem Id", type => "number"}
+        ],
+        return => {desc => "List of distribution formula applications"}
+    }
+);
+
+sub ranged_distrib_formula_applications {
+    my ($self, $conn, $auth, $li_id) = @_;
+
+    my $e = new_editor("authtoken" => $auth);
+    return $e->event unless $e->checkauth;
+
+    my $li = $e->retrieve_acq_lineitem([
+        $li_id, {
+            "flesh" => 1,
+            "flesh_fields" => {"jub" => [qw/purchase_order picklist/]}
+        }
+    ]) or return $e->die_event;
+
+    if ($li->picklist) {
+        return $e->die_event unless $e->allowed(
+            "VIEW_PICKLIST", $li->picklist->org_unit
+        );
+    } elsif ($li->purchase_order) {
+        return $e->die_event unless $e->allowed(
+            "VIEW_PURCHASE_ORDER", $li->purchase_order->ordering_agency
+        );
+    } else {
+        # For the moment no use cases are forseen for using this
+        # method with LIs that don't belong to a PL or a PO.
+        $e->disconnect;
+        return new OpenILS::Event("BAD_PARAMS", "note" => "Freestanding LI");
+    }
+
+    my $dfa = $e->search_acq_distribution_formula_application([
+        {"lineitem" => $li_id},
+        {"flesh" => 1, "flesh_fields" => {"acqdfa" => [qw/formula creator/]}}
+    ]);
+
+    $conn->respond($_) foreach (@$dfa);
+
+    $e->disconnect;
+    undef;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Provider.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Provider.pm
new file mode 100644
index 0000000000..10d96cbfc5
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Provider.pm
@@ -0,0 +1,189 @@
+package OpenILS::Application::Acq::Provider;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+use OpenILS::Event;
+use OpenILS::Const qw/:const/;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Application::AppUtils;
+
+my $U = 'OpenILS::Application::AppUtils';
+
+__PACKAGE__->register_method(
+	method => 'create_provider',
+	api_name	=> 'open-ils.acq.provider.create',
+	signature => {
+        desc => 'Creates a new provider',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'provider object to create', type => 'object'}
+        ],
+        return => {desc => 'The ID of the new provider'}
+    }
+);
+
+sub create_provider {
+    my($self, $conn, $auth, $provider) = @_;
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('ADMIN_PROVIDER', $provider->owner);
+    $e->create_acq_provider($provider) or return $e->die_event;
+    $e->commit;
+    return $provider->id;
+}
+
+
+
+__PACKAGE__->register_method(
+	method => 'retrieve_provider',
+	api_name	=> 'open-ils.acq.provider.retrieve',
+    authoritative => 1,
+	signature => {
+        desc => 'Retrieves a new provider',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'provider ID', type => 'number'}
+        ],
+        return => {desc => 'The provider object on success, Event on failure'}
+    }
+);
+
+sub retrieve_provider {
+    my($self, $conn, $auth, $provider_id) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    my $provider = $e->retrieve_acq_provider($provider_id) or return $e->event;
+    return $e->event unless $e->allowed(
+        ['ADMIN_PROVIDER', 'MANAGE_PROVIDER', 'VIEW_PROVIDER'], $provider->owner, $provider);
+    return $provider;
+}
+
+
+__PACKAGE__->register_method(
+	method => 'retrieve_org_providers',
+	api_name	=> 'open-ils.acq.provider.org.retrieve',
+    stream => 1,
+	signature => {
+        desc => 'Retrieves all the providers associated with an org unit that the requestor has access to see',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'List of org Unit IDs.  If no IDs are provided, this method returns the 
+                full set of funding sources this user has permission to view', type => 'number'},
+            {desc => q/Limiting permission.  this permission is used find the work-org tree from which  
+                the list of orgs is generated if no org ids are provided.  
+                The default is ADMIN_PROVIDER/, type => 'string'},
+        ],
+        return => {desc => 'The provider objects on success, empty array otherwise'}
+    }
+);
+
+sub retrieve_org_providers {
+    my($self, $conn, $auth, $org_id_list, $options) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+
+    my $limit_perm = ($$options{limit_perm}) ? $$options{limit_perm} : 'ADMIN_PROVIDER';
+
+    return OpenILS::Event->new('BAD_PARAMS')
+        unless $limit_perm =~ /(ADMIN|MANAGE|VIEW)_PROVIDER/;
+
+    my $org_ids = ($org_id_list and @$org_id_list) ? $org_id_list :
+        $U->user_has_work_perm_at($e, $limit_perm, {descendants =>1});
+
+    return [] unless @$org_ids;
+    $conn->respond($_) for @{
+        $e->search_acq_provider([
+            {owner => $org_ids, active => 't'},
+            {order_by => {acqpro => 'code'}}
+        ])
+    };
+
+    return undef;
+}
+
+__PACKAGE__->register_method(
+	method => 'retrieve_provider_attr_def',
+	api_name	=> 'open-ils.acq.lineitem_provider_attr_definition.provider.retrieve',
+    stream => 1,
+	signature => {
+        desc => 'Retrieves all of the lineitem_provider_attr_definition for a given provider',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Provider ID', type => 'number'}
+        ],
+        return => {desc => 'Streams a of lineitem_provider_attr_definition objects'}
+    }
+);
+
+sub retrieve_provider_attr_def {
+    my($self, $conn, $auth, $prov_id) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    my $provider = $e->retrieve_acq_provider($prov_id)
+        or return $e->event;
+    return $e->event unless $e->allowed('ADMIN_PROVIDER', $provider->owner);
+    for my $id (@{$e->search_acq_lineitem_provider_attr_definition({provider=>$prov_id},{idlist=>1})}) {
+        $conn->respond($e->retrieve_acq_lineitem_provider_attr_definition($id));
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method(
+	method => 'create_provider_attr_def',
+	api_name	=> 'open-ils.acq.lineitem_provider_attr_definition.create',
+	signature => {
+        desc => 'Retrieves all of the lineitem_provider_attr_definition for a given provider',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Provider ID', type => 'number'}
+        ],
+        return => {desc => 'Streams a of lineitem_provider_attr_definition objects'}
+    }
+);
+
+sub create_provider_attr_def {
+    my($self, $conn, $auth, $attr_def) = @_;
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+    my $provider = $e->retrieve_acq_provider($attr_def->provider)
+        or return $e->die_event;
+    return $e->die_event unless $e->allowed('ADMIN_PROVIDER', $provider->owner);
+    $e->create_acq_lineitem_provider_attr_definition($attr_def)
+        or return $e->die_event;
+    $e->commit;
+    return $attr_def->id;
+}
+
+__PACKAGE__->register_method(
+	method => 'delete_provider_attr_def',
+	api_name	=> 'open-ils.acq.lineitem_provider_attr_definition.delete',
+	signature => {
+        desc => 'Deletes a lineitem_provider_attr_definition',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'ID', type => 'number'}
+        ],
+        return => {desc => '1 on success, event on failure'}
+    }
+);
+
+sub delete_provider_attr_def {
+    my($self, $conn, $auth, $id) = @_;
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+    my $attr_def = $e->retrieve_acq_lineitem_provider_attr_definition($id)
+        or return $e->die_event;
+    my $provider = $e->retrieve_acq_provider($attr_def->provider)
+        or return $e->die_event;
+    return $e->die_event unless $e->allowed('ADMIN_PROVIDER', $provider->owner);
+    $e->delete_acq_lineitem_provider_attr_definition($attr_def)
+        or return $e->die_event;
+    $e->commit;
+    return 1;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Search.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Search.pm
new file mode 100644
index 0000000000..b6f267c903
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Search.pm
@@ -0,0 +1,616 @@
+package OpenILS::Application::Acq::Search;
+use base "OpenILS::Application";
+
+use strict;
+use warnings;
+
+use OpenSRF::AppSession;
+use OpenSRF::Utils::Logger qw/:logger/;
+use OpenILS::Event;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Application::Acq::Lineitem;
+use OpenILS::Application::Acq::Financials;
+use OpenILS::Application::Acq::Picklist;
+use OpenILS::Application::Acq::Invoice;
+use OpenILS::Application::Acq::Order;
+
+my %RETRIEVERS = (
+    "lineitem" =>
+        \&{"OpenILS::Application::Acq::Lineitem::retrieve_lineitem_impl"},
+    "picklist" =>
+        \&{"OpenILS::Application::Acq::Picklist::retrieve_picklist_impl"},
+    "purchase_order" => \&{
+        "OpenILS::Application::Acq::Financials::retrieve_purchase_order_impl"
+    },
+    "invoice" => \&{
+        "OpenILS::Application::Acq::Invoice::fetch_invoice_impl"
+    },
+);
+
+sub F { $Fieldmapper::fieldmap->{"Fieldmapper::" . $_[0]}; }
+
+# This subroutine returns 1 if the argument is a) a scalar OR
+# b) an array of ONLY scalars. Otherwise it returns 0.
+sub check_1d_max {
+    my ($o) = @_;
+    return 1 unless ref $o;
+    if (ref($o) eq "ARRAY") {
+        foreach (@$o) { return 0 if ref $_; }
+        return 1;
+    }
+    0;
+}
+
+# Returns 1 if and only if argument is an array of exactly two scalars.
+sub could_be_range {
+    my ($o) = @_;
+    if (ref $o eq "ARRAY") {
+        return 1 if (scalar(@$o) == 2 && (!ref $o->[0] && !ref $o->[1]));
+    }
+    0;
+}
+
+sub castdate {
+    my ($value, $gte, $lte) = @_;
+
+    my $op = "=";
+    $op = ">=" if $gte;
+    $op = "<=" if $lte;
+
+    +{$op => {"transform" => "date", "value" => $value}};
+}
+
+sub prepare_acqlia_search_and {
+    my ($acqlia) = @_;
+
+    my @phrases = ();
+    foreach my $unit (@{$acqlia}) {
+        my $subquery = {
+            "select" => {"acqlia" => ["id"]},
+            "from" => "acqlia",
+            "where" => {"-and" => [{"lineitem" => {"=" => {"+jub" => "id"}}}]}
+        };
+
+        # castdate not supported for acqlia fields: they're all type text
+        my ($k, $v, $fuzzy, $between, $not) = breakdown_term($unit);
+        my $point = $subquery->{"where"}->{"-and"};
+        my $term_clause;
+
+        push @$point, {"definition" => $k};
+
+        if ($fuzzy and not ref $v) {
+            push @$point, {"attr_value" => {"ilike" => "%" . $v . "%"}};
+        } elsif ($between and could_be_range($v)) {
+            push @$point, {"attr_value" => {"between" => $v}};
+        } elsif (check_1d_max($v)) {
+            push @$point, {"attr_value" => $v};
+        } else {
+            next;
+        }
+
+        my $operator = $not ? "-not-exists" : "-exists";
+        push @phrases, {$operator => $subquery};
+    }
+    @phrases;
+}
+
+sub prepare_acqlia_search_or {
+    my ($acqlia) = @_;
+
+    my $point = [];
+    my $result = {"+acqlia" => {"-or" => $point}};
+
+    foreach my $unit (@$acqlia) {
+        # castdate not supported for acqlia fields: they're all type text
+        my ($k, $v, $fuzzy, $between, $not) = breakdown_term($unit);
+        my $term_clause;
+        if ($fuzzy and not ref $v) {
+            $term_clause = {
+                "-and" => {
+                    "definition" => $k,
+                    "attr_value" => {"ilike" => "%" . $v . "%"}
+                }
+            };
+        } elsif ($between and could_be_range($v)) {
+            $term_clause = {
+                "-and" => {
+                    "definition" => $k, "attr_value" => {"between" => $v}
+                }
+            };
+        } elsif (check_1d_max($v)) {
+            $term_clause = {
+                "-and" => {"definition" => $k, "attr_value" => $v}
+            };
+        } else {
+            next;
+        }
+
+        push @$point, $not ? {"-not" => $term_clause} : $term_clause;
+    }
+    $result;
+}
+
+sub breakdown_term {
+    my ($term) = @_;
+
+    my $key = (grep { !/^__/ } keys %$term)[0];
+    (
+        $key, $term->{$key},
+        $term->{"__fuzzy"} ? 1 : 0,
+        $term->{"__between"} ? 1 : 0,
+        $term->{"__not"} ? 1 : 0,
+        $term->{"__castdate"} ? 1 : 0,
+        $term->{"__gte"} ? 1 : 0,
+        $term->{"__lte"} ? 1 : 0
+    );
+}
+
+sub get_fm_links_by_hint {
+    my ($hint) = @_;
+    foreach my $field (values %{$Fieldmapper::fieldmap}) {
+        return $field->{"links"} if $field->{"hint"} eq $hint;
+    }
+    undef;
+}
+
+sub gen_au_term {
+    my ($value, $n) = @_;
+    +{
+        "-or" => [
+            {"+au$n" => {"usrname" => $value}},
+            {"+au$n" => {"first_given_name" => $value}},
+            {"+au$n" => {"second_given_name" => $value}},
+            {"+au$n" => {"family_name" => $value}},
+            {"+ac$n" => {"barcode" => $value}}
+        ]
+    };
+}
+
+# go through the terms hash, find keys that correspond to fields links
+# to actor.usr, and rewrite the search as one that searches not by
+# actor.usr.id but by any of these user properties: card barcode, username,
+# given names and family name.
+sub prepare_au_terms {
+    my ($terms, $join_num) = @_;
+
+    my @joins = ();
+    my $nots = 0;
+    $join_num ||= 0;
+
+    foreach my $conj (qw/-and -or/) {
+        next unless exists $terms->{$conj};
+
+        my @new_outer_terms = ();
+        HINT_UNIT: foreach my $hint_unit (@{$terms->{$conj}}) {
+            my $hint = (keys %$hint_unit)[0];
+            (my $plain_hint = $hint) =~ y/+//d;
+            if ($hint eq "-not") {
+                $hint_unit = $hint_unit->{$hint};
+                $nots++;
+                redo HINT_UNIT;
+            }
+
+            if (my $links = get_fm_links_by_hint($plain_hint) and
+                $plain_hint ne "acqlia") {
+                my @new_terms = ();
+                my ($attr, $value) = breakdown_term($hint_unit->{$hint});
+                if ($links->{$attr} and
+                    $links->{$attr}->{"class"} eq "au") {
+                    push @joins, [$plain_hint, $attr, $join_num];
+                    my $au_term = gen_au_term($value, $join_num);
+                    if ($nots > 0) {
+                        $au_term = {"-not" => $au_term};
+                        $nots--;
+                    }
+                    push @new_outer_terms, $au_term;
+                    $join_num++;
+                    delete $hint_unit->{$hint};
+                }
+            }
+            if ($nots > 0) {
+                $hint_unit = {"-not" => $hint_unit};
+                $nots--;
+            }
+            push @new_outer_terms, $hint_unit if scalar keys %$hint_unit;
+        }
+        $terms->{$conj} = [ @new_outer_terms ];
+    }
+    @joins;
+}
+
+sub prepare_terms {
+    my ($terms, $is_and) = @_;
+
+    my $conj = $is_and ? "-and" : "-or";
+    my $outer_clause = {};
+
+    foreach my $class (qw/acqpo acqpl acqinv jub/) {
+        next if not exists $terms->{$class};
+
+        $outer_clause->{$conj} = [] unless $outer_clause->{$conj};
+        foreach my $unit (@{$terms->{$class}}) {
+            my ($k, $v, $fuzzy, $between, $not, $castdate, $gte, $lte) =
+                breakdown_term($unit);
+
+            my $term_clause;
+            if ($fuzzy and not ref $v) {
+                $term_clause = {$k => {"ilike" => "%" . $v . "%"}};
+            } elsif ($between and could_be_range($v)) {
+                $term_clause = {$k => {"between" => $v}};
+            } elsif (check_1d_max($v)) {
+                $v = castdate($v, $gte, $lte) if $castdate;
+                $term_clause = {$k => $v};
+            } else {
+                next;
+            }
+
+            my $clause = {"+" . $class => $term_clause};
+            $clause = {"-not" => $clause} if $not;
+            push @{$outer_clause->{$conj}}, $clause;
+        }
+    }
+
+    if ($terms->{"acqlia"}) {
+        push @{$outer_clause->{$conj}},
+            $is_and ? prepare_acqlia_search_and($terms->{"acqlia"}) :
+                prepare_acqlia_search_or($terms->{"acqlia"});
+    }
+
+    return undef unless scalar keys %$outer_clause;
+    $outer_clause;
+}
+
+sub add_au_joins {
+    my ($from) = shift;
+
+    my $n = 0;
+    foreach my $join (@_) {
+        my ($hint, $attr, $num) = @$join;
+        my $start;
+        if ($hint eq "jub") {
+            $start = $from->{$hint};
+        } elsif ($hint eq "acqinv") {
+            $start = $from->{"jub"}->{"acqie"}->{"join"}->{$hint};
+        } else {
+            $start = $from->{"jub"}->{$hint};
+        }
+        my $clause = {
+            "class" => "au",
+            "type" => "left",
+            "field" => "id",
+            "fkey" => $attr,
+            "join" => {
+                "ac$num" => {
+                    "class" => "ac",
+                    "type" => "left",
+                    "field" => "id",
+                    "fkey" => "card"
+                }
+            }
+        };
+        if ($hint eq "jub") {
+            $start->{"au$num"} = $clause;
+        } else {
+            $start->{"join"} ||= {};
+            $start->{"join"}->{"au$num"} = $clause;
+        }
+        $n++;
+    }
+    $n;
+}
+
+__PACKAGE__->register_method(
+    method    => "unified_search",
+    api_name  => "open-ils.acq.lineitem.unified_search",
+    stream    => 1,
+    signature => {
+        desc   => q/Returns lineitems based on flexible search terms./,
+        params => [
+            {desc => "Authentication token", type => "string"},
+            {desc => "Field/value pairs for AND'ing", type => "object"},
+            {desc => "Field/value pairs for OR'ing", type => "object"},
+            {desc => "Conjunction between AND pairs and OR pairs " .
+                "(can be 'and' or 'or')", type => "string"},
+            {desc => "Retrieval options (clear_marc, flesh_notes, etc) " .
+                "- XXX detail all the options",
+                type => "object"}
+        ],
+        return => {desc => "A stream of LIs on success, Event on failure"}
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "unified_search",
+    api_name  => "open-ils.acq.purchase_order.unified_search",
+    stream    => 1,
+    signature => {
+        desc   => q/Returns purchase orders based on flexible search terms.
+            See open-ils.acq.lineitem.unified_search/,
+        return => {desc => "A stream of POs on success, Event on failure"}
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "unified_search",
+    api_name  => "open-ils.acq.picklist.unified_search",
+    stream    => 1,
+    signature => {
+        desc   => q/Returns pick lists based on flexible search terms.
+            See open-ils.acq.lineitem.unified_search/,
+        return => {desc => "A stream of PLs on success, Event on failure"}
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "unified_search",
+    api_name  => "open-ils.acq.invoice.unified_search",
+    stream    => 1,
+    signature => {
+        desc   => q/Returns invoices lists based on flexible search terms.
+            See open-ils.acq.lineitem.unified_search/,
+        return => {desc => "A stream of invoices on success, Event on failure"}
+    }
+);
+
+sub unified_search {
+    my ($self, $conn, $auth, $and_terms, $or_terms, $conj, $options) = @_;
+    $options ||= {};
+
+    my $e = new_editor("authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    # What kind of object are we returning? Important: (\w+) had better be
+    # a legit acq classname particle, so don't register any crazy api_names.
+    my $ret_type = ($self->api_name =~ /cq.(\w+).un/)[0];
+    my $retriever = $RETRIEVERS{$ret_type};
+    my $hint = F("acq::$ret_type")->{"hint"};
+
+    my $select_clause = {
+        $hint => [{"column" => "id", "transform" => "distinct"}]
+    };
+
+    if ($options->{"order_by"}) {
+        # What's the point of this block?  When using ORDER BY in conjuction
+        # with SELECT DISTINCT, the fields present in ORDER BY have to also
+        # be in the SELECT clause.  This will take _one_ such field and add
+        # it to the SELECT clause as needed.
+        my ($order_by, $class, $field);
+        unless (
+            ($order_by = $options->{"order_by"}->[0]) &&
+            ($class = $order_by->{"class"}) =~ /^[\da-z_]+$/ &&
+            ($field = $order_by->{"field"}) =~ /^[\da-z_]+$/
+        ) {
+            $e->disconnect;
+            return new OpenILS::Event(
+                "BAD_PARAMS", "note" =>
+q/order_by clause must be of the long form, like:
+"order_by": [{"class": "foo", "field": "bar", "direction": "asc"}]/
+            );
+        } else {
+            $select_clause->{$class} ||= [];
+            push @{$select_clause->{$class}}, $field;
+        }
+    }
+
+    my $query = {
+        "select" => $select_clause,
+        "from" => {
+            "jub" => {
+                "acqpo" => {
+                    "type" => "full",
+                    "field" => "id",
+                    "fkey" => "purchase_order"
+                },
+                "acqpl" => {
+                    "type" => "full",
+                    "field" => "id",
+                    "fkey" => "picklist"
+                },
+                "acqie" => {
+                    "type" => "full",
+                    "field" => "lineitem",
+                    "fkey" => "id",
+                    "join" => {
+                        "acqinv" => {
+                            "type" => "full",
+                            "fkey" => "invoice",
+                            "field" => "id"
+                        }
+                    }
+                }
+            }
+        },
+        "order_by" => ($options->{"order_by"} || {$hint => {"id" => {}}}),
+        "offset" => ($options->{"offset"} || 0)
+    };
+
+    $query->{"limit"} = $options->{"limit"} if $options->{"limit"};
+
+    # XXX for the future? but it doesn't quite work as is.
+#    # Remove anything in temporary picklists from search results.
+#    $and_terms ||= {};
+#    $and_terms->{"acqpl"} ||= [];
+#    push @{$and_terms->{"acqpl"}}, {"name" => "", "__not" => 1};
+
+    $and_terms = prepare_terms($and_terms, 1);
+    $or_terms = prepare_terms($or_terms, 0) and do {
+        $query->{"from"}->{"jub"}->{"acqlia"} = {
+            "type" => "left", "field" => "lineitem", "fkey" => "id",
+        };
+    };
+
+    my $offset = add_au_joins($query->{"from"}, prepare_au_terms($and_terms));
+    add_au_joins($query->{"from"}, prepare_au_terms($or_terms, $offset));
+
+    if ($and_terms and $or_terms) {
+        $query->{"where"} = {
+            "-" . (lc $conj eq "or" ? "or" : "and") => [$and_terms, $or_terms]
+        };
+    } elsif ($and_terms) {
+        $query->{"where"} = $and_terms;
+    } elsif ($or_terms) {
+        $query->{"where"} = $or_terms;
+    } else {
+        $e->disconnect;
+        return new OpenILS::Event("BAD_PARAMS", "desc" => "No usable terms");
+    }
+
+    my $results = $e->json_query($query) or return $e->die_event;
+    my @id_list = map { $_->{"id"} } (grep { $_->{"id"} } @$results);
+
+    if ($options->{"id_list"}) {
+        $conn->respond($_) foreach @id_list;
+    } else {
+        $conn->respond($retriever->($e, $_, $options)) foreach @id_list;
+    }
+
+    $e->disconnect;
+    undef;
+}
+
+__PACKAGE__->register_method(
+    method    => "bib_search",
+    api_name  => "open-ils.acq.biblio.wrapped_search",
+    stream    => 1,
+    signature => {
+        desc   => q/Returns new lineitems for each matching bib record/,
+        params => [
+            {desc => "Authentication token", type => "string"},
+            {desc => "search string", type => "string"},
+            {desc => "search options", type => "object"}
+        ],
+        return => {desc => "A stream of LIs on success, Event on failure"}
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "bib_search",
+    api_name  => "open-ils.acq.biblio.create_by_id",
+    stream    => 1,
+    signature => {
+        desc   => q/Returns new lineitems for each matching bib record/,
+        params => [
+            {desc => "Authentication token", type => "string"},
+            {desc => "list of bib IDs", type => "array"},
+            {desc => "options (for lineitem fleshing)", type => "object"}
+        ],
+        return => {desc => "A stream of LIs on success, Event on failure"}
+    }
+);
+
+# This is very similar to zsearch() in Order.pm
+sub bib_search {
+    my ($self, $conn, $auth, $search, $opts) = @_;
+
+    my $e = new_editor("authtoken" => $auth, "xact" => 1);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed("CREATE_PICKLIST");
+
+    my $mgr = new OpenILS::Application::Acq::BatchManager(
+        "editor" => $e, "conn" => $conn
+    );
+
+    $opts ||= {};
+
+    my $picklist;
+    my @li_ids = ();
+    if ($self->api_name =~ /create_by_id/) {
+        $search = [ sort @$search ]; # for consitency
+        my $bibs = $e->search_biblio_record_entry(
+            {"id" => $search}, {"order_by" => {"bre" => ["id"]}}
+        ) or return $e->die_event;
+
+        if ($opts->{"reuse_picklist"}) {
+            $picklist = $e->retrieve_acq_picklist($opts->{"reuse_picklist"}) or
+                return $e->die_event;
+            return $e->die_event unless
+                $e->allowed("UPDATE_PICKLIST", $picklist->org_unit);
+
+            # If we're reusing an existing picklist, we don't need to
+            # create new lineitems for any bib records for which we already
+
+            my $already_have = $e->search_acq_lineitem({
+                "picklist" => $picklist->id,
+                "eg_bib_id" => [ map { $_->id } @$bibs ]
+            }) or return $e->die_event;
+         
+            # So in that case we a) save the lineitem id's of the relevant
+            # items that already exist so that we can return those items later,
+            # and b) remove the bib id's in question from our list of bib
+            # id's to lineitemize.
+            if (@$already_have) {
+                push @li_ids, $_->id foreach (@$already_have);
+                my @new_bibs = ();
+                foreach my $bib (@$bibs) {
+                    push @new_bibs, $bib unless
+                        grep { $_->eg_bib_id == $bib->id } @$already_have;
+                }
+                $bibs = [ @new_bibs ];
+            }
+        } else {
+            $picklist = OpenILS::Application::Acq::Order::zsearch_build_pl($mgr, undef)
+                or return $e->die_event;
+        }
+
+        $conn->respond($picklist->id);
+
+        push @li_ids, map {
+            OpenILS::Application::Acq::Order::create_lineitem(
+                $mgr,
+                "picklist" => $picklist->id,
+                "source_label" => "native-evergreen-catalog",
+                "marc" => $_->marc,
+                "eg_bib_id" => $_->id
+            )->id;
+        } (@$bibs);
+    } else {
+        $opts->{"limit"} ||= 10;
+
+        my $ses = create OpenSRF::AppSession("open-ils.search");
+        my $req = $ses->request(
+            "open-ils.search.biblio.multiclass.query.staff", $opts, $search
+        );
+
+        my $count = 0;
+        while (my $resp = $req->recv("timeout" => 60)) {
+            $picklist = OpenILS::Application::Acq::Order::zsearch_build_pl(
+                $mgr, undef
+            ) unless $count++;
+
+            my $result = $resp->content;
+            next if not ref $result;
+
+            # The result object contains a whole heck of a lot more information
+            # than just bib IDs, so maybe we could tell the client something
+            # useful (progress meter at least) in the future...
+            push @li_ids, map {
+                my $bib = $_->[0];
+                OpenILS::Application::Acq::Order::create_lineitem(
+                    $mgr,
+                    "picklist" => $picklist->id,
+                    "source_label" => "native-evergreen-catalog",
+                    "marc" => $e->retrieve_biblio_record_entry($bib)->marc,
+                    "eg_bib_id" => $bib
+                )->id;
+            } (@{$result->{"ids"}});
+        }
+        $ses->disconnect;
+    }
+
+    $e->commit;
+
+    $logger->info("created @li_ids new lineitems for picklist $picklist");
+
+    # new editor, but still using transaction to ensure correct retrieval
+    # in a replicated setup
+    $e = new_editor("authtoken" => $auth, xact => 1) or return $e->die_event;
+    return $e->die_event unless $e->checkauth;
+    $conn->respond($RETRIEVERS{"lineitem"}->($e, $_, $opts)) foreach @li_ids;
+    $e->rollback;
+    $e->disconnect;
+
+    undef;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor.pm
new file mode 100644
index 0000000000..fa75db451c
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor.pm
@@ -0,0 +1,4292 @@
+package OpenILS::Application::Actor;
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+use Data::Dumper;
+$Data::Dumper::Indent = 0;
+use OpenILS::Event;
+
+use Digest::MD5 qw(md5_hex);
+
+use OpenSRF::EX qw(:try);
+use OpenILS::Perm;
+
+use OpenILS::Application::AppUtils;
+
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::ModsParser;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenSRF::Utils qw/:datetime/;
+use OpenSRF::Utils::SettingsClient;
+
+use OpenSRF::Utils::Cache;
+
+use OpenSRF::Utils::JSON;
+use DateTime;
+use DateTime::Format::ISO8601;
+use OpenILS::Const qw/:const/;
+
+use OpenILS::Application::Actor::Container;
+use OpenILS::Application::Actor::ClosedDates;
+use OpenILS::Application::Actor::UserGroups;
+use OpenILS::Application::Actor::Friends;
+use OpenILS::Application::Actor::Stage;
+
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenILS::Utils::Penalty;
+use List::Util qw/max/;
+
+use UUID::Tiny qw/:std/;
+
+sub initialize {
+	OpenILS::Application::Actor::Container->initialize();
+	OpenILS::Application::Actor::UserGroups->initialize();
+	OpenILS::Application::Actor::ClosedDates->initialize();
+}
+
+my $apputils = "OpenILS::Application::AppUtils";
+my $U = $apputils;
+
+sub _d { warn "Patron:\n" . Dumper(shift()); }
+
+my $cache;
+my $set_user_settings;
+my $set_ou_settings;
+
+
+#__PACKAGE__->register_method(
+#	method	=> "allowed_test",
+#	api_name	=> "open-ils.actor.allowed_test",
+#);
+#sub allowed_test {
+#    my($self, $conn, $auth, $orgid, $permcode) = @_;
+#    my $e = new_editor(authtoken => $auth);
+#    return $e->die_event unless $e->checkauth;
+#
+#    return {
+#        orgid => $orgid,
+#        permcode => $permcode,
+#        result => $e->allowed($permcode, $orgid)
+#    };
+#}
+
+__PACKAGE__->register_method(
+	method	=> "update_user_setting",
+	api_name	=> "open-ils.actor.patron.settings.update",
+);
+sub update_user_setting {
+	my($self, $conn, $auth, $user_id, $settings) = @_;
+    my $e = new_editor(xact => 1, authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    $user_id = $e->requestor->id unless defined $user_id;
+
+    unless($e->requestor->id == $user_id) {
+        my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
+        return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
+    }
+
+    for my $name (keys %$settings) {
+        my $val = $$settings{$name};
+        my $set = $e->search_actor_user_setting({usr => $user_id, name => $name})->[0];
+
+        if(defined $val) {
+            $val = OpenSRF::Utils::JSON->perl2JSON($val);
+            if($set) {
+                $set->value($val);
+                $e->update_actor_user_setting($set) or return $e->die_event;
+            } else {
+                $set = Fieldmapper::actor::user_setting->new;
+                $set->usr($user_id);
+                $set->name($name);
+                $set->value($val);
+                $e->create_actor_user_setting($set) or return $e->die_event;
+            }
+        } elsif($set) {
+            $e->delete_actor_user_setting($set) or return $e->die_event;
+        }
+    }
+
+    $e->commit;
+    return 1;
+}
+
+
+__PACKAGE__->register_method(
+    method    => "set_ou_settings",
+    api_name  => "open-ils.actor.org_unit.settings.update",
+    signature => {
+        desc => "Updates the value for a given org unit setting.  The permission to update "          .
+                "an org unit setting is either the UPDATE_ORG_UNIT_SETTING_ALL, or a specific "       .
+                "permission specified in the update_perm column of the config.org_unit_setting_type " .
+                "table's row corresponding to the setting being changed." ,
+        params => [
+            {desc => 'Authentication token',             type => 'string'},
+            {desc => 'Org unit ID',                      type => 'number'},
+            {desc => 'Hash of setting name-value pairs', type => 'object'}
+        ],
+        return => {desc => '1 on success, Event on error'}
+    }
+);
+
+sub set_ou_settings {
+	my( $self, $client, $auth, $org_id, $settings ) = @_;
+
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+
+    my $all_allowed = $e->allowed("UPDATE_ORG_UNIT_SETTING_ALL", $org_id);
+
+	for my $name (keys %$settings) {
+        my $val = $$settings{$name};
+
+        my $type = $e->retrieve_config_org_unit_setting_type([
+            $name,
+            {flesh => 1, flesh_fields => {'coust' => ['update_perm']}}
+        ]) or return $e->die_event;
+        my $set = $e->search_actor_org_unit_setting({org_unit => $org_id, name => $name})->[0];
+
+        # If there is no relevant permission, the default assumption will
+        # be, "no, the caller cannot change that value."
+        return $e->die_event unless ($all_allowed ||
+            ($type->update_perm && $e->allowed($type->update_perm->code, $org_id)));
+
+        if(defined $val) {
+            $val = OpenSRF::Utils::JSON->perl2JSON($val);
+            if($set) {
+                $set->value($val);
+                $e->update_actor_org_unit_setting($set) or return $e->die_event;
+            } else {
+                $set = Fieldmapper::actor::org_unit_setting->new;
+                $set->org_unit($org_id);
+                $set->name($name);
+                $set->value($val);
+                $e->create_actor_org_unit_setting($set) or return $e->die_event;
+            }
+        } elsif($set) {
+            $e->delete_actor_org_unit_setting($set) or return $e->die_event;
+        }
+    }
+
+    $e->commit;
+    return 1;
+}
+
+__PACKAGE__->register_method(
+    method   => "user_settings",
+    authoritative => 1,
+    api_name => "open-ils.actor.patron.settings.retrieve",
+);
+sub user_settings {
+	my( $self, $client, $auth, $user_id, $setting ) = @_;
+
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+    $user_id = $e->requestor->id unless defined $user_id;
+
+    my $patron = $e->retrieve_actor_user($user_id) or return $e->event;
+    if($e->requestor->id != $user_id) {
+        return $e->event unless $e->allowed('VIEW_USER', $patron->home_ou);
+    }
+
+    sub get_setting {
+        my($e, $user_id, $setting) = @_;
+        my $val = $e->search_actor_user_setting({usr => $user_id, name => $setting})->[0];
+        return undef unless $val; # XXX this should really return undef, but needs testing
+        return OpenSRF::Utils::JSON->JSON2perl($val->value);
+    }
+
+    if($setting) {
+        if(ref $setting eq 'ARRAY') {
+            my %settings;
+            $settings{$_} = get_setting($e, $user_id, $_) for @$setting;
+            return \%settings;
+        } else {
+            return get_setting($e, $user_id, $setting);    
+        }
+    } else {
+        my $s = $e->search_actor_user_setting({usr => $user_id});
+	    return { map { ( $_->name => OpenSRF::Utils::JSON->JSON2perl($_->value) ) } @$s };
+    }
+}
+
+
+__PACKAGE__->register_method(
+    method    => "ranged_ou_settings",
+    api_name  => "open-ils.actor.org_unit_setting.values.ranged.retrieve",
+    signature => {
+        desc   => "Retrieves all org unit settings for the given org_id, up to whatever limit " .
+                  "is implied for retrieving OU settings by the authenticated users' permissions.",
+        params => [
+            {desc => 'Authentication token',   type => 'string'},
+            {desc => 'Org unit ID',            type => 'number'},
+        ],
+        return => {desc => 'A hashref of "ranged" settings, event on error'}
+    }
+);
+sub ranged_ou_settings {
+	my( $self, $client, $auth, $org_id ) = @_;
+
+	my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    my %ranged_settings;
+    my $org_list = $U->get_org_ancestors($org_id);
+    my $settings = $e->search_actor_org_unit_setting({org_unit => $org_list});
+    $org_list = [ reverse @$org_list ];
+
+    # start at the context org and capture the setting value
+    # without clobbering settings we've already captured
+    for my $this_org_id (@$org_list) {
+        
+        my @sets = grep { $_->org_unit == $this_org_id } @$settings;
+
+        for my $set (@sets) {
+            my $type = $e->retrieve_config_org_unit_setting_type([
+                $set->name,
+                {flesh => 1, flesh_fields => {coust => ['view_perm']}}
+            ]);
+
+            # If there is no relevant permission, the default assumption will
+            # be, "yes, the caller can have that value."
+            if ($type && $type->view_perm) {
+                next if not $e->allowed($type->view_perm->code, $org_id);
+            }
+
+            $ranged_settings{$set->name} = OpenSRF::Utils::JSON->JSON2perl($set->value)
+                unless defined $ranged_settings{$set->name};
+        }
+    }
+
+	return \%ranged_settings;
+}
+
+
+
+__PACKAGE__->register_method(
+    api_name  => 'open-ils.actor.ou_setting.ancestor_default',
+    method    => 'ou_ancestor_setting',
+    signature => {
+        desc => 'Get the org unit setting value associated with the setting name as seen from the specified org unit.  ' .
+                'IF AND ONLY IF an authentication token is provided, this method will make sure that the given '         .
+                'user has permission to view that setting, if there is a permission associated with the setting.'        ,
+        params => [
+            { desc => 'Org unit ID',          type => 'number' },
+            { desc => 'setting name',         type => 'string' },
+            { desc => 'authtoken (optional)', type => 'string' }
+        ],
+        return => {desc => 'A value for the org unit setting, or undef'}
+    }
+);
+
+# ------------------------------------------------------------------
+# Attempts to find the org setting value for a given org.  if not 
+# found at the requested org, searches up the org tree until it 
+# finds a parent that has the requested setting.
+# when found, returns { org => $id, value => $value }
+# otherwise, returns NULL
+# ------------------------------------------------------------------
+sub ou_ancestor_setting {
+    my( $self, $client, $orgid, $name, $auth ) = @_;
+    return $U->ou_ancestor_setting($orgid, $name, undef, $auth);
+}
+
+__PACKAGE__->register_method(
+    api_name  => 'open-ils.actor.ou_setting.ancestor_default.batch',
+    method    => 'ou_ancestor_setting_batch',
+    signature => {
+        desc => 'Get org unit setting name => value pairs for a list of names, as seen from the specified org unit.  ' .
+                'IF AND ONLY IF an authentication token is provided, this method will make sure that the given '       .
+                'user has permission to view that setting, if there is a permission associated with the setting.'      ,
+        params => [
+            { desc => 'Org unit ID',          type => 'number' },
+            { desc => 'setting name list',    type => 'array'  },
+            { desc => 'authtoken (optional)', type => 'string' }
+        ],
+        return => {desc => 'A hash with name => value pairs for the org unit settings'}
+    }
+);
+sub ou_ancestor_setting_batch {
+    my( $self, $client, $orgid, $name_list, $auth ) = @_;
+    my %values;
+    $values{$_} = $U->ou_ancestor_setting($orgid, $_, undef, $auth) for @$name_list;
+    return \%values;
+}
+
+
+
+__PACKAGE__->register_method(
+    method   => "update_patron",
+    api_name => "open-ils.actor.patron.update",
+    signature => {
+        desc   => q/
+            Update an existing user, or create a new one.  Related objects,
+            like cards, addresses, survey responses, and stat cats, 
+            can be updated by attaching them to the user object in their
+            respective fields.  For examples, the billing address object
+            may be inserted into the 'billing_address' field, etc.  For each 
+            attached object, indicate if the object should be created, 
+            updated, or deleted using the built-in 'isnew', 'ischanged', 
+            and 'isdeleted' fields on the object.
+        /,
+        params => [
+            { desc => 'Authentication token', type => 'string' },
+            { desc => 'Patron data object',   type => 'object' }
+        ],
+        return => {desc => 'A fleshed user object, event on error'}
+    }
+);
+
+sub update_patron {
+	my( $self, $client, $user_session, $patron ) = @_;
+
+	my $session = $apputils->start_db_session();
+
+	$logger->info($patron->isnew ? "Creating new patron..." : "Updating Patron: " . $patron->id);
+
+	my( $user_obj, $evt ) = $U->checkses($user_session);
+	return $evt if $evt;
+
+	$evt = check_group_perm($session, $user_obj, $patron);
+	return $evt if $evt;
+
+
+	# $new_patron is the patron in progress.  $patron is the original patron
+	# passed in with the method.  new_patron will change as the components
+	# of patron are added/updated.
+
+	my $new_patron;
+
+	# unflesh the real items on the patron
+	$patron->card( $patron->card->id ) if(ref($patron->card));
+	$patron->billing_address( $patron->billing_address->id ) 
+		if(ref($patron->billing_address));
+	$patron->mailing_address( $patron->mailing_address->id ) 
+		if(ref($patron->mailing_address));
+
+	# create/update the patron first so we can use his id
+	if($patron->isnew()) {
+		( $new_patron, $evt ) = _add_patron($session, _clone_patron($patron), $user_obj);
+		return $evt if $evt;
+	} else { $new_patron = $patron; }
+
+	( $new_patron, $evt ) = _add_update_addresses($session, $patron, $new_patron, $user_obj);
+	return $evt if $evt;
+
+	( $new_patron, $evt ) = _add_update_cards($session, $patron, $new_patron, $user_obj);
+	return $evt if $evt;
+
+	( $new_patron, $evt ) = _add_survey_responses($session, $patron, $new_patron, $user_obj);
+	return $evt if $evt;
+
+	# re-update the patron if anything has happened to him during this process
+	if($new_patron->ischanged()) {
+		( $new_patron, $evt ) = _update_patron($session, $new_patron, $user_obj);
+		return $evt if $evt;
+	}
+
+	($new_patron, $evt) = _create_stat_maps($session, $user_session, $patron, $new_patron, $user_obj);
+	return $evt if $evt;
+
+	($new_patron, $evt) = _create_perm_maps($session, $user_session, $patron, $new_patron, $user_obj);
+	return $evt if $evt;
+
+	$apputils->commit_db_session($session);
+
+    $evt = apply_invalid_addr_penalty($patron);
+    return $evt if $evt;
+
+    my $tses = OpenSRF::AppSession->create('open-ils.trigger');
+	if($patron->isnew) {
+        $tses->request('open-ils.trigger.event.autocreate', 'au.create', $new_patron, $new_patron->home_ou);
+	} else {
+        $tses->request('open-ils.trigger.event.autocreate', 'au.update', $new_patron, $new_patron->home_ou);
+    }
+
+	return flesh_user($new_patron->id(), new_editor(requestor => $user_obj, xact => 1));
+}
+
+sub apply_invalid_addr_penalty {
+    my $patron = shift;
+    my $e = new_editor(xact => 1);
+
+    # grab the invalid address penalty if set
+    my $penalties = OpenILS::Utils::Penalty->retrieve_usr_penalties($e, $patron->id, $patron->home_ou);
+
+    my ($addr_penalty) = grep 
+        { $_->standing_penalty->name eq 'INVALID_PATRON_ADDRESS' } @$penalties;
+    
+    # do we enforce invalid address penalty
+    my $enforce = $U->ou_ancestor_setting_value(
+        $patron->home_ou, 'circ.patron_invalid_address_apply_penalty') || 0;
+
+    my $addrs = $e->search_actor_user_address(
+        {usr => $patron->id, valid => 'f', id => {'>' => 0}}, {idlist => 1});
+    my $addr_count = scalar(@$addrs);
+
+    if($addr_count == 0 and $addr_penalty) {
+
+        # regardless of any settings, remove the penalty when the user has no invalid addresses
+        $e->delete_actor_user_standing_penalty($addr_penalty) or return $e->die_event;
+        $e->commit;
+
+    } elsif($enforce and $addr_count > 0 and !$addr_penalty) {
+        
+        my $ptype = $e->retrieve_config_standing_penalty(29) or return $e->die_event;
+        my $depth = $ptype->org_depth;
+        my $ctx_org = $U->org_unit_ancestor_at_depth($patron->home_ou, $depth) if defined $depth;
+        $ctx_org = $patron->home_ou unless defined $ctx_org;
+        
+        my $penalty = Fieldmapper::actor::user_standing_penalty->new;
+        $penalty->usr($patron->id);
+        $penalty->org_unit($ctx_org);
+        $penalty->standing_penalty(OILS_PENALTY_INVALID_PATRON_ADDRESS);
+
+        $e->create_actor_user_standing_penalty($penalty) or return $e->die_event;
+        $e->commit;
+
+    } else {
+        $e->rollback;
+    }
+
+    return undef;
+}
+
+
+sub flesh_user {
+	my $id = shift;
+    my $e = shift;
+    my $home_ou = shift;
+
+    my $fields = [
+		"cards",
+		"card",
+		"standing_penalties",
+		"addresses",
+		"billing_address",
+		"mailing_address",
+		"stat_cat_entries"
+    ];
+    push @$fields, "home_ou" if $home_ou;
+	return new_flesh_user($id, $fields, $e );
+}
+
+
+
+
+
+
+# clone and clear stuff that would break the database
+sub _clone_patron {
+	my $patron = shift;
+
+	my $new_patron = $patron->clone;
+	# clear these
+	$new_patron->clear_billing_address();
+	$new_patron->clear_mailing_address();
+	$new_patron->clear_addresses();
+	$new_patron->clear_card();
+	$new_patron->clear_cards();
+	$new_patron->clear_id();
+	$new_patron->clear_isnew();
+	$new_patron->clear_ischanged();
+	$new_patron->clear_isdeleted();
+	$new_patron->clear_stat_cat_entries();
+	$new_patron->clear_permissions();
+	$new_patron->clear_standing_penalties();
+
+	return $new_patron;
+}
+
+
+sub _add_patron {
+
+	my $session		= shift;
+	my $patron		= shift;
+	my $user_obj	= shift;
+
+	my $evt = $U->check_perms($user_obj->id, $patron->home_ou, 'CREATE_USER');
+	return (undef, $evt) if $evt;
+
+	my $ex = $session->request(
+		'open-ils.storage.direct.actor.user.search.usrname', $patron->usrname())->gather(1);
+	if( $ex and @$ex ) {
+		return (undef, OpenILS::Event->new('USERNAME_EXISTS'));
+	}
+
+	$logger->info("Creating new user in the DB with username: ".$patron->usrname());
+
+	my $id = $session->request(
+		"open-ils.storage.direct.actor.user.create", $patron)->gather(1);
+	return (undef, $U->DB_UPDATE_FAILED($patron)) unless $id;
+
+	$logger->info("Successfully created new user [$id] in DB");
+
+	return ( $session->request( 
+		"open-ils.storage.direct.actor.user.retrieve", $id)->gather(1), undef );
+}
+
+
+sub check_group_perm {
+	my( $session, $requestor, $patron ) = @_;
+	my $evt;
+
+	# first let's see if the requestor has 
+	# priveleges to update this user in any way
+	if( ! $patron->isnew ) {
+		my $p = $session->request(
+			'open-ils.storage.direct.actor.user.retrieve', $patron->id )->gather(1);
+
+		# If we are the requestor (trying to update our own account)
+		# and we are not trying to change our profile, we're good
+		if( $p->id == $requestor->id and 
+				$p->profile == $patron->profile ) {
+			return undef;
+		}
+
+
+		$evt = group_perm_failed($session, $requestor, $p);
+		return $evt if $evt;
+	}
+
+	# They are allowed to edit this patron.. can they put the 
+	# patron into the group requested?
+	$evt = group_perm_failed($session, $requestor, $patron);
+	return $evt if $evt;
+	return undef;
+}
+
+
+sub group_perm_failed {
+	my( $session, $requestor, $patron ) = @_;
+
+	my $perm;
+	my $grp;
+	my $grpid = $patron->profile;
+
+	do {
+
+		$logger->debug("user update looking for group perm for group $grpid");
+		$grp = $session->request(
+			'open-ils.storage.direct.permission.grp_tree.retrieve', $grpid )->gather(1);
+		return OpenILS::Event->new('PERMISSION_GRP_TREE_NOT_FOUND') unless $grp;
+
+	} while( !($perm = $grp->application_perm) and ($grpid = $grp->parent) );
+
+	$logger->info("user update checking perm $perm on user ".
+		$requestor->id." for update/create on user username=".$patron->usrname);
+
+	my $evt = $U->check_perms($requestor->id, $patron->home_ou, $perm);
+	return $evt if $evt;
+	return undef;
+}
+
+
+
+sub _update_patron {
+	my( $session, $patron, $user_obj, $noperm) = @_;
+
+	$logger->info("Updating patron ".$patron->id." in DB");
+
+	my $evt;
+
+	if(!$noperm) {
+		$evt = $U->check_perms($user_obj->id, $patron->home_ou, 'UPDATE_USER');
+		return (undef, $evt) if $evt;
+	}
+
+	# update the password by itself to avoid the password protection magic
+	if( $patron->passwd ) {
+		my $s = $session->request(
+			'open-ils.storage.direct.actor.user.remote_update',
+			{id => $patron->id}, {passwd => $patron->passwd})->gather(1);
+		return (undef, $U->DB_UPDATE_FAILED($patron)) unless defined($s);
+		$patron->clear_passwd;
+	}
+
+	if(!$patron->ident_type) {
+		$patron->clear_ident_type;
+		$patron->clear_ident_value;
+	}
+
+    $evt = verify_last_xact($session, $patron);
+    return (undef, $evt) if $evt;
+
+	my $stat = $session->request(
+		"open-ils.storage.direct.actor.user.update",$patron )->gather(1);
+	return (undef, $U->DB_UPDATE_FAILED($patron)) unless defined($stat);
+
+	return ($patron);
+}
+
+sub verify_last_xact {
+    my( $session, $patron ) = @_;
+    return undef unless $patron->id and $patron->id > 0;
+    my $p = $session->request(
+        'open-ils.storage.direct.actor.user.retrieve', $patron->id)->gather(1);
+    my $xact = $p->last_xact_id;
+    return undef unless $xact;
+    $logger->info("user xact = $xact, saving with xact " . $patron->last_xact_id);
+    return OpenILS::Event->new('XACT_COLLISION')
+        if $xact != $patron->last_xact_id;
+    return undef;
+}
+
+
+sub _check_dup_ident {
+	my( $session, $patron ) = @_;
+
+	return undef unless $patron->ident_value;
+
+	my $search = {
+		ident_type	=> $patron->ident_type, 
+		ident_value => $patron->ident_value,
+	};
+
+	$logger->debug("patron update searching for dup ident values: " . 
+		$patron->ident_type . ':' . $patron->ident_value);
+
+	$search->{id} = {'!=' => $patron->id} if $patron->id and $patron->id > 0;
+
+	my $dups = $session->request(
+		'open-ils.storage.direct.actor.user.search_where.atomic', $search )->gather(1);
+
+
+	return OpenILS::Event->new('PATRON_DUP_IDENT1', payload => $patron )
+		if $dups and @$dups;
+
+	return undef;
+}
+
+
+sub _add_update_addresses {
+
+	my $session = shift;
+	my $patron = shift;
+	my $new_patron = shift;
+
+	my $evt;
+
+	my $current_id; # id of the address before creation
+
+	for my $address (@{$patron->addresses()}) {
+
+		next unless ref $address;
+		$current_id = $address->id();
+
+		if( $patron->billing_address() and
+			$patron->billing_address() == $current_id ) {
+			$logger->info("setting billing addr to $current_id");
+			$new_patron->billing_address($address->id());
+			$new_patron->ischanged(1);
+		}
+	
+		if( $patron->mailing_address() and
+			$patron->mailing_address() == $current_id ) {
+			$new_patron->mailing_address($address->id());
+			$logger->info("setting mailing addr to $current_id");
+			$new_patron->ischanged(1);
+		}
+
+
+		if($address->isnew()) {
+
+			$address->usr($new_patron->id());
+
+			($address, $evt) = _add_address($session,$address);
+			return (undef, $evt) if $evt;
+
+			# we need to get the new id
+			if( $patron->billing_address() and 
+					$patron->billing_address() == $current_id ) {
+				$new_patron->billing_address($address->id());
+				$logger->info("setting billing addr to $current_id");
+				$new_patron->ischanged(1);
+			}
+
+			if( $patron->mailing_address() and
+					$patron->mailing_address() == $current_id ) {
+				$new_patron->mailing_address($address->id());
+				$logger->info("setting mailing addr to $current_id");
+				$new_patron->ischanged(1);
+			}
+
+		} elsif($address->ischanged() ) {
+
+			($address, $evt) = _update_address($session, $address);
+			return (undef, $evt) if $evt;
+
+		} elsif($address->isdeleted() ) {
+
+			if( $address->id() == $new_patron->mailing_address() ) {
+				$new_patron->clear_mailing_address();
+				($new_patron, $evt) = _update_patron($session, $new_patron);
+				return (undef, $evt) if $evt;
+			}
+
+			if( $address->id() == $new_patron->billing_address() ) {
+				$new_patron->clear_billing_address();
+				($new_patron, $evt) = _update_patron($session, $new_patron);
+				return (undef, $evt) if $evt;
+			}
+
+			$evt = _delete_address($session, $address);
+			return (undef, $evt) if $evt;
+		} 
+	}
+
+	return ( $new_patron, undef );
+}
+
+
+# adds an address to the db and returns the address with new id
+sub _add_address {
+	my($session, $address) = @_;
+	$address->clear_id();
+
+	$logger->info("Creating new address at street ".$address->street1);
+
+	# put the address into the database
+	my $id = $session->request(
+		"open-ils.storage.direct.actor.user_address.create", $address )->gather(1);
+	return (undef, $U->DB_UPDATE_FAILED($address)) unless $id;
+
+	$address->id( $id );
+	return ($address, undef);
+}
+
+
+sub _update_address {
+	my( $session, $address ) = @_;
+
+	$logger->info("Updating address ".$address->id." in the DB");
+
+	my $stat = $session->request(
+		"open-ils.storage.direct.actor.user_address.update", $address )->gather(1);
+
+	return (undef, $U->DB_UPDATE_FAILED($address)) unless defined($stat);
+	return ($address, undef);
+}
+
+
+
+sub _add_update_cards {
+
+	my $session = shift;
+	my $patron = shift;
+	my $new_patron = shift;
+
+	my $evt;
+
+	my $virtual_id; #id of the card before creation
+	for my $card (@{$patron->cards()}) {
+
+		$card->usr($new_patron->id());
+
+		if(ref($card) and $card->isnew()) {
+
+			$virtual_id = $card->id();
+			( $card, $evt ) = _add_card($session,$card);
+			return (undef, $evt) if $evt;
+
+			#if(ref($patron->card)) { $patron->card($patron->card->id); }
+			if($patron->card() == $virtual_id) {
+				$new_patron->card($card->id());
+				$new_patron->ischanged(1);
+			}
+
+		} elsif( ref($card) and $card->ischanged() ) {
+			$evt = _update_card($session, $card);
+			return (undef, $evt) if $evt;
+		}
+	}
+
+	return ( $new_patron, undef );
+}
+
+
+# adds an card to the db and returns the card with new id
+sub _add_card {
+	my( $session, $card ) = @_;
+	$card->clear_id();
+
+	$logger->info("Adding new patron card ".$card->barcode);
+
+	my $id = $session->request(
+		"open-ils.storage.direct.actor.card.create", $card )->gather(1);
+	return (undef, $U->DB_UPDATE_FAILED($card)) unless $id;
+	$logger->info("Successfully created patron card $id");
+
+	$card->id($id);
+	return ( $card, undef );
+}
+
+
+# returns event on error.  returns undef otherwise
+sub _update_card {
+	my( $session, $card ) = @_;
+	$logger->info("Updating patron card ".$card->id);
+
+	my $stat = $session->request(
+		"open-ils.storage.direct.actor.card.update", $card )->gather(1);
+	return $U->DB_UPDATE_FAILED($card) unless defined($stat);
+	return undef;
+}
+
+
+
+
+# returns event on error.  returns undef otherwise
+sub _delete_address {
+	my( $session, $address ) = @_;
+
+	$logger->info("Deleting address ".$address->id." from DB");
+
+	my $stat = $session->request(
+		"open-ils.storage.direct.actor.user_address.delete", $address )->gather(1);
+
+	return $U->DB_UPDATE_FAILED($address) unless defined($stat);
+	return undef;
+}
+
+
+
+sub _add_survey_responses {
+	my ($session, $patron, $new_patron) = @_;
+
+	$logger->info( "Updating survey responses for patron ".$new_patron->id );
+
+	my $responses = $patron->survey_responses;
+
+	if($responses) {
+
+		$_->usr($new_patron->id) for (@$responses);
+
+		my $evt = $U->simplereq( "open-ils.circ", 
+			"open-ils.circ.survey.submit.user_id", $responses );
+
+		return (undef, $evt) if defined($U->event_code($evt));
+
+	}
+
+	return ( $new_patron, undef );
+}
+
+
+sub _create_stat_maps {
+
+	my($session, $user_session, $patron, $new_patron) = @_;
+
+	my $maps = $patron->stat_cat_entries();
+
+	for my $map (@$maps) {
+
+		my $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.update";
+
+		if ($map->isdeleted()) {
+			$method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.delete";
+
+		} elsif ($map->isnew()) {
+			$method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.create";
+			$map->clear_id;
+		}
+
+
+		$map->target_usr($new_patron->id);
+
+		#warn "
+		$logger->info("Updating stat entry with method $method and map $map");
+
+		my $stat = $session->request($method, $map)->gather(1);
+		return (undef, $U->DB_UPDATE_FAILED($map)) unless defined($stat);
+
+	}
+
+	return ($new_patron, undef);
+}
+
+sub _create_perm_maps {
+
+	my($session, $user_session, $patron, $new_patron) = @_;
+
+	my $maps = $patron->permissions;
+
+	for my $map (@$maps) {
+
+		my $method = "open-ils.storage.direct.permission.usr_perm_map.update";
+		if ($map->isdeleted()) {
+			$method = "open-ils.storage.direct.permission.usr_perm_map.delete";
+		} elsif ($map->isnew()) {
+			$method = "open-ils.storage.direct.permission.usr_perm_map.create";
+			$map->clear_id;
+		}
+
+
+		$map->usr($new_patron->id);
+
+		#warn( "Updating permissions with method $method and session $user_session and map $map" );
+		$logger->info( "Updating permissions with method $method and map $map" );
+
+		my $stat = $session->request($method, $map)->gather(1);
+		return (undef, $U->DB_UPDATE_FAILED($map)) unless defined($stat);
+
+	}
+
+	return ($new_patron, undef);
+}
+
+
+__PACKAGE__->register_method(
+    method   => "set_user_work_ous",
+    api_name => "open-ils.actor.user.work_ous.update",
+);
+
+sub set_user_work_ous {
+    my $self   = shift;
+    my $client = shift;
+    my $ses    = shift;
+    my $maps   = shift;
+
+	my( $requestor, $evt ) = $apputils->checksesperm( $ses, 'ASSIGN_WORK_ORG_UNIT' );
+	return $evt if $evt;
+
+	my $session = $apputils->start_db_session();
+
+	for my $map (@$maps) {
+
+		my $method = "open-ils.storage.direct.permission.usr_work_ou_map.update";
+		if ($map->isdeleted()) {
+			$method = "open-ils.storage.direct.permission.usr_work_ou_map.delete";
+		} elsif ($map->isnew()) {
+			$method = "open-ils.storage.direct.permission.usr_work_ou_map.create";
+			$map->clear_id;
+		}
+
+		#warn( "Updating permissions with method $method and session $ses and map $map" );
+		$logger->info( "Updating work_ou map with method $method and map $map" );
+
+		my $stat = $session->request($method, $map)->gather(1);
+		$logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat);
+
+	}
+
+	$apputils->commit_db_session($session);
+
+	return scalar(@$maps);
+}
+
+
+__PACKAGE__->register_method(
+    method   => "set_user_perms",
+    api_name => "open-ils.actor.user.permissions.update",
+);
+
+sub set_user_perms {
+	my $self = shift;
+	my $client = shift;
+	my $ses = shift;
+	my $maps = shift;
+
+	my $session = $apputils->start_db_session();
+
+	my( $user_obj, $evt ) = $U->checkses($ses);
+	return $evt if $evt;
+
+	my $perms = $session->request('open-ils.storage.permission.user_perms.atomic', $user_obj->id)->gather(1);
+
+	my $all = undef;
+	$all = 1 if ($U->is_true($user_obj->super_user()));
+    $all = 1 unless ($U->check_perms($user_obj->id, $user_obj->home_ou, 'EVERYTHING'));
+
+	for my $map (@$maps) {
+
+		my $method = "open-ils.storage.direct.permission.usr_perm_map.update";
+		if ($map->isdeleted()) {
+			$method = "open-ils.storage.direct.permission.usr_perm_map.delete";
+		} elsif ($map->isnew()) {
+			$method = "open-ils.storage.direct.permission.usr_perm_map.create";
+			$map->clear_id;
+		}
+
+		next if (!$all and !grep { $_->perm eq $map->perm and $U->is_true($_->grantable) and $_->depth <= $map->depth } @$perms);
+		#warn( "Updating permissions with method $method and session $ses and map $map" );
+		$logger->info( "Updating permissions with method $method and map $map" );
+
+		my $stat = $session->request($method, $map)->gather(1);
+		$logger->warn( "update failed: ".$U->DB_UPDATE_FAILED($map) ) unless defined($stat);
+
+	}
+
+	$apputils->commit_db_session($session);
+
+	return scalar(@$maps);
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "user_retrieve_by_barcode",
+    authoritative => 1,
+	api_name	=> "open-ils.actor.user.fleshed.retrieve_by_barcode",);
+
+sub user_retrieve_by_barcode {
+	my($self, $client, $auth, $barcode, $flesh_home_ou) = @_;
+
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    my $card = $e->search_actor_card({barcode => $barcode})->[0]
+        or return $e->event;
+
+	my $user = flesh_user($card->usr, $e, $flesh_home_ou);
+    return $e->event unless $e->allowed(
+        "VIEW_USER", $flesh_home_ou ? $user->home_ou->id : $user->home_ou
+    );
+    return $user;
+}
+
+
+
+__PACKAGE__->register_method(
+    method        => "get_user_by_id",
+    authoritative => 1,
+    api_name      => "open-ils.actor.user.retrieve",
+);
+
+sub get_user_by_id {
+	my ($self, $client, $auth, $id) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	my $user = $e->retrieve_actor_user($id) or return $e->event;
+	return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);	
+	return $user;
+}
+
+
+__PACKAGE__->register_method(
+    method   => "get_org_types",
+    api_name => "open-ils.actor.org_types.retrieve",
+);
+sub get_org_types {
+    return $U->get_org_types();
+}
+
+
+__PACKAGE__->register_method(
+    method   => "get_user_ident_types",
+    api_name => "open-ils.actor.user.ident_types.retrieve",
+);
+my $ident_types;
+sub get_user_ident_types {
+	return $ident_types if $ident_types;
+	return $ident_types = 
+		new_editor()->retrieve_all_config_identification_type();
+}
+
+
+__PACKAGE__->register_method(
+    method   => "get_org_unit",
+    api_name => "open-ils.actor.org_unit.retrieve",
+);
+
+sub get_org_unit {
+	my( $self, $client, $user_session, $org_id ) = @_;
+	my $e = new_editor(authtoken => $user_session);
+	if(!$org_id) {
+		return $e->event unless $e->checkauth;
+		$org_id = $e->requestor->ws_ou;
+	}
+	my $o = $e->retrieve_actor_org_unit($org_id)
+		or return $e->event;
+	return $o;
+}
+
+__PACKAGE__->register_method(
+    method   => "search_org_unit",
+    api_name => "open-ils.actor.org_unit_list.search",
+);
+
+sub search_org_unit {
+
+	my( $self, $client, $field, $value ) = @_;
+
+	my $list = OpenILS::Application::AppUtils->simple_scalar_request(
+		"open-ils.cstore",
+		"open-ils.cstore.direct.actor.org_unit.search.atomic", 
+		{ $field => $value } );
+
+	return $list;
+}
+
+
+# build the org tree
+
+__PACKAGE__->register_method(
+	method	=> "get_org_tree",
+	api_name	=> "open-ils.actor.org_tree.retrieve",
+	argc		=> 0, 
+	note		=> "Returns the entire org tree structure",
+);
+
+sub get_org_tree {
+	my $self = shift;
+	my $client = shift;
+	return $U->get_org_tree($client->session->session_locale);
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "get_org_descendants",
+	api_name	=> "open-ils.actor.org_tree.descendants.retrieve"
+);
+
+# depth is optional.  org_unit is the id
+sub get_org_descendants {
+	my( $self, $client, $org_unit, $depth ) = @_;
+
+    if(ref $org_unit eq 'ARRAY') {
+        $depth ||= [];
+        my @trees;
+        for my $i (0..scalar(@$org_unit)-1) {
+            my $list = $U->simple_scalar_request(
+			    "open-ils.storage", 
+			    "open-ils.storage.actor.org_unit.descendants.atomic",
+			    $org_unit->[$i], $depth->[$i] );
+            push(@trees, $U->build_org_tree($list));
+        }
+        return \@trees;
+
+    } else {
+	    my $orglist = $apputils->simple_scalar_request(
+			    "open-ils.storage", 
+			    "open-ils.storage.actor.org_unit.descendants.atomic",
+			    $org_unit, $depth );
+	    return $U->build_org_tree($orglist);
+    }
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "get_org_ancestors",
+	api_name	=> "open-ils.actor.org_tree.ancestors.retrieve"
+);
+
+# depth is optional.  org_unit is the id
+sub get_org_ancestors {
+	my( $self, $client, $org_unit, $depth ) = @_;
+	my $orglist = $apputils->simple_scalar_request(
+			"open-ils.storage", 
+			"open-ils.storage.actor.org_unit.ancestors.atomic",
+			$org_unit, $depth );
+	return $U->build_org_tree($orglist);
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "get_standings",
+	api_name	=> "open-ils.actor.standings.retrieve"
+);
+
+my $user_standings;
+sub get_standings {
+	return $user_standings if $user_standings;
+	return $user_standings = 
+		$apputils->simple_scalar_request(
+			"open-ils.cstore",
+			"open-ils.cstore.direct.config.standing.search.atomic",
+			{ id => { "!=" => undef } }
+		);
+}
+
+
+__PACKAGE__->register_method(
+    method   => "get_my_org_path",
+    api_name => "open-ils.actor.org_unit.full_path.retrieve"
+);
+
+sub get_my_org_path {
+	my( $self, $client, $auth, $org_id ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	$org_id = $e->requestor->ws_ou unless defined $org_id;
+
+	return $apputils->simple_scalar_request(
+		"open-ils.storage",
+		"open-ils.storage.actor.org_unit.full_path.atomic",
+		$org_id );
+}
+
+
+__PACKAGE__->register_method(
+    method   => "patron_adv_search",
+    api_name => "open-ils.actor.patron.search.advanced"
+);
+sub patron_adv_search {
+	my( $self, $client, $auth, $search_hash, 
+        $search_limit, $search_sort, $include_inactive, $search_depth ) = @_;
+
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('VIEW_USER');
+	return $U->storagereq(
+		"open-ils.storage.actor.user.crazy_search", $search_hash, 
+            $search_limit, $search_sort, $include_inactive, $e->requestor->ws_ou, $search_depth);
+}
+
+
+__PACKAGE__->register_method(
+    method    => "update_passwd",
+    api_name  => "open-ils.actor.user.password.update",
+    signature => {
+        desc   => "Update the operator's password", 
+        params => [
+            { desc => 'Authentication token', type => 'string' },
+            { desc => 'New password',         type => 'string' },
+            { desc => 'Current password',     type => 'string' }
+        ],
+        return => {desc => '1 on success, Event on error or incorrect current password'}
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "update_passwd",
+    api_name  => "open-ils.actor.user.username.update",
+    signature => {
+        desc   => "Update the operator's username", 
+        params => [
+            { desc => 'Authentication token', type => 'string' },
+            { desc => 'New username',         type => 'string' }
+        ],
+        return => {desc => '1 on success, Event on error'}
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "update_passwd",
+    api_name  => "open-ils.actor.user.email.update",
+    signature => {
+        desc   => "Update the operator's email address", 
+        params => [
+            { desc => 'Authentication token', type => 'string' },
+            { desc => 'New email address',    type => 'string' }
+        ],
+        return => {desc => '1 on success, Event on error'}
+    }
+);
+
+sub update_passwd {
+    my( $self, $conn, $auth, $new_val, $orig_pw ) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $db_user = $e->retrieve_actor_user($e->requestor->id)
+        or return $e->die_event;
+    my $api = $self->api_name;
+
+    if( $api =~ /password/o ) {
+        # make sure the original password matches the in-database password
+        if (md5_hex($orig_pw) ne $db_user->passwd) {
+            $e->rollback;
+            return new OpenILS::Event('INCORRECT_PASSWORD');
+        }
+        $db_user->passwd($new_val);
+
+    } else {
+
+        # if we don't clear the password, the user will be updated with
+        # a hashed version of the hashed version of their password
+        $db_user->clear_passwd;
+
+        if( $api =~ /username/o ) {
+
+            # make sure no one else has this username
+            my $exist = $e->search_actor_user({usrname=>$new_val},{idlist=>1}); 
+            if (@$exist) {
+                $e->rollback;
+                return new OpenILS::Event('USERNAME_EXISTS');
+            }
+            $db_user->usrname($new_val);
+
+        } elsif( $api =~ /email/o ) {
+            $db_user->email($new_val);
+        }
+    }
+
+    $e->update_actor_user($db_user) or return $e->die_event;
+    $e->commit;
+    return 1;
+}
+
+
+
+__PACKAGE__->register_method(
+    method   => "check_user_perms",
+    api_name => "open-ils.actor.user.perm.check",
+    notes    => <<"	NOTES");
+	Takes a login session, user id, an org id, and an array of perm type strings.  For each
+	perm type, if the user does *not* have the given permission it is added
+	to a list which is returned from the method.  If all permissions
+	are allowed, an empty list is returned
+	if the logged in user does not match 'user_id', then the logged in user must
+	have VIEW_PERMISSION priveleges.
+	NOTES
+
+sub check_user_perms {
+	my( $self, $client, $login_session, $user_id, $org_id, $perm_types ) = @_;
+
+	my( $staff, $evt ) = $apputils->checkses($login_session);
+	return $evt if $evt;
+
+	if($staff->id ne $user_id) {
+		if( $evt = $apputils->check_perms(
+			$staff->id, $org_id, 'VIEW_PERMISSION') ) {
+			return $evt;
+		}
+	}
+
+	my @not_allowed;
+	for my $perm (@$perm_types) {
+		if($apputils->check_perms($user_id, $org_id, $perm)) {
+			push @not_allowed, $perm;
+		}
+	}
+
+	return \@not_allowed
+}
+
+__PACKAGE__->register_method(
+	method	=> "check_user_perms2",
+	api_name	=> "open-ils.actor.user.perm.check.multi_org",
+	notes		=> q/
+		Checks the permissions on a list of perms and orgs for a user
+		@param authtoken The login session key
+		@param user_id The id of the user to check
+		@param orgs The array of org ids
+		@param perms The array of permission names
+		@return An array of  [ orgId, permissionName ] arrays that FAILED the check
+		if the logged in user does not match 'user_id', then the logged in user must
+		have VIEW_PERMISSION priveleges.
+	/);
+
+sub check_user_perms2 {
+	my( $self, $client, $authtoken, $user_id, $orgs, $perms ) = @_;
+
+	my( $staff, $target, $evt ) = $apputils->checkses_requestor(
+		$authtoken, $user_id, 'VIEW_PERMISSION' );
+	return $evt if $evt;
+
+	my @not_allowed;
+	for my $org (@$orgs) {
+		for my $perm (@$perms) {
+			if($apputils->check_perms($user_id, $org, $perm)) {
+				push @not_allowed, [ $org, $perm ];
+			}
+		}
+	}
+
+	return \@not_allowed
+}
+
+
+__PACKAGE__->register_method(
+	method => 'check_user_perms3',
+	api_name	=> 'open-ils.actor.user.perm.highest_org',
+	notes		=> q/
+		Returns the highest org unit id at which a user has a given permission
+		If the requestor does not match the target user, the requestor must have
+		'VIEW_PERMISSION' rights at the home org unit of the target user
+		@param authtoken The login session key
+		@param userid The id of the user in question
+		@param perm The permission to check
+		@return The org unit highest in the org tree within which the user has
+		the requested permission
+	/);
+
+sub check_user_perms3 {
+	my($self, $client, $authtoken, $user_id, $perm) = @_;
+	my $e = new_editor(authtoken=>$authtoken);
+	return $e->event unless $e->checkauth;
+
+	my $tree = $U->get_org_tree();
+
+    unless($e->requestor->id == $user_id) {
+        my $user = $e->retrieve_actor_user($user_id)
+            or return $e->event;
+        return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
+	    return $U->find_highest_perm_org($perm, $user_id, $user->home_ou, $tree );
+    }
+
+    return $U->find_highest_perm_org($perm, $user_id, $e->requestor->ws_ou, $tree);
+}
+
+__PACKAGE__->register_method(
+	method => 'user_has_work_perm_at',
+	api_name	=> 'open-ils.actor.user.has_work_perm_at',
+    authoritative => 1,
+    signature => {
+        desc => q/
+            Returns a set of org unit IDs which represent the highest orgs in 
+            the org tree where the user has the requested permission.  The
+            purpose of this method is to return the smallest set of org units
+            which represent the full expanse of the user's ability to perform
+            the requested action.  The user whose perms this method should
+            check is implied by the authtoken. /,
+        params => [
+		    {desc => 'authtoken', type => 'string'},
+            {desc => 'permission name', type => 'string'},
+            {desc => q/user id, optional.  If present, check perms for 
+                this user instead of the logged in user/, type => 'number'},
+        ],
+        return => {desc => 'An array of org IDs'}
+    }
+);
+
+sub user_has_work_perm_at {
+    my($self, $conn, $auth, $perm, $user_id) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    if(defined $user_id) {
+        my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+        return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
+    }
+    return $U->user_has_work_perm_at($e, $perm, undef, $user_id);
+}
+
+__PACKAGE__->register_method(
+	method => 'user_has_work_perm_at_batch',
+	api_name	=> 'open-ils.actor.user.has_work_perm_at.batch',
+    authoritative => 1,
+);
+
+sub user_has_work_perm_at_batch {
+    my($self, $conn, $auth, $perms, $user_id) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    if(defined $user_id) {
+        my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+        return $e->event unless $e->allowed('VIEW_PERMISSION', $user->home_ou);
+    }
+    my $map = {};
+    $map->{$_} = $U->user_has_work_perm_at($e, $_) for @$perms;
+    return $map;
+}
+
+
+
+__PACKAGE__->register_method(
+	method => 'check_user_perms4',
+	api_name	=> 'open-ils.actor.user.perm.highest_org.batch',
+	notes		=> q/
+		Returns the highest org unit id at which a user has a given permission
+		If the requestor does not match the target user, the requestor must have
+		'VIEW_PERMISSION' rights at the home org unit of the target user
+		@param authtoken The login session key
+		@param userid The id of the user in question
+		@param perms An array of perm names to check 
+		@return An array of orgId's  representing the org unit 
+		highest in the org tree within which the user has the requested permission
+		The arrah of orgId's has matches the order of the perms array
+	/);
+
+sub check_user_perms4 {
+	my( $self, $client, $authtoken, $userid, $perms ) = @_;
+	
+	my( $staff, $target, $org, $evt );
+
+	( $staff, $target, $evt ) = $apputils->checkses_requestor(
+		$authtoken, $userid, 'VIEW_PERMISSION' );
+	return $evt if $evt;
+
+	my @arr;
+	return [] unless ref($perms);
+	my $tree = $U->get_org_tree();
+
+	for my $p (@$perms) {
+		push( @arr, $U->find_highest_perm_org( $p, $userid, $target->home_ou, $tree ) );
+	}
+	return \@arr;
+}
+
+
+__PACKAGE__->register_method(
+    method        => "user_fines_summary",
+    api_name      => "open-ils.actor.user.fines.summary",
+    authoritative => 1,
+    signature     => {
+        desc   => 'Returns a short summary of the users total open fines, '  .
+                  'excluding voided fines Params are login_session, user_id' ,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'User ID',              type => 'string'}  # number?
+        ],
+        return => {
+            desc => "a 'mous' object, event on error",
+        }
+    }
+);
+
+sub user_fines_summary {
+	my( $self, $client, $auth, $user_id ) = @_;
+
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+
+	if( $user_id ne $e->requestor->id ) {
+	    my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+		return $e->event unless 
+			$e->allowed('VIEW_USER_FINES_SUMMARY', $user->home_ou);
+	}
+
+    return $e->search_money_open_user_summary({usr => $user_id})->[0];
+}
+
+
+__PACKAGE__->register_method(
+    method        => "user_opac_vitals",
+    api_name      => "open-ils.actor.user.opac.vital_stats",
+    argc          => 1,
+    authoritative => 1,
+    signature     => {
+        desc   => 'Returns a short summary of the users vital stats, including '  .
+                  'identification information, accumulated balance, number of holds, ' .
+                  'and current open circulation stats' ,
+        params => [
+            {desc => 'Authentication token',                          type => 'string'},
+            {desc => 'Optional User ID, for use in the staff client', type => 'number'}  # number?
+        ],
+        return => {
+            desc => "An object with four properties: user, fines, checkouts and holds."
+        }
+    }
+);
+
+sub user_opac_vitals {
+	my( $self, $client, $auth, $user_id ) = @_;
+
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+
+    $user_id ||= $e->requestor->id;
+
+    my $user = $e->retrieve_actor_user( $user_id );
+
+    my ($fines) = $self
+        ->method_lookup('open-ils.actor.user.fines.summary')
+        ->run($auth => $user_id);
+    return $fines if (defined($U->event_code($fines)));
+
+    if (!$fines) {
+        $fines = new Fieldmapper::money::open_user_summary ();
+        $fines->balance_owed(0.00);
+        $fines->total_owed(0.00);
+        $fines->total_paid(0.00);
+        $fines->usr($user_id);
+    }
+
+    my ($holds) = $self
+        ->method_lookup('open-ils.actor.user.hold_requests.count')
+        ->run($auth => $user_id);
+    return $holds if (defined($U->event_code($holds)));
+
+    my ($out) = $self
+        ->method_lookup('open-ils.actor.user.checked_out.count')
+        ->run($auth => $user_id);
+    return $out if (defined($U->event_code($out)));
+
+    return {
+        user => {
+            first_given_name  => $user->first_given_name,
+            second_given_name => $user->second_given_name,
+            family_name       => $user->family_name,
+            alias             => $user->alias,
+            usrname           => $user->usrname
+        },
+        fines => $fines->to_bare_hash,
+        checkouts => $out,
+        holds => $holds
+    };
+}
+
+
+##### a small consolidation of related method registrations
+my $common_params = [
+    { desc => 'Authentication token', type => 'string' },
+    { desc => 'User ID',              type => 'string' },
+    { desc => 'Transactions type (optional, defaults to all)', type => 'string' },
+    { desc => 'Options hash.  May contain limit and offset for paged results.', type => 'object' },
+];
+my %methods = (
+    'open-ils.actor.user.transactions'                      => '',
+    'open-ils.actor.user.transactions.fleshed'              => '',
+    'open-ils.actor.user.transactions.have_charge'          => ' that have an initial charge',
+    'open-ils.actor.user.transactions.have_charge.fleshed'  => ' that have an initial charge',
+    'open-ils.actor.user.transactions.have_balance'         => ' that have an outstanding balance',
+    'open-ils.actor.user.transactions.have_balance.fleshed' => ' that have an outstanding balance',
+);
+
+foreach (keys %methods) {
+    my %args = (
+        method    => "user_transactions",
+        api_name  => $_,
+        signature => {
+            desc   => 'For a given user, retrieve a list of '
+                    . (/\.fleshed/ ? 'fleshed ' : '')
+                    . 'transactions' . $methods{$_}
+                    . ' optionally limited to transactions of a given type.',
+            params => $common_params,
+            return => {
+                desc => "List of objects, or event on error.  Each object is a hash containing: transaction, circ, record. "
+                      . 'These represent the relevant (mbts) transaction, attached circulation and title pointed to in the circ, respectively.',
+            }
+        }
+    );
+    /\.have_balance/ and $args{authoritative} = 1;     # FIXME: I don't know why have_charge isn't authoritative
+    __PACKAGE__->register_method(%args);
+}
+
+# Now for the counts
+%methods = (
+    'open-ils.actor.user.transactions.count'              => '',
+    'open-ils.actor.user.transactions.have_charge.count'  => ' that have an initial charge',
+    'open-ils.actor.user.transactions.have_balance.count' => ' that have an outstanding balance',
+);
+
+foreach (keys %methods) {
+    my %args = (
+        method    => "user_transactions",
+        api_name  => $_,
+        signature => {
+            desc   => 'For a given user, retrieve a count of open '
+                    . 'transactions' . $methods{$_}
+                    . ' optionally limited to transactions of a given type.',
+            params => $common_params,
+            return => { desc => "Integer count of transactions, or event on error" }
+        }
+    );
+    /\.have_balance/ and $args{authoritative} = 1;     # FIXME: I don't know why have_charge isn't authoritative
+    __PACKAGE__->register_method(%args);
+}
+
+__PACKAGE__->register_method(
+    method        => "user_transactions",
+    api_name      => "open-ils.actor.user.transactions.have_balance.total",
+    authoritative => 1,
+    signature     => {
+        desc   => 'For a given user, retrieve the total balance owed for open transactions,'
+                . ' optionally limited to transactions of a given type.',
+        params => $common_params,
+        return => { desc => "Decimal balance value, or event on error" }
+    }
+);
+
+
+sub user_transactions {
+	my( $self, $client, $login_session, $user_id, $type, $options ) = @_;
+    $options ||= {};
+
+	my( $user_obj, $target, $evt ) = $apputils->checkses_requestor(
+		$login_session, $user_id, 'VIEW_USER_TRANSACTIONS' );
+	return $evt if $evt;
+
+    my $api = $self->api_name();
+
+    my $filter = ($api =~ /have_balance/o) ?
+        { 'balance_owed' => { '<>' => 0 } }:
+        { 'total_owed' => { '>' => 0 } };
+
+    my ($trans) = $self->method_lookup(
+        'open-ils.actor.user.transactions.history.still_open')
+      ->run( $login_session, $user_id, $type, $filter, $options );
+
+	if($api =~ /total/o) { 
+		my $total = 0.0;
+		for my $t (@$trans) {
+			$total += $t->balance_owed;
+		}
+
+		$logger->debug("Total balance owed by user $user_id: $total");
+		return $total;
+	}
+
+    ($api =~ /count/o  ) and return scalar @$trans;
+    ($api !~ /fleshed/o) and return $trans;
+
+	my @resp;
+	for my $t (@$trans) {
+			
+		if( $t->xact_type ne 'circulation' ) {
+			push @resp, {transaction => $t};
+			next;
+		}
+
+		my $circ = $apputils->simple_scalar_request(
+				"open-ils.cstore",
+				"open-ils.cstore.direct.action.circulation.retrieve",
+				$t->id );
+
+		next unless $circ;
+
+		my $title = $apputils->simple_scalar_request(
+			"open-ils.storage", 
+			"open-ils.storage.fleshed.biblio.record_entry.retrieve_by_copy",
+			$circ->target_copy );
+
+		next unless $title;
+
+		my $u = OpenILS::Utils::ModsParser->new();
+		$u->start_mods_batch($title->marc());
+		my $mods = $u->finish_mods_batch();
+		$mods->doc_id($title->id) if $mods;
+
+		push @resp, {transaction => $t, circ => $circ, record => $mods };
+
+	}
+
+	return \@resp; 
+} 
+
+
+__PACKAGE__->register_method(
+    method   => "user_transaction_retrieve",
+    api_name => "open-ils.actor.user.transaction.fleshed.retrieve",
+    argc     => 1,
+    notes    => "Returns a fleshed transaction record"
+);
+
+__PACKAGE__->register_method(
+    method   => "user_transaction_retrieve",
+    api_name => "open-ils.actor.user.transaction.retrieve",
+    argc     => 1,
+    notes    => "Returns a transaction record"
+);
+
+sub user_transaction_retrieve {
+	my( $self, $client, $login_session, $bill_id ) = @_;
+
+	# I think I'm deprecated... make sure.   phasefx says, "No, I'll use you :)
+
+	my $trans = $apputils->simple_scalar_request( 
+		"open-ils.cstore",
+		"open-ils.cstore.direct.money.billable_transaction_summary.retrieve",
+		$bill_id
+	);
+
+	my( $user_obj, $target, $evt ) = $apputils->checkses_requestor(
+		$login_session, $trans->usr, 'VIEW_USER_TRANSACTIONS' );
+	return $evt if $evt;
+	
+	my $api = $self->api_name();
+	if($api !~ /fleshed/o) { return $trans; }
+
+	if( $trans->xact_type ne 'circulation' ) {
+		$logger->debug("Returning non-circ transaction");
+		return {transaction => $trans};
+	}
+
+	my $circ = $apputils->simple_scalar_request(
+			"open-ils.cstore",
+			"open-ils.cstore.direct.action.circulation.retrieve",
+			$trans->id );
+
+	return {transaction => $trans} unless $circ;
+	$logger->debug("Found the circ transaction");
+
+	my $title = $apputils->simple_scalar_request(
+		"open-ils.storage", 
+		"open-ils.storage.fleshed.biblio.record_entry.retrieve_by_copy",
+		$circ->target_copy );
+
+	return {transaction => $trans, circ => $circ } unless $title;
+	$logger->debug("Found the circ title");
+
+	my $mods;
+    my $copy = $apputils->simple_scalar_request(
+        "open-ils.cstore",
+        "open-ils.cstore.direct.asset.copy.retrieve",
+        $circ->target_copy );
+
+	try {
+		my $u = OpenILS::Utils::ModsParser->new();
+		$u->start_mods_batch($title->marc());
+		$mods = $u->finish_mods_batch();
+	} otherwise {
+		if ($title->id == OILS_PRECAT_RECORD) {
+			$mods = new Fieldmapper::metabib::virtual_record;
+			$mods->doc_id(OILS_PRECAT_RECORD);
+			$mods->title($copy->dummy_title);
+			$mods->author($copy->dummy_author);
+		}
+	};
+
+	$logger->debug("MODSized the circ title");
+
+	return {transaction => $trans, circ => $circ, record => $mods, copy => $copy };
+}
+
+
+__PACKAGE__->register_method(
+    method        => "hold_request_count",
+    api_name      => "open-ils.actor.user.hold_requests.count",
+    authoritative => 1,
+    argc          => 1,
+    notes         => 'Returns hold ready/total counts'
+);
+	
+sub hold_request_count {
+	my( $self, $client, $login_session, $userid ) = @_;
+
+	my( $user_obj, $target, $evt ) = $apputils->checkses_requestor(
+		$login_session, $userid, 'VIEW_HOLD' );
+	return $evt if $evt;
+	
+
+	my $holds = $apputils->simple_scalar_request(
+			"open-ils.cstore",
+			"open-ils.cstore.direct.action.hold_request.search.atomic",
+			{ 
+				usr => $userid,
+				fulfillment_time => {"=" => undef },
+				cancel_time => undef,
+			}
+	);
+
+	my @ready;
+	for my $h (@$holds) {
+		next unless $h->capture_time and $h->current_copy;
+
+		my $copy = $apputils->simple_scalar_request(
+			"open-ils.cstore",
+			"open-ils.cstore.direct.asset.copy.retrieve",
+			$h->current_copy
+		);
+
+		if ($copy and $copy->status == 8) {
+			push @ready, $h;
+		}
+	}
+
+	return { total => scalar(@$holds), ready => scalar(@ready) };
+}
+
+__PACKAGE__->register_method(
+    method        => "checked_out",
+    api_name      => "open-ils.actor.user.checked_out",
+    authoritative => 1,
+    argc          => 2,
+	signature     => {
+        desc => "For a given user, returns a structure of circulations objects sorted by out, overdue, lost, claims_returned, long_overdue. "
+              . "A list of IDs are returned of each type.  Circs marked lost, long_overdue, and claims_returned will not be 'finished' "
+              . "(i.e., outstanding balance or some other pending action on the circ). "
+              . "The .count method also includes a 'total' field which sums all open circs.",
+        params => [
+            { desc => 'Authentication Token', type => 'string'},
+            { desc => 'User ID',              type => 'string'},
+        ],
+        return => {
+            desc => 'Returns event on error, or an object with ID lists, like: '
+                  . '{"out":[12552,451232], "claims_returned":[], "long_overdue":[23421] "overdue":[], "lost":[]}'
+        },
+    }
+);
+
+__PACKAGE__->register_method(
+    method        => "checked_out",
+    api_name      => "open-ils.actor.user.checked_out.count",
+    authoritative => 1,
+    argc          => 2,
+    signature     => q/@see open-ils.actor.user.checked_out/
+);
+
+sub checked_out {
+	my( $self, $conn, $auth, $userid ) = @_;
+
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+
+	if( $userid ne $e->requestor->id ) {
+        my $user = $e->retrieve_actor_user($userid) or return $e->event;
+		unless($e->allowed('VIEW_CIRCULATIONS', $user->home_ou)) {
+
+            # see if there is a friend link allowing circ.view perms
+            my $allowed = OpenILS::Application::Actor::Friends->friend_perm_allowed(
+                $e, $userid, $e->requestor->id, 'circ.view');
+            return $e->event unless $allowed;
+        }
+	}
+
+	my $count = $self->api_name =~ /count/;
+	return _checked_out( $count, $e, $userid );
+}
+
+sub _checked_out {
+	my( $iscount, $e, $userid ) = @_;
+
+    my %result = (
+        out => [],
+        overdue => [],
+        lost => [],
+        claims_returned => [],
+        long_overdue => []
+    );
+	my $meth = 'retrieve_action_open_circ_';
+
+    if ($iscount) {
+	    $meth .= 'count';
+        %result = (
+            out => 0,
+            overdue => 0,
+            lost => 0,
+            claims_returned => 0,
+            long_overdue => 0
+        );
+    } else {
+	    $meth .= 'list';
+    }
+
+    my $data = $e->$meth($userid);
+
+    if ($data) {
+        if ($iscount) {
+            $result{$_} += $data->$_() for (keys %result);
+            $result{total} += $data->$_() for (keys %result);
+        } else {
+            for my $k (keys %result) {
+                $result{$k} = [ grep { $_ > 0 } split( ',', $data->$k()) ];
+            }
+        }
+    }
+
+    return \%result;
+}
+
+
+
+__PACKAGE__->register_method(
+    method        => "checked_in_with_fines",
+    api_name      => "open-ils.actor.user.checked_in_with_fines",
+    authoritative => 1,
+    argc          => 2,
+    signature     => q/@see open-ils.actor.user.checked_out/
+);
+
+sub checked_in_with_fines {
+	my( $self, $conn, $auth, $userid ) = @_;
+
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+
+	if( $userid ne $e->requestor->id ) {
+		return $e->event unless $e->allowed('VIEW_CIRCULATIONS');
+	}
+
+	# money is owed on these items and they are checked in
+	my $open = $e->search_action_circulation(
+		{
+			usr				=> $userid, 
+			xact_finish		=> undef,
+			checkin_time	=> { "!=" => undef },
+		}
+	);
+
+
+	my( @lost, @cr, @lo );
+	for my $c (@$open) {
+		push( @lost, $c->id ) if $c->stop_fines eq 'LOST';
+		push( @cr, $c->id ) if $c->stop_fines eq 'CLAIMSRETURNED';
+		push( @lo, $c->id ) if $c->stop_fines eq 'LONGOVERDUE';
+	}
+
+	return {
+		lost		=> \@lost,
+		claims_returned	=> \@cr,
+		long_overdue		=> \@lo
+	};
+}
+
+
+sub _sigmaker {
+    my ($api, $desc, $auth) = @_;
+    $desc = $desc ? (" " . $desc) : '';
+    my $ids = ($api =~ /ids$/) ? 1 : 0;
+    my @sig = (
+        argc      => 1,
+        method    => "user_transaction_history",
+        api_name  => "open-ils.actor.user.transactions.$api",
+        signature => {
+            desc   => "For a given User ID, returns a list of billable transaction" .
+                      ($ids ? " id" : '') .
+                      "s$desc, optionally filtered by type and/or fields in money.billable_xact_summary.  " .
+                      "The VIEW_USER_TRANSACTIONS permission is required to view another user's transactions",
+            params => [
+                {desc => 'Authentication token',        type => 'string'},
+                {desc => 'User ID',                     type => 'number'},
+                {desc => 'Transaction type (optional)', type => 'number'},
+                {desc => 'Hash of Billable Transaction Summary filters (optional)', type => 'object'}
+            ],
+            return => {
+                desc => 'List of transaction' . ($ids ? " id" : '') . 's, Event on error'
+            },
+        }
+    );
+    $auth and push @sig, (authoritative => 1);
+    return @sig;
+}
+
+my %hist_methods = (
+    'history'             => '',
+    'history.have_charge' => 'that have an initial charge',
+    'history.still_open'  => 'that are not finished',
+);
+my %auth_hist_methods = (
+    'history.have_balance'         => 'that have a balance',
+    'history.have_bill'            => 'that have billings',
+    'history.have_bill_or_payment' => 'that have non-zero-sum billings or at least 1 payment',
+);
+foreach (keys %hist_methods) {
+    __PACKAGE__->register_method(_sigmaker($_,       $hist_methods{$_}));
+    __PACKAGE__->register_method(_sigmaker("$_.ids", $hist_methods{$_}));
+}
+foreach (keys %auth_hist_methods) {
+    __PACKAGE__->register_method(_sigmaker($_,       $auth_hist_methods{$_}, 1));
+    __PACKAGE__->register_method(_sigmaker("$_.ids", $auth_hist_methods{$_}, 1));
+}
+
+sub user_transaction_history {
+	my( $self, $conn, $auth, $userid, $type, $filter, $options ) = @_;
+    $filter ||= {};
+    $options ||= {};
+
+	my $e = new_editor(authtoken=>$auth);
+	return $e->die_event unless $e->checkauth;
+
+	if ($e->requestor->id ne $userid) {
+        return $e->die_event unless $e->allowed('VIEW_USER_TRANSACTIONS');
+	}
+
+	my $api = $self->api_name;
+	my @xact_finish  = (xact_finish => undef ) if ($api =~ /history\.still_open$/);     # What about history.still_open.ids?
+
+	if(defined($type)) {
+		$filter->{'xact_type'} = $type;
+	}
+
+	if($api =~ /have_bill_or_payment/o) {
+
+        # transactions that have a non-zero sum across all billings or at least 1 payment
+        $filter->{'-or'} = {
+            'balance_owed' => { '<>' => 0 },
+            'last_payment_ts' => { '<>' => undef }
+        };
+
+    } elsif( $api =~ /have_balance/o) {
+
+        # transactions that have a non-zero overall balance
+        $filter->{'balance_owed'} = { '<>' => 0 };
+
+	} elsif( $api =~ /have_charge/o) {
+
+        # transactions that have at least 1 billing, regardless of whether it was voided
+        $filter->{'last_billing_ts'} = { '<>' => undef };
+
+	} elsif( $api =~ /have_bill/o) {    # needs to be an elsif, or we double-match have_bill_or_payment!
+
+        # transactions that have non-zero sum across all billings.  This will exclude
+        # xacts where all billings have been voided
+        $filter->{'total_owed'} = { '<>' => 0 };
+	}
+
+    my $options_clause = { order_by => { mbt => 'xact_start DESC' } };
+    $options_clause->{'limit'} = $options->{'limit'} if $options->{'limit'}; 
+    $options_clause->{'offset'} = $options->{'offset'} if $options->{'offset'}; 
+
+    my $mbts = $e->search_money_billable_transaction_summary(
+        [ 
+            { usr => $userid, @xact_finish, %$filter },
+            $options_clause
+        ]
+    );
+
+    if ($api =~ /\.ids/) {
+    	return [map {$_->id} @$mbts];
+    } else {
+        return $mbts;
+    }
+}
+
+
+
+__PACKAGE__->register_method(
+    method   => "user_perms",
+    api_name => "open-ils.actor.permissions.user_perms.retrieve",
+    argc     => 1,
+    notes    => "Returns a list of permissions"
+);
+	
+sub user_perms {
+	my( $self, $client, $authtoken, $user ) = @_;
+
+	my( $staff, $evt ) = $apputils->checkses($authtoken);
+	return $evt if $evt;
+
+	$user ||= $staff->id;
+
+	if( $user != $staff->id and $evt = $apputils->check_perms( $staff->id, $staff->home_ou, 'VIEW_PERMISSION') ) {
+		return $evt;
+	}
+
+	return $apputils->simple_scalar_request(
+		"open-ils.storage",
+		"open-ils.storage.permission.user_perms.atomic",
+		$user);
+}
+
+__PACKAGE__->register_method(
+    method   => "retrieve_perms",
+    api_name => "open-ils.actor.permissions.retrieve",
+    notes    => "Returns a list of permissions"
+);
+sub retrieve_perms {
+	my( $self, $client ) = @_;
+	return $apputils->simple_scalar_request(
+		"open-ils.cstore",
+		"open-ils.cstore.direct.permission.perm_list.search.atomic",
+		{ id => { '!=' => undef } }
+	);
+}
+
+__PACKAGE__->register_method(
+    method   => "retrieve_groups",
+    api_name => "open-ils.actor.groups.retrieve",
+    notes    => "Returns a list of user groups"
+);
+sub retrieve_groups {
+	my( $self, $client ) = @_;
+	return new_editor()->retrieve_all_permission_grp_tree();
+}
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_org_address",
+	api_name	=> "open-ils.actor.org_unit.address.retrieve",
+	notes		=> <<'	NOTES');
+	Returns an org_unit address by ID
+	@param An org_address ID
+	NOTES
+sub retrieve_org_address {
+	my( $self, $client, $id ) = @_;
+	return $apputils->simple_scalar_request(
+		"open-ils.cstore",
+		"open-ils.cstore.direct.actor.org_address.retrieve",
+		$id
+	);
+}
+
+__PACKAGE__->register_method(
+    method   => "retrieve_groups_tree",
+    api_name => "open-ils.actor.groups.tree.retrieve",
+    notes    => "Returns a list of user groups"
+);
+	
+sub retrieve_groups_tree {
+	my( $self, $client ) = @_;
+	return new_editor()->search_permission_grp_tree(
+		[
+			{ parent => undef},
+			{	
+				flesh				=> -1,
+				flesh_fields	=> { pgt => ["children"] }, 
+				order_by			=> { pgt => 'name'}
+			}
+		]
+	)->[0];
+}
+
+
+__PACKAGE__->register_method(
+    method   => "add_user_to_groups",
+    api_name => "open-ils.actor.user.set_groups",
+    notes    => "Adds a user to one or more permission groups"
+);
+	
+sub add_user_to_groups {
+	my( $self, $client, $authtoken, $userid, $groups ) = @_;
+
+	my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
+		$authtoken, $userid, 'CREATE_USER_GROUP_LINK' );
+	return $evt if $evt;
+
+	( $requestor, $target, $evt ) = $apputils->checkses_requestor(
+		$authtoken, $userid, 'REMOVE_USER_GROUP_LINK' );
+	return $evt if $evt;
+
+	$apputils->simplereq(
+		'open-ils.storage',
+		'open-ils.storage.direct.permission.usr_grp_map.mass_delete', { usr => $userid } );
+		
+	for my $group (@$groups) {
+		my $link = Fieldmapper::permission::usr_grp_map->new;
+		$link->grp($group);
+		$link->usr($userid);
+
+		my $id = $apputils->simplereq(
+			'open-ils.storage',
+			'open-ils.storage.direct.permission.usr_grp_map.create', $link );
+	}
+
+	return 1;
+}
+
+__PACKAGE__->register_method(
+    method   => "get_user_perm_groups",
+    api_name => "open-ils.actor.user.get_groups",
+    notes    => "Retrieve a user's permission groups."
+);
+
+
+sub get_user_perm_groups {
+	my( $self, $client, $authtoken, $userid ) = @_;
+
+	my( $requestor, $target, $evt ) = $apputils->checkses_requestor(
+		$authtoken, $userid, 'VIEW_PERM_GROUPS' );
+	return $evt if $evt;
+
+	return $apputils->simplereq(
+		'open-ils.cstore',
+		'open-ils.cstore.direct.permission.usr_grp_map.search.atomic', { usr => $userid } );
+}	
+
+
+__PACKAGE__->register_method(
+    method   => "get_user_work_ous",
+    api_name => "open-ils.actor.user.get_work_ous",
+    notes    => "Retrieve a user's work org units."
+);
+
+__PACKAGE__->register_method(
+    method   => "get_user_work_ous",
+    api_name => "open-ils.actor.user.get_work_ous.ids",
+    notes    => "Retrieve a user's work org units."
+);
+
+sub get_user_work_ous {
+	my( $self, $client, $auth, $userid ) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    $userid ||= $e->requestor->id;
+
+    if($e->requestor->id != $userid) {
+        my $user = $e->retrieve_actor_user($userid)
+            or return $e->event;
+        return $e->event unless $e->allowed('ASSIGN_WORK_ORG_UNIT', $user->home_ou);
+    }
+
+    return $e->search_permission_usr_work_ou_map({usr => $userid})
+        unless $self->api_name =~ /.ids$/;
+
+    # client just wants a list of org IDs
+    return $U->get_user_work_ou_ids($e, $userid);
+}	
+
+
+
+__PACKAGE__->register_method(
+    method    => 'register_workstation',
+    api_name  => 'open-ils.actor.workstation.register.override',
+    signature => q/@see open-ils.actor.workstation.register/
+);
+
+__PACKAGE__->register_method(
+    method    => 'register_workstation',
+    api_name  => 'open-ils.actor.workstation.register',
+    signature => q/
+		Registers a new workstion in the system
+		@param authtoken The login session key
+		@param name The name of the workstation id
+		@param owner The org unit that owns this workstation
+		@return The workstation id on success, WORKSTATION_NAME_EXISTS
+		if the name is already in use.
+	/
+);
+
+sub register_workstation {
+	my( $self, $conn, $authtoken, $name, $owner ) = @_;
+
+	my $e = new_editor(authtoken=>$authtoken, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('REGISTER_WORKSTATION', $owner);
+	my $existing = $e->search_actor_workstation({name => $name})->[0];
+
+	if( $existing ) {
+
+		if( $self->api_name =~ /override/o ) {
+            # workstation with the given name exists.  
+
+            if($owner ne $existing->owning_lib) {
+                # if necessary, update the owning_lib of the workstation
+
+                $logger->info("changing owning lib of workstation ".$existing->id.
+                    " from ".$existing->owning_lib." to $owner");
+			    return $e->die_event unless 
+                    $e->allowed('UPDATE_WORKSTATION', $existing->owning_lib); 
+
+			    return $e->die_event unless $e->allowed('UPDATE_WORKSTATION', $owner); 
+
+                $existing->owning_lib($owner);
+			    return $e->die_event unless $e->update_actor_workstation($existing);
+
+                $e->commit;
+
+            } else {
+                $logger->info(  
+                    "attempt to register an existing workstation.  returning existing ID");
+            }
+
+            return $existing->id;
+
+		} else {
+			return OpenILS::Event->new('WORKSTATION_NAME_EXISTS')
+		}
+	}
+
+	my $ws = Fieldmapper::actor::workstation->new;
+	$ws->owning_lib($owner);
+	$ws->name($name);
+	$e->create_actor_workstation($ws) or return $e->die_event;
+	$e->commit;
+	return $ws->id; # note: editor sets the id on the new object for us
+}
+
+__PACKAGE__->register_method(
+    method    => 'workstation_list',
+    api_name  => 'open-ils.actor.workstation.list',
+    signature => q/
+		Returns a list of workstations registered at the given location
+		@param authtoken The login session key
+		@param ids A list of org_unit.id's for the workstation owners
+	/
+);
+
+sub workstation_list {
+	my( $self, $conn, $authtoken, @orgs ) = @_;
+
+	my $e = new_editor(authtoken=>$authtoken);
+	return $e->event unless $e->checkauth;
+    my %results;
+
+    for my $o (@orgs) {
+	    return $e->event 
+            unless $e->allowed('REGISTER_WORKSTATION', $o);
+        $results{$o} = $e->search_actor_workstation({owning_lib=>$o});
+    }
+    return \%results;
+}
+
+
+__PACKAGE__->register_method(
+    method        => 'fetch_patron_note',
+    api_name      => 'open-ils.actor.note.retrieve.all',
+    authoritative => 1,
+    signature     => q/
+		Returns a list of notes for a given user
+		Requestor must have VIEW_USER permission if pub==false and
+		@param authtoken The login session key
+		@param args Hash of params including
+			patronid : the patron's id
+			pub : true if retrieving only public notes
+	/
+);
+
+sub fetch_patron_note {
+	my( $self, $conn, $authtoken, $args ) = @_;
+	my $patronid = $$args{patronid};
+
+	my($reqr, $evt) = $U->checkses($authtoken);
+	return $evt if $evt;
+
+	my $patron;
+	($patron, $evt) = $U->fetch_user($patronid);
+	return $evt if $evt;
+
+	if($$args{pub}) {
+		if( $patronid ne $reqr->id ) {
+			$evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
+			return $evt if $evt;
+		}
+		return $U->cstorereq(
+			'open-ils.cstore.direct.actor.usr_note.search.atomic', 
+			{ usr => $patronid, pub => 't' } );
+	}
+
+	$evt = $U->check_perms($reqr->id, $patron->home_ou, 'VIEW_USER');
+	return $evt if $evt;
+
+	return $U->cstorereq(
+		'open-ils.cstore.direct.actor.usr_note.search.atomic', { usr => $patronid } );
+}
+
+__PACKAGE__->register_method(
+    method    => 'create_user_note',
+    api_name  => 'open-ils.actor.note.create',
+    signature => q/
+		Creates a new note for the given user
+		@param authtoken The login session key
+		@param note The note object
+	/
+);
+sub create_user_note {
+	my( $self, $conn, $authtoken, $note ) = @_;
+	my $e = new_editor(xact=>1, authtoken=>$authtoken);
+	return $e->die_event unless $e->checkauth;
+
+	my $user = $e->retrieve_actor_user($note->usr)
+		or return $e->die_event;
+
+	return $e->die_event unless 
+		$e->allowed('UPDATE_USER',$user->home_ou);
+
+	$note->creator($e->requestor->id);
+	$e->create_actor_usr_note($note) or return $e->die_event;
+	$e->commit;
+	return $note->id;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'delete_user_note',
+    api_name  => 'open-ils.actor.note.delete',
+    signature => q/
+		Deletes a note for the given user
+		@param authtoken The login session key
+		@param noteid The note id
+	/
+);
+sub delete_user_note {
+	my( $self, $conn, $authtoken, $noteid ) = @_;
+
+	my $e = new_editor(xact=>1, authtoken=>$authtoken);
+	return $e->die_event unless $e->checkauth;
+	my $note = $e->retrieve_actor_usr_note($noteid)
+		or return $e->die_event;
+	my $user = $e->retrieve_actor_user($note->usr)
+		or return $e->die_event;
+	return $e->die_event unless 
+		$e->allowed('UPDATE_USER', $user->home_ou);
+	
+	$e->delete_actor_usr_note($note) or return $e->die_event;
+	$e->commit;
+	return 1;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'update_user_note',
+    api_name  => 'open-ils.actor.note.update',
+    signature => q/
+		@param authtoken The login session key
+		@param note The note
+	/
+);
+
+sub update_user_note {
+	my( $self, $conn, $auth, $note ) = @_;
+	my $e = new_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	my $patron = $e->retrieve_actor_user($note->usr)
+		or return $e->die_event;
+	return $e->die_event unless 
+		$e->allowed('UPDATE_USER', $patron->home_ou);
+	$e->update_actor_user_note($note)
+		or return $e->die_event;
+	$e->commit;
+	return 1;
+}
+
+
+
+__PACKAGE__->register_method(
+    method    => 'create_closed_date',
+    api_name  => 'open-ils.actor.org_unit.closed_date.create',
+    signature => q/
+		Creates a new closing entry for the given org_unit
+		@param authtoken The login session key
+		@param note The closed_date object
+	/
+);
+sub create_closed_date {
+	my( $self, $conn, $authtoken, $cd ) = @_;
+
+	my( $user, $evt ) = $U->checkses($authtoken);
+	return $evt if $evt;
+
+	$evt = $U->check_perms($user->id, $cd->org_unit, 'CREATE_CLOSEING');
+	return $evt if $evt;
+
+	$logger->activity("user ".$user->id." creating library closing for ".$cd->org_unit);
+
+	my $id = $U->storagereq(
+		'open-ils.storage.direct.actor.org_unit.closed_date.create', $cd );
+	return $U->DB_UPDATE_FAILED($cd) unless $id;
+	return $id;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'delete_closed_date',
+    api_name  => 'open-ils.actor.org_unit.closed_date.delete',
+    signature => q/
+		Deletes a closing entry for the given org_unit
+		@param authtoken The login session key
+		@param noteid The close_date id
+	/
+);
+sub delete_closed_date {
+	my( $self, $conn, $authtoken, $cd ) = @_;
+
+	my( $user, $evt ) = $U->checkses($authtoken);
+	return $evt if $evt;
+
+	my $cd_obj;
+	($cd_obj, $evt) = fetch_closed_date($cd);
+	return $evt if $evt;
+
+	$evt = $U->check_perms($user->id, $cd->org_unit, 'DELETE_CLOSEING');
+	return $evt if $evt;
+
+	$logger->activity("user ".$user->id." deleting library closing for ".$cd->org_unit);
+
+	my $stat = $U->storagereq(
+		'open-ils.storage.direct.actor.org_unit.closed_date.delete', $cd );
+	return $U->DB_UPDATE_FAILED($cd) unless $stat;
+	return $stat;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'usrname_exists',
+    api_name  => 'open-ils.actor.username.exists',
+    signature => {
+        desc  => 'Check if a username is already taken (by an undeleted patron)',
+        param => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Username',             type => 'string'}
+        ],
+        return => {
+            desc => 'id of existing user if username exists, undef otherwise.  Event on error'
+        },
+    }
+);
+
+sub usrname_exists {
+	my( $self, $conn, $auth, $usrname ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	my $a = $e->search_actor_user({usrname => $usrname, deleted=>'f'}, {idlist=>1});
+	return $$a[0] if $a and @$a;
+	return undef;
+}
+
+__PACKAGE__->register_method(
+    method        => 'barcode_exists',
+    api_name      => 'open-ils.actor.barcode.exists',
+    authoritative => 1,
+    signature     => 'Returns 1 if the requested barcode exists, returns 0 otherwise'
+);
+
+sub barcode_exists {
+	my( $self, $conn, $auth, $barcode ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	my $card = $e->search_actor_card({barcode => $barcode});
+	if (@$card) {
+		return 1;
+	} else {
+		return 0;
+	}
+	#return undef unless @$card;
+	#return $card->[0]->usr;
+}
+
+
+__PACKAGE__->register_method(
+    method   => 'retrieve_net_levels',
+    api_name => 'open-ils.actor.net_access_level.retrieve.all',
+);
+
+sub retrieve_net_levels {
+	my( $self, $conn, $auth ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->retrieve_all_config_net_access_level();
+}
+
+# Retain the old typo API name just in case
+__PACKAGE__->register_method(
+    method   => 'fetch_org_by_shortname',
+    api_name => 'open-ils.actor.org_unit.retrieve_by_shorname',
+);
+__PACKAGE__->register_method(
+    method   => 'fetch_org_by_shortname',
+    api_name => 'open-ils.actor.org_unit.retrieve_by_shortname',
+);
+sub fetch_org_by_shortname {
+	my( $self, $conn, $sname ) = @_;
+	my $e = new_editor();
+	my $org = $e->search_actor_org_unit({ shortname => uc($sname)})->[0];
+	return $e->event unless $org;
+	return $org;
+}
+
+
+__PACKAGE__->register_method(
+    method   => 'session_home_lib',
+    api_name => 'open-ils.actor.session.home_lib',
+);
+
+sub session_home_lib {
+	my( $self, $conn, $auth ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return undef unless $e->checkauth;
+	my $org = $e->retrieve_actor_org_unit($e->requestor->home_ou);
+	return $org->shortname;
+}
+
+__PACKAGE__->register_method(
+    method    => 'session_safe_token',
+    api_name  => 'open-ils.actor.session.safe_token',
+    signature => q/
+		Returns a hashed session ID that is safe for export to the world.
+		This safe token will expire after 1 hour of non-use.
+		@param auth Active authentication token
+	/
+);
+
+sub session_safe_token {
+	my( $self, $conn, $auth ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return undef unless $e->checkauth;
+
+	my $safe_token = md5_hex($auth);
+
+	$cache ||= OpenSRF::Utils::Cache->new("global", 0);
+
+	# Add more like the following if needed...
+	$cache->put_cache(
+		"safe-token-home_lib-shortname-$safe_token",
+		$e->retrieve_actor_org_unit(
+			$e->requestor->home_ou
+		)->shortname,
+		60 * 60
+	);
+
+	return $safe_token;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'safe_token_home_lib',
+    api_name  => 'open-ils.actor.safe_token.home_lib.shortname',
+    signature => q/
+		Returns the home library shortname from the session
+		asscociated with a safe token from generated by
+		open-ils.actor.session.safe_token.
+		@param safe_token Active safe token
+	/
+);
+
+sub safe_token_home_lib {
+	my( $self, $conn, $safe_token ) = @_;
+
+	$cache ||= OpenSRF::Utils::Cache->new("global", 0);
+	return $cache->get_cache( 'safe-token-home_lib-shortname-'. $safe_token );
+}
+
+
+
+__PACKAGE__->register_method(
+    method   => 'slim_tree',
+    api_name => "open-ils.actor.org_tree.slim_hash.retrieve",
+);
+sub slim_tree {
+	my $tree = new_editor()->search_actor_org_unit( 
+		[
+			{"parent_ou" => undef },
+			{
+				flesh				=> -1,
+				flesh_fields	=> { aou =>  ['children'] },
+				order_by			=> { aou => 'name'},
+				select			=> { aou => ["id","shortname", "name"]},
+			}
+		]
+	)->[0];
+
+	return trim_tree($tree);
+}
+
+
+sub trim_tree {
+	my $tree = shift;
+	return undef unless $tree;
+	my $htree = {
+		code => $tree->shortname,
+		name => $tree->name,
+	};
+	if( $tree->children and @{$tree->children} ) {
+		$htree->{children} = [];
+		for my $c (@{$tree->children}) {
+			push( @{$htree->{children}}, trim_tree($c) );
+		}
+	}
+
+	return $htree;
+}
+
+
+__PACKAGE__->register_method(
+    method   => "update_penalties",
+    api_name => "open-ils.actor.user.penalties.update"
+);
+
+sub update_penalties {
+	my($self, $conn, $auth, $user_id) = @_;
+	my $e = new_editor(authtoken=>$auth, xact => 1);
+	return $e->die_event unless $e->checkauth;
+    my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
+    return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
+    my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $e->requestor->ws_ou);
+    return $evt if $evt;
+    $e->commit;
+    return 1;
+}
+
+
+__PACKAGE__->register_method(
+    method   => "apply_penalty",
+    api_name => "open-ils.actor.user.penalty.apply"
+);
+
+sub apply_penalty {
+	my($self, $conn, $auth, $penalty) = @_;
+
+	my $e = new_editor(authtoken=>$auth, xact => 1);
+	return $e->die_event unless $e->checkauth;
+
+    my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
+    return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
+
+    my $ptype = $e->retrieve_config_standing_penalty($penalty->standing_penalty) or return $e->die_event;
+    
+    my $ctx_org = 
+        (defined $ptype->org_depth) ?
+        $U->org_unit_ancestor_at_depth($penalty->org_unit, $ptype->org_depth) :
+        $penalty->org_unit;
+
+    $penalty->org_unit($ctx_org);
+    $penalty->staff($e->requestor->id);
+    $e->create_actor_user_standing_penalty($penalty) or return $e->die_event;
+
+    $e->commit;
+    return $penalty->id;
+}
+
+__PACKAGE__->register_method(
+    method   => "remove_penalty",
+    api_name => "open-ils.actor.user.penalty.remove"
+);
+
+sub remove_penalty {
+	my($self, $conn, $auth, $penalty) = @_;
+	my $e = new_editor(authtoken=>$auth, xact => 1);
+	return $e->die_event unless $e->checkauth;
+    my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
+    return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
+
+    $e->delete_actor_user_standing_penalty($penalty) or return $e->die_event;
+    $e->commit;
+    return 1;
+}
+
+__PACKAGE__->register_method(
+    method   => "update_penalty_note",
+    api_name => "open-ils.actor.user.penalty.note.update"
+);
+
+sub update_penalty_note {
+	my($self, $conn, $auth, $penalty_ids, $note) = @_;
+	my $e = new_editor(authtoken=>$auth, xact => 1);
+	return $e->die_event unless $e->checkauth;
+    for my $penalty_id (@$penalty_ids) {
+        my $penalty = $e->search_actor_user_standing_penalty( { id => $penalty_id } )->[0];
+        if (! $penalty ) { return $e->die_event; }
+        my $user = $e->retrieve_actor_user($penalty->usr) or return $e->die_event;
+        return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
+
+        $penalty->note( $note ); $penalty->ischanged( 1 );
+
+        $e->update_actor_user_standing_penalty($penalty) or return $e->die_event;
+    }
+    $e->commit;
+    return 1;
+}
+
+__PACKAGE__->register_method(
+    method   => "ranged_penalty_thresholds",
+    api_name => "open-ils.actor.grp_penalty_threshold.ranged.retrieve",
+    stream   => 1
+);
+
+sub ranged_penalty_thresholds {
+	my($self, $conn, $auth, $context_org) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('VIEW_GROUP_PENALTY_THRESHOLD', $context_org);
+    my $list = $e->search_permission_grp_penalty_threshold([
+        {org_unit => $U->get_org_ancestors($context_org)},
+        {order_by => {pgpt => 'id'}}
+    ]);
+    $conn->respond($_) for @$list;
+    return undef;
+}
+
+
+
+__PACKAGE__->register_method(
+    method        => "user_retrieve_fleshed_by_id",
+    authoritative => 1,
+    api_name      => "open-ils.actor.user.fleshed.retrieve",
+);
+
+sub user_retrieve_fleshed_by_id {
+	my( $self, $client, $auth, $user_id, $fields ) = @_;
+	my $e = new_editor(authtoken => $auth);
+	return $e->event unless $e->checkauth;
+
+	if( $e->requestor->id != $user_id ) {
+		return $e->event unless $e->allowed('VIEW_USER');
+	}
+
+	$fields ||= [
+		"cards",
+		"card",
+		"standing_penalties",
+		"addresses",
+		"billing_address",
+		"mailing_address",
+		"stat_cat_entries" ];
+	return new_flesh_user($user_id, $fields, $e);
+}
+
+
+sub new_flesh_user {
+
+	my $id = shift;
+	my $fields = shift || [];
+	my $e = shift;
+
+    my $fetch_penalties = 0;
+    if(grep {$_ eq 'standing_penalties'} @$fields) {
+        $fields = [grep {$_ ne 'standing_penalties'} @$fields];
+        $fetch_penalties = 1;
+    }
+
+	my $user = $e->retrieve_actor_user(
+   	[
+      	$id,
+      	{
+         	"flesh" 			=> 1,
+         	"flesh_fields" =>  { "au" => $fields }
+      	}
+   	]
+	) or return $e->die_event;
+
+
+	if( grep { $_ eq 'addresses' } @$fields ) {
+
+		$user->addresses([]) unless @{$user->addresses};
+        # don't expose "replaced" addresses by default
+        $user->addresses([grep {$_->id >= 0} @{$user->addresses}]);
+	
+		if( ref $user->billing_address ) {
+			unless( grep { $user->billing_address->id == $_->id } @{$user->addresses} ) {
+				push( @{$user->addresses}, $user->billing_address );
+			}
+		}
+	
+		if( ref $user->mailing_address ) {
+			unless( grep { $user->mailing_address->id == $_->id } @{$user->addresses} ) {
+				push( @{$user->addresses}, $user->mailing_address );
+			}
+		}
+	}
+
+    if($fetch_penalties) {
+        # grab the user penalties ranged for this location
+        $user->standing_penalties(
+            $e->search_actor_user_standing_penalty([
+                {   usr => $id, 
+                    '-or' => [
+                        {stop_date => undef},
+                        {stop_date => {'>' => 'now'}}
+                    ],
+                    org_unit => $U->get_org_ancestors($e->requestor->ws_ou)
+                },
+                {   flesh => 1,
+                    flesh_fields => {ausp => ['standing_penalty']}
+                }
+            ])
+        );
+    }
+
+	$e->rollback;
+	$user->clear_passwd();
+	return $user;
+}
+
+
+
+
+__PACKAGE__->register_method(
+    method   => "user_retrieve_parts",
+    api_name => "open-ils.actor.user.retrieve.parts",
+);
+
+sub user_retrieve_parts {
+	my( $self, $client, $auth, $user_id, $fields ) = @_;
+	my $e = new_editor(authtoken => $auth);
+	return $e->event unless $e->checkauth;
+    $user_id ||= $e->requestor->id;
+	if( $e->requestor->id != $user_id ) {
+		return $e->event unless $e->allowed('VIEW_USER');
+	}
+	my @resp;
+	my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+	push(@resp, $user->$_()) for(@$fields);
+	return \@resp;
+}
+
+
+
+__PACKAGE__->register_method(
+    method    => 'user_opt_in_enabled',
+    api_name  => 'open-ils.actor.user.org_unit_opt_in.enabled',
+    signature => '@return 1 if user opt-in is globally enabled, 0 otherwise.'
+);
+
+sub user_opt_in_enabled {
+    my($self, $conn) = @_;
+    my $sc = OpenSRF::Utils::SettingsClient->new;
+    return 1 if lc($sc->config_value(share => user => 'opt_in')) eq 'true'; 
+    return 0;
+}
+    
+
+__PACKAGE__->register_method(
+    method    => 'user_opt_in_at_org',
+    api_name  => 'open-ils.actor.user.org_unit_opt_in.check',
+    signature => q/
+        @param $auth The auth token
+        @param user_id The ID of the user to test
+        @return 1 if the user has opted in at the specified org,
+            event on error, and 0 otherwise. /
+);
+sub user_opt_in_at_org {
+    my($self, $conn, $auth, $user_id) = @_;
+
+    # see if we even need to enforce the opt-in value
+    return 1 unless user_opt_in_enabled($self);
+
+	my $e = new_editor(authtoken => $auth);
+	return $e->event unless $e->checkauth;
+    my $org_id = $e->requestor->ws_ou;
+
+    my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+	return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
+
+    # user is automatically opted-in at the home org
+    return 1 if $user->home_ou eq $org_id;
+
+    my $vals = $e->search_actor_usr_org_unit_opt_in(
+        {org_unit=>$org_id, usr=>$user_id},{idlist=>1});
+
+    return 1 if @$vals;
+    return 0;
+}
+
+__PACKAGE__->register_method(
+    method    => 'create_user_opt_in_at_org',
+    api_name  => 'open-ils.actor.user.org_unit_opt_in.create',
+    signature => q/
+        @param $auth The auth token
+        @param user_id The ID of the user to test
+        @return The ID of the newly created object, event on error./
+);
+
+sub create_user_opt_in_at_org {
+    my($self, $conn, $auth, $user_id) = @_;
+
+	my $e = new_editor(authtoken => $auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+    my $org_id = $e->requestor->ws_ou;
+
+    my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
+	return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
+
+    my $opt_in = Fieldmapper::actor::usr_org_unit_opt_in->new;
+
+    $opt_in->org_unit($org_id);
+    $opt_in->usr($user_id);
+    $opt_in->staff($e->requestor->id);
+    $opt_in->opt_in_ts('now');
+    $opt_in->opt_in_ws($e->requestor->wsid);
+
+    $opt_in = $e->create_actor_usr_org_unit_opt_in($opt_in)
+        or return $e->die_event;
+
+    $e->commit;
+
+    return $opt_in->id;
+}
+
+
+__PACKAGE__->register_method (
+	method		=> 'retrieve_org_hours',
+	api_name	=> 'open-ils.actor.org_unit.hours_of_operation.retrieve',
+	signature	=> q/
+        Returns the hours of operation for a specified org unit
+		@param authtoken The login session key
+		@param org_id The org_unit ID
+	/
+);
+
+sub retrieve_org_hours {
+    my($self, $conn, $auth, $org_id) = @_;
+    my $e = new_editor(authtoken => $auth);
+	return $e->die_event unless $e->checkauth;
+    $org_id ||= $e->requestor->ws_ou;
+    return $e->retrieve_actor_org_unit_hours_of_operation($org_id);
+}
+
+
+__PACKAGE__->register_method (
+	method		=> 'verify_user_password',
+	api_name	=> 'open-ils.actor.verify_user_password',
+	signature	=> q/
+        Given a barcode or username and the MD5 encoded password, 
+        returns 1 if the password is correct.  Returns 0 otherwise.
+	/
+);
+
+sub verify_user_password {
+    my($self, $conn, $auth, $barcode, $username, $password) = @_;
+    my $e = new_editor(authtoken => $auth);
+	return $e->die_event unless $e->checkauth;
+    my $user;
+    my $user_by_barcode;
+    my $user_by_username;
+    if($barcode) {
+        my $card = $e->search_actor_card([
+            {barcode => $barcode},
+            {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0] or return 0;
+        $user_by_barcode = $card->usr;
+        $user = $user_by_barcode;
+    }
+    if ($username) {
+        $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return 0;
+        $user = $user_by_username;
+    }
+    return 0 if (!$user);
+    return 0 if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id); 
+    return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
+    return 1 if $user->passwd eq $password;
+    return 0;
+}
+
+__PACKAGE__->register_method (
+	method		=> 'retrieve_usr_id_via_barcode_or_usrname',
+	api_name	=> "open-ils.actor.user.retrieve_id_by_barcode_or_username",
+	signature	=> q/
+        Given a barcode or username returns the id for the user or
+        a failure event.
+	/
+);
+
+sub retrieve_usr_id_via_barcode_or_usrname {
+    my($self, $conn, $auth, $barcode, $username) = @_;
+    my $e = new_editor(authtoken => $auth);
+	return $e->die_event unless $e->checkauth;
+    my $id_as_barcode= OpenSRF::Utils::SettingsClient->new->config_value(apps => 'open-ils.actor' => app_settings => 'id_as_barcode');
+    my $user;
+    my $user_by_barcode;
+    my $user_by_username;
+    $logger->info("$id_as_barcode is the ID as BARCODE");
+    if($barcode) {
+        my $card = $e->search_actor_card([
+            {barcode => $barcode},
+            {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0];
+        if ($id_as_barcode =~ /^t/i) {
+            if (!$card) {
+                $user = $e->retrieve_actor_user($barcode);
+                return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$user);
+            }else {
+                $user_by_barcode = $card->usr;
+                $user = $user_by_barcode;
+            }
+        }else {
+            return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if(!$card);
+            $user_by_barcode = $card->usr;
+            $user = $user_by_barcode;
+        }
+    }
+
+    if ($username) {
+        $user_by_username = $e->search_actor_user({usrname => $username})->[0] or return OpenILS::Event->new( 'ACTOR_USR_NOT_FOUND' );
+
+        $user = $user_by_username;
+    }
+	return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if (!$user);
+	return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' ) if ($user_by_username && $user_by_barcode && $user_by_username->id != $user_by_barcode->id); 
+    return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
+    return $user->id;
+}
+
+
+__PACKAGE__->register_method (
+	method		=> 'merge_users',
+	api_name	=> 'open-ils.actor.user.merge',
+	signature	=> {
+        desc => q/
+            Given a list of source users and destination user, transfer all data from the source
+            to the dest user and delete the source user.  All user related data is 
+            transferred, including circulations, holds, bookbags, etc.
+        /
+    }
+);
+
+sub merge_users {
+    my($self, $conn, $auth, $master_id, $user_ids, $options) = @_;
+    my $e = new_editor(xact => 1, authtoken => $auth);
+	return $e->die_event unless $e->checkauth;
+
+    # disallow the merge if any subordinate accounts are in collections
+    my $colls = $e->search_money_collections_tracker({usr => $user_ids}, {idlist => 1});
+    return OpenILS::Event->new('MERGED_USER_IN_COLLECTIONS', payload => $user_ids) if @$colls;
+
+    my $master_user = $e->retrieve_actor_user($master_id) or return $e->die_event;
+    my $del_addrs = ($U->ou_ancestor_setting_value(
+        $master_user->home_ou, 'circ.user_merge.delete_addresses', $e)) ? 't' : 'f';
+    my $del_cards = ($U->ou_ancestor_setting_value(
+        $master_user->home_ou, 'circ.user_merge.delete_cards', $e)) ? 't' : 'f';
+    my $deactivate_cards = ($U->ou_ancestor_setting_value(
+        $master_user->home_ou, 'circ.user_merge.deactivate_cards', $e)) ? 't' : 'f';
+
+    for my $src_id (@$user_ids) {
+        my $src_user = $e->retrieve_actor_user($src_id) or return $e->die_event;
+
+        return $e->die_event unless $e->allowed('MERGE_USERS', $src_user->home_ou);
+        if($src_user->home_ou ne $master_user->home_ou) {
+            return $e->die_event unless $e->allowed('MERGE_USERS', $master_user->home_ou);
+        }
+
+        return $e->die_event unless 
+            $e->json_query({from => [
+                'actor.usr_merge', 
+                $src_id, 
+                $master_id,
+                $del_addrs,
+                $del_cards,
+                $deactivate_cards
+            ]});
+    }
+
+    $e->commit;
+    return 1;
+}
+
+
+__PACKAGE__->register_method (
+	method		=> 'approve_user_address',
+	api_name	=> 'open-ils.actor.user.pending_address.approve',
+	signature	=> {
+        desc => q/
+        /
+    }
+);
+
+sub approve_user_address {
+    my($self, $conn, $auth, $addr) = @_;
+    my $e = new_editor(xact => 1, authtoken => $auth);
+	return $e->die_event unless $e->checkauth;
+    if(ref $addr) {
+        # if the caller passes an address object, assume they want to 
+        # update it first before approving it
+        $e->update_actor_user_address($addr) or return $e->die_event;
+    } else {
+        $addr = $e->retrieve_actor_user_address($addr) or return $e->die_event;
+    }
+    my $user = $e->retrieve_actor_user($addr->usr);
+    return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
+    my $result = $e->json_query({from => ['actor.approve_pending_address', $addr->id]})->[0]
+        or return $e->die_event;
+    $e->commit;
+    return [values %$result]->[0]; 
+}
+
+
+__PACKAGE__->register_method (
+	method		=> 'retrieve_friends',
+	api_name	=> 'open-ils.actor.friends.retrieve',
+	signature	=> {
+        desc => q/
+            returns { confirmed: [], pending_out: [], pending_in: []}
+            pending_out are users I'm requesting friendship with
+            pending_in are users requesting friendship with me
+        /
+    }
+);
+
+sub retrieve_friends {
+    my($self, $conn, $auth, $user_id, $options) = @_;
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+    $user_id ||= $e->requestor->id;
+
+    if($user_id != $e->requestor->id) {
+        my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+        return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
+    }
+
+    return OpenILS::Application::Actor::Friends->retrieve_friends(  
+        $e, $user_id, $options);
+}
+
+
+
+__PACKAGE__->register_method (
+	method		=> 'apply_friend_perms',
+	api_name	=> 'open-ils.actor.friends.perms.apply',
+	signature	=> {
+        desc => q/
+        /
+    }
+);
+sub apply_friend_perms {
+    my($self, $conn, $auth, $user_id, $delegate_id, @perms) = @_;
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+
+    if($user_id != $e->requestor->id) {
+        my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
+        return $e->die_event unless $e->allowed('VIEW_USER', $user->home_ou);
+    }
+
+    for my $perm (@perms) {
+        my $evt = 
+            OpenILS::Application::Actor::Friends->apply_friend_perm(
+                $e, $user_id, $delegate_id, $perm);
+        return $evt if $evt;
+    }
+
+    $e->commit;
+    return 1;
+}
+
+
+__PACKAGE__->register_method (
+	method		=> 'update_user_pending_address',
+	api_name	=> 'open-ils.actor.user.address.pending.cud'
+);
+
+sub update_user_pending_address {
+    my($self, $conn, $auth, $addr) = @_;
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+
+    if($addr->usr != $e->requestor->id) {
+        my $user = $e->retrieve_actor_user($addr->usr) or return $e->die_event;
+        return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
+    }
+
+    if($addr->isnew) {
+        $e->create_actor_user_address($addr) or return $e->die_event;
+    } elsif($addr->isdeleted) {
+        $e->delete_actor_user_address($addr) or return $e->die_event;
+    } else {
+        $e->update_actor_user_address($addr) or return $e->die_event;
+    }
+
+    $e->commit;
+    return $addr->id;
+}
+
+
+__PACKAGE__->register_method (
+	method		=> 'user_events',
+	api_name    => 'open-ils.actor.user.events.circ',
+    stream      => 1,
+);
+__PACKAGE__->register_method (
+	method		=> 'user_events',
+	api_name    => 'open-ils.actor.user.events.ahr',
+    stream      => 1,
+);
+
+sub user_events {
+    my($self, $conn, $auth, $user_id, $filters) = @_;
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/;
+    my $user_field = 'usr';
+
+    $filters ||= {};
+    $filters->{target} = { 
+        select => { $obj_type => ['id'] },
+        from => $obj_type,
+        where => {usr => $user_id}
+    };
+
+    my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+    if($e->requestor->id != $user_id) {
+        return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
+    }
+
+    my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+    my $req = $ses->request('open-ils.trigger.events_by_target', 
+        $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2);
+
+    while(my $resp = $req->recv) {
+        my $val = $resp->content;
+        my $tgt = $val->target;
+
+        if($obj_type eq 'circ') {
+            $tgt->target_copy($e->retrieve_asset_copy($tgt->target_copy));
+
+        } elsif($obj_type eq 'ahr') {
+            $tgt->current_copy($e->retrieve_asset_copy($tgt->current_copy))
+                if $tgt->current_copy;
+        }
+
+        $conn->respond($val) if $val;
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method (
+	method		=> 'copy_events',
+	api_name    => 'open-ils.actor.copy.events.circ',
+    stream      => 1,
+);
+__PACKAGE__->register_method (
+	method		=> 'copy_events',
+	api_name    => 'open-ils.actor.copy.events.ahr',
+    stream      => 1,
+);
+
+sub copy_events {
+    my($self, $conn, $auth, $copy_id, $filters) = @_;
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    (my $obj_type = $self->api_name) =~ s/.*\.([a-z]+)$/$1/;
+
+    my $copy = $e->retrieve_asset_copy($copy_id) or return $e->event;
+
+    my $copy_field = 'target_copy';
+    $copy_field = 'current_copy' if $obj_type eq 'ahr';
+
+    $filters ||= {};
+    $filters->{target} = { 
+        select => { $obj_type => ['id'] },
+        from => $obj_type,
+        where => {$copy_field => $copy_id}
+    };
+
+
+    my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+    my $req = $ses->request('open-ils.trigger.events_by_target', 
+        $obj_type, $filters, {atevdef => ['reactor', 'validator']}, 2);
+
+    while(my $resp = $req->recv) {
+        my $val = $resp->content;
+        my $tgt = $val->target;
+        
+        my $user = $e->retrieve_actor_user($tgt->usr);
+        if($e->requestor->id != $user->id) {
+            return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
+        }
+
+        $tgt->$copy_field($copy);
+
+        $tgt->usr($user);
+        $conn->respond($val) if $val;
+    }
+
+    return undef;
+}
+
+
+
+
+__PACKAGE__->register_method (
+	method		=> 'update_events',
+	api_name    => 'open-ils.actor.user.event.cancel.batch',
+    stream      => 1,
+);
+__PACKAGE__->register_method (
+	method		=> 'update_events',
+	api_name    => 'open-ils.actor.user.event.reset.batch',
+    stream      => 1,
+);
+
+sub update_events {
+    my($self, $conn, $auth, $event_ids) = @_;
+    my $e = new_editor(xact => 1, authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $x = 1;
+    for my $id (@$event_ids) {
+
+        # do a little dance to determine what user we are ultimately affecting
+        my $event = $e->retrieve_action_trigger_event([
+            $id,
+            {   flesh => 2,
+                flesh_fields => {atev => ['event_def'], atevdef => ['hook']}
+            }
+        ]) or return $e->die_event;
+
+        my $user_id;
+        if($event->event_def->hook->core_type eq 'circ') {
+            $user_id = $e->retrieve_action_circulation($event->target)->usr;
+        } elsif($event->event_def->hook->core_type eq 'ahr') {
+            $user_id = $e->retrieve_action_hold_request($event->target)->usr;
+        } else {
+            return 0;
+        }
+
+        my $user = $e->retrieve_actor_user($user_id);
+        return $e->die_event unless $e->allowed('UPDATE_USER', $user->home_ou);
+
+        if($self->api_name =~ /cancel/) {
+            $event->state('invalid');
+        } elsif($self->api_name =~ /reset/) {
+            $event->clear_start_time;
+            $event->clear_update_time;
+            $event->state('pending');
+        }
+
+        $e->update_action_trigger_event($event) or return $e->die_event;
+        $conn->respond({maximum => scalar(@$event_ids), progress => $x++});
+    }
+
+    $e->commit;
+    return {complete => 1};
+}
+
+
+__PACKAGE__->register_method (
+	method		=> 'really_delete_user',
+	api_name    => 'open-ils.actor.user.delete',
+    signature   => q/
+        It anonymizes all personally identifiable information in actor.usr. By calling actor.usr_purge_data() 
+        it also purges related data from other tables, sometimes by transferring it to a designated destination user.
+        The usrname field (along with first_given_name and family_name) is updated to id '-PURGED-' now().
+        dest_usr_id is only required when deleting a user that performs staff functions.
+    /
+);
+
+sub really_delete_user {
+    my($self, $conn, $auth, $user_id, $dest_user_id) = @_;
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+    my $user = $e->retrieve_actor_user($user_id) or return $e->die_event;
+    return $e->die_event unless $e->allowed('DELETE_USER', $user->home_ou);
+    my $stat = $e->json_query(
+        {from => ['actor.usr_delete', $user_id, $dest_user_id]})->[0] 
+        or return $e->die_event;
+    $e->commit;
+    return 1;
+}
+
+
+
+__PACKAGE__->register_method (
+	method		=> 'user_payments',
+	api_name    => 'open-ils.actor.user.payments.retrieve',
+    stream => 1,
+    signature   => q/
+        Returns all payments for a given user.  Default order is newest payments first.
+        @param auth Authentication token
+        @param user_id The user ID
+        @param filters An optional hash of filters, including limit, offset, and order_by definitions
+    /
+);
+
+sub user_payments {
+    my($self, $conn, $auth, $user_id, $filters) = @_;
+    $filters ||= {};
+
+    my $e = new_editor(authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+    return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou);
+
+    # Find all payments for all transactions for user $user_id
+    my $query = {
+        select => {mp => ['id']}, 
+        from => 'mp', 
+        where => {
+            xact => {
+                in => {
+                    select => {mbt => ['id']}, 
+                    from => 'mbt', 
+                    where => {usr => $user_id}
+                }   
+            }
+        },
+        order_by => [{ # by default, order newest payments first
+            class => 'mp', 
+            field => 'payment_ts',
+            direction => 'desc'
+        }]
+    };
+
+    for (qw/order_by limit offset/) {
+        $query->{$_} = $filters->{$_} if defined $filters->{$_};
+    }
+
+    if(defined $filters->{where}) {
+        foreach (keys %{$filters->{where}}) {
+            # don't allow the caller to expand the result set to other users
+            $query->{where}->{$_} = $filters->{where}->{$_} unless $_ eq 'xact'; 
+        }
+    }
+
+    my $payment_ids = $e->json_query($query);
+    for my $pid (@$payment_ids) {
+        my $pay = $e->retrieve_money_payment([
+            $pid->{id},
+            {   flesh => 6,
+                flesh_fields => {
+                    mp => ['xact'],
+                    mbt => ['summary', 'circulation', 'grocery'],
+                    circ => ['target_copy'],
+                    acp => ['call_number'],
+                    acn => ['record']
+                }
+            }
+        ]);
+
+        my $resp = {
+            mp => $pay,
+            xact_type => $pay->xact->summary->xact_type,
+            last_billing_type => $pay->xact->summary->last_billing_type,
+        };
+
+        if($pay->xact->summary->xact_type eq 'circulation') {
+            $resp->{barcode} = $pay->xact->circulation->target_copy->barcode;
+            $resp->{title} = $U->record_to_mvr($pay->xact->circulation->target_copy->call_number->record)->title;
+        }
+
+        $pay->xact($pay->xact->id); # de-flesh
+        $conn->respond($resp);
+    }
+
+    return undef;
+}
+
+
+
+__PACKAGE__->register_method (
+	method		=> 'negative_balance_users',
+	api_name    => 'open-ils.actor.users.negative_balance',
+    stream => 1,
+    signature   => q/
+        Returns all users that have an overall negative balance
+        @param auth Authentication token
+        @param org_id The context org unit as an ID or list of IDs.  This will be the home 
+        library of the user.  If no org_unit is specified, no org unit filter is applied
+    /
+);
+
+sub negative_balance_users {
+    my($self, $conn, $auth, $org_id) = @_;
+
+    my $e = new_editor(authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('VIEW_USER', $org_id);
+
+    my $query = {
+        select => { 
+            mous => ['usr', 'balance_owed'], 
+            au => ['home_ou'], 
+            mbts => [
+                {column => 'last_billing_ts', transform => 'max', aggregate => 1},
+                {column => 'last_payment_ts', transform => 'max', aggregate => 1},
+            ]
+        }, 
+        from => { 
+            mous => { 
+                au => { 
+                    fkey => 'usr', 
+                    field => 'id', 
+                    join => { 
+                        mbts => { 
+                            key => 'id', 
+                            field => 'usr' 
+                        } 
+                    } 
+                } 
+            } 
+        }, 
+        where => {'+mous' => {balance_owed => {'<' => 0}}} 
+    };
+
+    $query->{from}->{mous}->{au}->{filter}->{home_ou} = $org_id if $org_id;
+
+    my $list = $e->json_query($query, {timeout => 600});
+
+    for my $data (@$list) {
+        $conn->respond({
+            usr => $e->retrieve_actor_user([$data->{usr}, {flesh => 1, flesh_fields => {au => ['card']}}]),
+            balance_owed => $data->{balance_owed},
+            last_billing_activity => max($data->{last_billing_ts}, $data->{last_payment_ts})
+        });
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method(
+	method	=> "request_password_reset",
+	api_name	=> "open-ils.actor.patron.password_reset.request",
+	signature	=> {
+        desc => "Generates a UUID token usable with the open-ils.actor.patron.password_reset.commit " .
+                "method for changing a user's password.  The UUID token is distributed via A/T "      .
+                "templates (i.e. email to the user).",
+        params => [
+            { desc => 'user_id_type', type => 'string' },
+            { desc => 'user_id', type => 'string' },
+            { desc => 'optional (based on library setting) matching email address for authorizing request', type => 'string' },
+        ],
+        return => {desc => '1 on success, Event on error'}
+    }
+);
+sub request_password_reset {
+    my($self, $conn, $user_id_type, $user_id, $email) = @_;
+
+    # Check to see if password reset requests are already being throttled:
+    # 0. Check cache to see if we're in throttle mode (avoid hitting database)
+
+    my $e = new_editor(xact => 1);
+    my $user;
+
+    # Get the user, if any, depending on the input value
+    if ($user_id_type eq 'username') {
+        $user = $e->search_actor_user({usrname => $user_id})->[0];
+        if (!$user) {
+            $e->die_event;
+            return OpenILS::Event->new( 'ACTOR_USER_NOT_FOUND' );
+        }
+    } elsif ($user_id_type eq 'barcode') {
+        my $card = $e->search_actor_card([
+            {barcode => $user_id},
+            {flesh => 1, flesh_fields => {ac => ['usr']}}])->[0];
+        if (!$card) { 
+            $e->die_event;
+            return OpenILS::Event->new('ACTOR_USER_NOT_FOUND');
+        }
+        $user = $card->usr;
+    }
+    
+    # If the user doesn't have an email address, we can't help them
+    if (!$user->email) {
+        $e->die_event;
+        return OpenILS::Event->new('PATRON_NO_EMAIL_ADDRESS');
+    }
+    
+    my $email_must_match = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_requires_matching_email');
+    if ($email_must_match) {
+        if ($user->email ne $email) {
+            return OpenILS::Event->new('EMAIL_VERIFICATION_FAILED');
+        }
+    }
+
+    _reset_password_request($conn, $e, $user);
+}
+
+# Once we have the user, we can issue the password reset request
+# XXX Add a wrapper method that accepts barcode + email input
+sub _reset_password_request {
+    my ($conn, $e, $user) = @_;
+
+    # 1. Get throttle threshold and time-to-live from OU_settings
+    my $aupr_throttle = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_throttle') || 1000;
+    my $aupr_ttl = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_time_to_live') || 24*60*60;
+
+    my $threshold_time = DateTime->now(time_zone => 'local')->subtract(seconds => $aupr_ttl)->iso8601();
+
+    # 2. Get time of last request and number of active requests (num_active)
+    my $active_requests = $e->json_query({
+        from => 'aupr',
+        select => {
+            aupr => [
+                {
+                    column => 'uuid',
+                    transform => 'COUNT'
+                },
+                {
+                    column => 'request_time',
+                    transform => 'MAX'
+                }
+            ]
+        },
+        where => {
+            has_been_reset => { '=' => 'f' },
+            request_time => { '>' => $threshold_time }
+        }
+    });
+
+    # Guard against no active requests
+    if ($active_requests->[0]->{'request_time'}) {
+        my $last_request = DateTime::Format::ISO8601->parse_datetime(clense_ISO8601($active_requests->[0]->{'request_time'}));
+        my $now = DateTime::Format::ISO8601->new();
+
+        # 3. if (num_active > throttle_threshold) and (now - last_request < 1 minute)
+        if (($active_requests->[0]->{'usr'} > $aupr_throttle) &&
+            ($last_request->add_duration('1 minute') > $now)) {
+            $cache->put_cache('open-ils.actor.password.throttle', DateTime::Format::ISO8601->new(), 60);
+            $e->die_event;
+            return OpenILS::Event->new('PATRON_TOO_MANY_ACTIVE_PASSWORD_RESET_REQUESTS');
+        }
+    }
+
+    # TODO Check to see if the user is in a password-reset-restricted group
+
+    # Otherwise, go ahead and try to get the user.
+ 
+    # Check the number of active requests for this user
+    $active_requests = $e->json_query({
+        from => 'aupr',
+        select => {
+            aupr => [
+                {
+                    column => 'usr',
+                    transform => 'COUNT'
+                }
+            ]
+        },
+        where => {
+            usr => { '=' => $user->id },
+            has_been_reset => { '=' => 'f' },
+            request_time => { '>' => $threshold_time }
+        }
+    });
+
+    $logger->info("User " . $user->id . " has " . $active_requests->[0]->{'usr'} . " active password reset requests.");
+
+    # if less than or equal to per-user threshold, proceed; otherwise, return event
+    my $aupr_per_user_limit = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_per_user_limit') || 3;
+    if ($active_requests->[0]->{'usr'} > $aupr_per_user_limit) {
+        $e->die_event;
+        return OpenILS::Event->new('PATRON_TOO_MANY_ACTIVE_PASSWORD_RESET_REQUESTS');
+    }
+
+    # Create the aupr object and insert into the database
+    my $reset_request = Fieldmapper::actor::usr_password_reset->new;
+    my $uuid = create_uuid_as_string(UUID_V4);
+    $reset_request->uuid($uuid);
+    $reset_request->usr($user->id);
+
+    my $aupr = $e->create_actor_usr_password_reset($reset_request) or return $e->die_event;
+    $e->commit;
+
+    # Create an event to notify user of the URL to reset their password
+
+    # Can we stuff this in the user_data param for trigger autocreate?
+    my $hostname = $U->ou_ancestor_setting_value($user->home_ou, 'lib.hostname') || 'localhost';
+
+    my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+    $ses->request('open-ils.trigger.event.autocreate', 'password.reset_request', $aupr, $user->home_ou);
+
+    # Trunk only
+    # $U->create_trigger_event('password.reset_request', $aupr, $user->home_ou);
+
+    return 1;
+}
+
+__PACKAGE__->register_method(
+	method	=> "commit_password_reset",
+	api_name	=> "open-ils.actor.patron.password_reset.commit",
+	signature	=> {
+        desc => "Checks a UUID token generated by the open-ils.actor.patron.password_reset.request method for " .
+                "validity, and if valid, uses it as authorization for changing the associated user's password " .
+                "with the supplied password.",
+        params => [
+            { desc => 'uuid', type => 'string' },
+            { desc => 'password', type => 'string' },
+        ],
+        return => {desc => '1 on success, Event on error'}
+    }
+);
+sub commit_password_reset {
+    my($self, $conn, $uuid, $password) = @_;
+
+    # Check to see if password reset requests are already being throttled:
+    # 0. Check cache to see if we're in throttle mode (avoid hitting database)
+    $cache ||= OpenSRF::Utils::Cache->new("global", 0);
+    my $throttle = $cache->get_cache('open-ils.actor.password.throttle') || undef;
+    if ($throttle) {
+        return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
+    }
+
+    my $e = new_editor(xact => 1);
+
+    my $aupr = $e->search_actor_usr_password_reset({
+        uuid => $uuid,
+        has_been_reset => 0
+    });
+
+    if (!$aupr->[0]) {
+        $e->die_event;
+        return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
+    }
+    my $user_id = $aupr->[0]->usr;
+    my $user = $e->retrieve_actor_user($user_id);
+
+    # Ensure we're still within the TTL for the request
+    my $aupr_ttl = $U->ou_ancestor_setting_value($user->home_ou, 'circ.password_reset_request_time_to_live') || 24*60*60;
+    my $threshold = DateTime::Format::ISO8601->parse_datetime(clense_ISO8601($aupr->[0]->request_time))->add(seconds => $aupr_ttl);
+    if ($threshold < DateTime->now(time_zone => 'local')) {
+        $e->die_event;
+        $logger->info("Password reset request needed to be submitted before $threshold");
+        return OpenILS::Event->new('PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST');
+    }
+
+    # Check complexity of password against OU-defined regex
+    my $pw_regex = $U->ou_ancestor_setting_value($user->home_ou, 'global.password_regex');
+
+    my $is_strong = 0;
+    if ($pw_regex) {
+        # Calling JSON2perl on the $pw_regex causes failure, even before the fancy Unicode regex
+        # ($pw_regex = OpenSRF::Utils::JSON->JSON2perl($pw_regex)) =~ s/\\u([0-9a-fA-F]{4})/\\x{$1}/gs;
+        $is_strong = check_password_strength_custom($password, $pw_regex);
+    } else {
+        $is_strong = check_password_strength_default($password);
+    }
+
+    if (!$is_strong) {
+        $e->die_event;
+        return OpenILS::Event->new('PATRON_PASSWORD_WAS_NOT_STRONG');
+    }
+
+    # All is well; update the password
+    $user->passwd($password);
+    $e->update_actor_user($user);
+
+    # And flag that this password reset request has been honoured
+    $aupr->[0]->has_been_reset('t');
+    $e->update_actor_usr_password_reset($aupr->[0]);
+    $e->commit;
+
+    return 1;
+}
+
+sub check_password_strength_default {
+    my $password = shift;
+    # Use the default set of checks
+    if ( (length($password) < 7) or 
+            ($password !~ m/.*\d+.*/) or 
+            ($password !~ m/.*[A-Za-z]+.*/)
+       ) {
+        return 0;
+    }
+    return 1;
+}
+
+sub check_password_strength_custom {
+    my ($password, $pw_regex) = @_;
+
+    $pw_regex = qr/$pw_regex/;
+    if ($password !~  /$pw_regex/) {
+        return 0;
+    }
+    return 1;
+}
+
+
+
+__PACKAGE__->register_method(
+    method    => "event_def_opt_in_settings",
+    api_name  => "open-ils.actor.event_def.opt_in.settings",
+    stream => 1,
+    signature => {
+        desc   => 'Streams the set of "cust" objects that are used as opt-in settings for event definitions',
+        params => [
+            { desc => 'Authentication token',  type => 'string'},
+            { 
+                desc => 'Org Unit ID.  (optional).  If no org ID is present, the home_ou of the requesting user is used', 
+                type => 'number'
+            },
+        ],
+        return => {
+            desc => q/set of "cust" objects that are used as opt-in settings for event definitions at the specified org unit/,
+            type => 'object',
+            class => 'cust'
+        }
+    }
+);
+
+sub event_def_opt_in_settings {
+    my($self, $conn, $auth, $org_id) = @_;
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    if(defined $org_id and $org_id != $e->requestor->home_ou) {
+        return $e->event unless 
+            $e->allowed(['VIEW_USER_SETTING_TYPE', 'ADMIN_USER_SETTING_TYPE'], $org_id);
+    } else {
+        $org_id = $e->requestor->home_ou;
+    }
+
+    # find all config.user_setting_type's related to event_defs for the requested org unit
+    my $types = $e->json_query({
+        select => {cust => ['name']}, 
+        from => {atevdef => 'cust'}, 
+        where => {
+            '+atevdef' => {
+                owner => $U->get_org_ancestors($org_id), # context org plus parents
+                active => 't'
+            }
+        }
+    });
+
+    if(@$types) {
+        $conn->respond($_) for 
+            @{$e->search_config_usr_setting_type({name => [map {$_->{name}} @$types]})};
+    }
+
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+    method    => "user_visible_circs",
+    api_name  => "open-ils.actor.history.circ.visible",
+    stream => 1,
+    signature => {
+        desc   => 'Returns the set of opt-in visible circulations accompanied by circulation chain summaries',
+        params => [
+            { desc => 'Authentication token',  type => 'string'},
+            { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
+            { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
+        ],
+        return => {
+            desc => q/An object with 2 fields: circulation and summary.  
+                circulation is the "circ" object.   summary is the related "accs" object/,
+            type => 'object',
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "user_visible_circs",
+    api_name  => "open-ils.actor.history.circ.visible.print",
+    stream => 1,
+    signature => {
+        desc   => 'Returns printable output for the set of opt-in visible circulations',
+        params => [
+            { desc => 'Authentication token',  type => 'string'},
+            { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
+            { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
+        ],
+        return => {
+            desc => q/An action_trigger.event object or error event./,
+            type => 'object',
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "user_visible_circs",
+    api_name  => "open-ils.actor.history.circ.visible.email",
+    stream => 1,
+    signature => {
+        desc   => 'Emails the set of opt-in visible circulations to the requestor',
+        params => [
+            { desc => 'Authentication token',  type => 'string'},
+            { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
+            { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
+        ],
+        return => {
+            desc => q/undef, or event on error/
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "user_visible_circs",
+    api_name  => "open-ils.actor.history.hold.visible",
+    stream => 1,
+    signature => {
+        desc   => 'Returns the set of opt-in visible holds',
+        params => [
+            { desc => 'Authentication token',  type => 'string'},
+            { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
+            { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
+        ],
+        return => {
+            desc => q/An object with 1 field: "hold"/,
+            type => 'object',
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "user_visible_circs",
+    api_name  => "open-ils.actor.history.hold.visible.print",
+    stream => 1,
+    signature => {
+        desc   => 'Returns printable output for the set of opt-in visible holds',
+        params => [
+            { desc => 'Authentication token',  type => 'string'},
+            { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
+            { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
+        ],
+        return => {
+            desc => q/An action_trigger.event object or error event./,
+            type => 'object',
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "user_visible_circs",
+    api_name  => "open-ils.actor.history.hold.visible.email",
+    stream => 1,
+    signature => {
+        desc   => 'Emails the set of opt-in visible holds to the requestor',
+        params => [
+            { desc => 'Authentication token',  type => 'string'},
+            { desc => 'User ID.  If no user id is present, the authenticated user is assumed', type => 'number' },
+            { desc => 'Options hash.  Supported fields are "limit" and "offset"', type => 'object' },
+        ],
+        return => {
+            desc => q/undef, or event on error/
+        }
+    }
+);
+
+sub user_visible_circs {
+    my($self, $conn, $auth, $user_id, $options) = @_;
+
+    my $is_hold = ($self->api_name =~ /hold/);
+    my $for_print = ($self->api_name =~ /print/);
+    my $for_email = ($self->api_name =~ /email/);
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    $user_id ||= $e->requestor->id;
+    $options ||= {};
+    $options->{limit} ||= 50;
+    $options->{offset} ||= 0;
+
+    if($user_id != $e->requestor->id) {
+        my $perm = ($is_hold) ? 'VIEW_HOLD' : 'VIEW_CIRCULATIONS';
+        my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+        return $e->event unless $e->allowed($perm, $user->home_ou);
+    }
+
+    my $db_func = ($is_hold) ? 'action.usr_visible_holds' : 'action.usr_visible_circs';
+
+    my $data = $e->json_query({
+        from => [$db_func, $user_id],
+        limit => $$options{limit},
+        offset => $$options{offset}
+
+        # TODO: I only want IDs. code below didn't get me there
+        # {"select":{"au":[{"column":"id", "result_field":"id", 
+        # "transform":"action.usr_visible_circs"}]}, "where":{"id":10}, "from":"au"}
+    },{
+        substream => 1
+    });
+
+    return undef unless @$data;
+
+    if ($for_print) {
+
+        # collect the batch of objects
+
+        if($is_hold) {
+
+            my $hold_list = $e->search_action_hold_request({id => [map { $_->{id} } @$data]});
+            return $U->fire_object_event(undef, 'ahr.format.history.print', $hold_list, $$hold_list[0]->request_lib);
+
+        } else {
+
+            my $circ_list = $e->search_action_circulation({id => [map { $_->{id} } @$data]});
+            return $U->fire_object_event(undef, 'circ.format.history.print', $circ_list, $$circ_list[0]->circ_lib);
+        }
+
+    } elsif ($for_email) {
+
+        $conn->respond_complete(1) if $for_email;  # no sense in waiting
+
+        foreach (@$data) {
+
+            my $id = $_->{id};
+
+            if($is_hold) {
+
+                my $hold = $e->retrieve_action_hold_request($id);
+                $U->create_events_for_hook('ahr.format.history.email', $hold, $hold->request_lib, undef, undef, 1);
+                # events will be fired from action_trigger_runner
+
+            } else {
+
+                my $circ = $e->retrieve_action_circulation($id);
+                $U->create_events_for_hook('circ.format.history.email', $circ, $circ->circ_lib, undef, undef, 1);
+                # events will be fired from action_trigger_runner
+            }
+        }
+
+    } else { # just give me the data please
+
+        foreach (@$data) {
+
+            my $id = $_->{id};
+
+            if($is_hold) {
+
+                my $hold = $e->retrieve_action_hold_request($id);
+                $conn->respond({hold => $hold});
+
+            } else {
+
+                my $circ = $e->retrieve_action_circulation($id);
+                $conn->respond({
+                    circ => $circ,
+                    summary => $U->create_circ_chain_summary($e, $id)
+                });
+            }
+        }
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method(
+    method     => "user_saved_search_cud",
+    api_name   => "open-ils.actor.user.saved_search.cud",
+    stream     => 1,
+    signature  => {
+        desc   => 'Create/Update/Delete Access to user saved searches',
+        params => [
+            { desc => 'Authentication token', type => 'string' },
+            { desc => 'Saved Search Object', type => 'object', class => 'auss' }
+        ],
+        return => {
+            desc   => q/The retrieved or updated saved search object, or id of a deleted object; Event on error/,
+            class  => 'auss'
+        }   
+    }
+);
+
+__PACKAGE__->register_method(
+    method     => "user_saved_search_cud",
+    api_name   => "open-ils.actor.user.saved_search.retrieve",
+    stream     => 1,
+    signature  => {
+        desc   => 'Retrieve a saved search object',
+        params => [
+            { desc => 'Authentication token', type => 'string' },
+            { desc => 'Saved Search ID', type => 'number' }
+        ],
+        return => {
+            desc   => q/The saved search object, Event on error/,
+            class  => 'auss'
+        }   
+    }
+);
+
+sub user_saved_search_cud {
+    my( $self, $client, $auth, $search ) = @_;
+    my $e = new_editor( authtoken=>$auth );
+    return $e->die_event unless $e->checkauth;
+
+    my $o_search;      # prior version of the object, if any
+    my $res;           # to be returned
+
+    # branch on the operation type
+
+    if( $self->api_name =~ /retrieve/ ) {                    # Retrieve
+
+        # Get the old version, to check ownership
+        $o_search = $e->retrieve_actor_usr_saved_search( $search )
+            or return $e->die_event;
+
+        # You can't read somebody else's search
+        return OpenILS::Event->new('BAD_PARAMS')
+            unless $o_search->owner == $e->requestor->id;
+
+        $res = $o_search;
+
+    } else {
+
+        $e->xact_begin;               # start an editor transaction
+
+        if( $search->isnew ) {                               # Create
+
+            # You can't create a search for somebody else
+            return OpenILS::Event->new('BAD_PARAMS')
+                unless $search->owner == $e->requestor->id;
+
+            $e->create_actor_usr_saved_search( $search )
+                or return $e->die_event;
+
+            $res = $search->id;
+
+        } elsif( $search->ischanged ) {                      # Update
+
+            # You can't change ownership of a search
+            return OpenILS::Event->new('BAD_PARAMS')
+                unless $search->owner == $e->requestor->id;
+
+            # Get the old version, to check ownership
+            $o_search = $e->retrieve_actor_usr_saved_search( $search->id )
+                or return $e->die_event;
+
+            # You can't update somebody else's search
+            return OpenILS::Event->new('BAD_PARAMS')
+                unless $o_search->owner == $e->requestor->id;
+
+            # Do the update
+            $e->update_actor_usr_saved_search( $search )
+                or return $e->die_event;
+
+            $res = $search;
+
+        } elsif( $search->isdeleted ) {                      # Delete
+
+            # Get the old version, to check ownership
+            $o_search = $e->retrieve_actor_usr_saved_search( $search->id )
+                or return $e->die_event;
+
+            # You can't delete somebody else's search
+            return OpenILS::Event->new('BAD_PARAMS')
+                unless $o_search->owner == $e->requestor->id;
+
+            # Do the delete
+            $e->delete_actor_usr_saved_search( $o_search )
+                or return $e->die_event;
+
+            $res = $search->id;
+        }
+
+        $e->commit;
+    }
+
+    return $res;
+}
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor/ClosedDates.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor/ClosedDates.pm
new file mode 100644
index 0000000000..e7601dfc5b
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor/ClosedDates.pm
@@ -0,0 +1,158 @@
+package OpenILS::Application::Actor::ClosedDates;
+use base 'OpenILS::Application';
+use strict; use warnings;
+use OpenSRF::EX qw(:try);
+use OpenILS::Utils::Editor q/:funcs/;
+
+sub initialize { return 1; }
+
+__PACKAGE__->register_method( 
+	method => 'fetch_dates',
+	api_name	=> 'open-ils.actor.org_unit.closed.retrieve.all',
+	signature	=> q/
+		Retrieves a list of closed date object IDs
+	/
+);
+
+sub fetch_dates {
+	my( $self, $conn, $auth, $args ) = @_;
+
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+
+	my $org = $$args{orgid} || $e->requestor->ws_ou;
+	my @date = localtime;
+	my $start = $$args{start_date} ||  #default to today 
+		($date[5] + 1900) .'-'. ($date[4] + 1) .'-'. $date[3];
+	my $end = $$args{end_date} || '3000-01-01'; # Y3K, here I come..
+
+	my $dates = $e->search_actor_org_unit_closed_date( 
+		{ 
+			close_start => { ">=" => $start }, 
+			close_end	=> { "<=" => $end },
+			org_unit		=> $org,
+		}, { idlist		=> $$args{idlist} } ) or return $e->event;
+
+	if(!$$args{idlist} and @$dates) {
+		$dates = [ sort { $a->close_start cmp $b->close_start } @$dates ];
+	}
+
+	return $dates;
+}
+
+__PACKAGE__->register_method( 
+	method => 'fetch_date',
+	api_name	=> 'open-ils.actor.org_unit.closed.retrieve',
+	signature	=> q/
+		Retrieves a single date object
+	/
+);
+
+sub fetch_date {
+	my( $self, $conn, $auth, $id ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	my $date = $e->retrieve_actor_org_unit_closed_date($id) or return $e->event;
+	return $date;
+}
+
+
+__PACKAGE__->register_method( 
+	method => 'delete_date',
+	api_name	=> 'open-ils.actor.org_unit.closed.delete',
+	signature	=> q/
+		Removes a single date object
+	/
+);
+
+sub delete_date {
+	my( $self, $conn, $auth, $id ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	my $date = $e->retrieve_actor_org_unit_closed_date($id) or return $e->event;
+	return $e->event unless $e->allowed( # rely on the editor perm eventually
+		'actor.org_unit.closed_date.delete', $date->org_unit);
+	$e->delete_actor_org_unit_closed_date($date) or return $e->event;
+	return 1;
+}
+
+
+
+
+__PACKAGE__->register_method( 
+	method => 'create_date',
+	api_name	=> 'open-ils.actor.org_unit.closed.create',
+	signature	=> q/
+		Creates a new org closed data
+	/
+);
+
+sub create_date {
+	my( $self, $conn, $auth, $date ) = @_;
+
+	my $e = new_editor(authtoken=>$auth, xact =>1);
+	return $e->event unless $e->checkauth;
+	
+	return $e->event unless $e->allowed( # rely on the editor perm eventually
+		'actor.org_unit.closed_date.create', $date->org_unit);
+
+	$e->create_actor_org_unit_closed_date($date) or return $e->event;
+
+	my $newobj = $e->retrieve_actor_org_unit_closed_date($date->id)
+		or return $e->event;
+
+	$e->commit;
+	return $newobj;
+}
+
+
+__PACKAGE__->register_method(
+	method => 'edit_date',
+	api_name	=> 'open-ils.actor.org_unit.closed.update',
+	signature	=> q/
+		Updates a closed date object
+	/
+);
+
+sub edit_date {
+	my( $self, $conn, $auth, $date ) = @_;
+	my $e = new_editor(authtoken=>$auth, xact =>1);
+	return $e->event unless $e->checkauth;
+	
+	# First make sure they have the right to update the selected date object
+	my $odate = $e->retrieve_actor_org_unit_closed_date($date->id) 
+		or return $e->event;
+
+	return $e->event unless $e->allowed( # rely on the editor perm eventually
+		'actor.org_unit.closed_date.update', $odate->org_unit);
+
+	$e->update_actor_org_unit_closed_date($date) or return $e->event;
+
+	return 1;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> 'closed_dates_overlap',
+	api_name	=> 'open-ils.actor.org_unit.closed_date.overlap',
+	signature	=> q/
+		Returns an object with 'start' and 'end' fields 
+		start is the first day the org is open going backwards from 
+		'date'.  end is the next day the org is open going
+		forward from 'date'.
+		@param orgid The org unit in question
+		@param date The date to search
+	/
+);
+sub closed_dates_overlap {
+	my( $self, $conn, $auth, $orgid, $date ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->request(
+		'open-ils.storage.actor.org_unit.closed_date.overlap', $orgid, $date );
+}
+
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor/Container.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor/Container.pm
new file mode 100644
index 0000000000..9126ad824f
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor/Container.pm
@@ -0,0 +1,630 @@
+package OpenILS::Application::Actor::Container;
+use base 'OpenILS::Application';
+use strict; use warnings;
+use OpenILS::Application::AppUtils;
+use OpenILS::Perm;
+use Data::Dumper;
+use OpenSRF::EX qw(:try);
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Cache;
+use Digest::MD5 qw(md5_hex);
+use OpenSRF::Utils::JSON;
+
+my $apputils = "OpenILS::Application::AppUtils";
+my $U = $apputils;
+my $logger = "OpenSRF::Utils::Logger";
+
+sub initialize { return 1; }
+
+my $svc = 'open-ils.cstore';
+my $meth = 'open-ils.cstore.direct.container';
+my %types;
+my %ctypes;
+$types{'biblio'} = "$meth.biblio_record_entry_bucket";
+$types{'callnumber'} = "$meth.call_number_bucket";
+$types{'copy'} = "$meth.copy_bucket";
+$types{'user'} = "$meth.user_bucket";
+$ctypes{'biblio'} = "container_biblio_record_entry_bucket";
+$ctypes{'callnumber'} = "container_call_number_bucket";
+$ctypes{'copy'} = "container_copy_bucket";
+$ctypes{'user'} = "container_user_bucket";
+my $event;
+
+sub _sort_buckets {
+	my $buckets = shift;
+	return $buckets unless ($buckets && $buckets->[0]);
+	return [ sort { $a->name cmp $b->name } @$buckets ];
+}
+
+__PACKAGE__->register_method(
+	method	=> "bucket_retrieve_all",
+	api_name	=> "open-ils.actor.container.all.retrieve_by_user",
+    authoritative => 1,
+	notes		=> <<"	NOTES");
+		Retrieves all un-fleshed buckets assigned to given user 
+		PARAMS(authtoken, bucketOwnerId)
+		If requestor ID is different than bucketOwnerId, requestor must have
+		VIEW_CONTAINER permissions.
+	NOTES
+
+sub bucket_retrieve_all {
+	my($self, $client, $auth, $user_id) = @_;
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    if($e->requestor->id ne $user_id) {
+        return $e->event unless $e->allowed('VIEW_CONTAINER');
+    }
+    
+	my %buckets;
+    for my $type (keys %ctypes) {
+        my $meth = "search_" . $ctypes{$type};
+	    $buckets{$type} = $e->$meth({owner => $user_id});
+    }
+
+	return \%buckets;
+}
+
+__PACKAGE__->register_method(
+	method	=> "bucket_flesh",
+	api_name	=> "open-ils.actor.container.flesh",
+    authoritative => 1,
+	argc		=> 3, 
+);
+
+__PACKAGE__->register_method(
+	method	=> "bucket_flesh_pub",
+	api_name	=> "open-ils.actor.container.public.flesh",
+	argc		=> 3, 
+);
+
+sub bucket_flesh {
+	my($self, $conn, $auth, $class, $bucket_id) = @_;
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+    return _bucket_flesh($self, $conn, $e, $class, $bucket_id);
+}
+
+sub bucket_flesh_pub {
+    my($self, $conn, $class, $bucket_id) = @_;
+    my $e = new_editor();
+    return _bucket_flesh($self, $conn, $e, $class, $bucket_id);
+}
+
+sub _bucket_flesh {
+	my($self, $conn, $e, $class, $bucket_id) = @_;
+	my $meth = 'retrieve_' . $ctypes{$class};
+    my $bkt = $e->$meth($bucket_id) or return $e->event;
+
+	unless($U->is_true($bkt->pub)) {
+        return undef if $self->api_name =~ /public/;
+        unless($bkt->owner eq $e->requestor->id) {
+            my $owner = $e->retrieve_actor_user($bkt->owner)
+                or return $e->die_event;
+            return $e->event unless $e->allowed('VIEW_CONTAINER', $owner->home_ou);
+        }
+	}
+
+    my $fmclass = $bkt->class_name . "i";
+    $meth = 'search_' . $ctypes{$class} . '_item';
+	$bkt->items(
+        $e->$meth(
+            {bucket => $bucket_id}, 
+            {   order_by => {$fmclass => "pos"},
+                flesh => 1, 
+                flesh_fields => {$fmclass => ['notes']}
+            }
+        )
+    );
+
+	return $bkt;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "item_note_cud",
+	api_name	=> "open-ils.actor.container.item_note.cud",
+);
+
+
+sub item_note_cud {
+    my($self, $conn, $auth, $class, $note) = @_;
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+
+    my $meth = 'retrieve_' . $ctypes{$class};
+    my $nclass = $note->class_name;
+    (my $iclass = $nclass) =~ s/n$//og;
+
+    my $db_note = $e->$meth($note->id, {
+        flesh => 2,
+        flesh_fields => {
+            $nclass => ['item'],
+            $iclass => ['bucket']
+        }
+    });
+
+    if($db_note->item->bucket->owner ne $e->requestor->id) {
+        return $e->die_event unless 
+            $e->allowed('UPDATE_CONTAINER', $db_note->item->bucket);
+    }
+
+    $meth = 'create_' . $ctypes{$class} if $note->isnew;
+    $meth = 'update_' . $ctypes{$class} if $note->ischanged;
+    $meth = 'delete_' . $ctypes{$class} if $note->isdeleted;
+    return $e->die_event unless $e->$meth($note);
+    $e->commit;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "bucket_retrieve_class",
+	api_name	=> "open-ils.actor.container.retrieve_by_class",
+	argc		=> 3, 
+	notes		=> <<"	NOTES");
+		Retrieves all un-fleshed buckets by class assigned to given user 
+		PARAMS(authtoken, bucketOwnerId, class [, type])
+		class can be one of "biblio", "callnumber", "copy", "user"
+		The optional "type" parameter allows you to limit the search by 
+		bucket type.  
+		If bucketOwnerId is not defined, the authtoken is used as the
+		bucket owner.
+		If requestor ID is different than bucketOwnerId, requestor must have
+		VIEW_CONTAINER permissions.
+	NOTES
+
+sub bucket_retrieve_class {
+	my( $self, $client, $authtoken, $userid, $class, $type ) = @_;
+
+	my( $staff, $user, $evt ) = 
+		$apputils->checkses_requestor( $authtoken, $userid, 'VIEW_CONTAINER' );
+	return $evt if $evt;
+
+	$logger->debug("User " . $staff->id . 
+		" retrieving buckets for user $userid [class=$class, type=$type]");
+
+	my $meth = $types{$class} . ".search.atomic";
+	my $buckets;
+
+	if( $type ) {
+		$buckets = $apputils->simplereq( $svc, 
+			$meth, { owner => $userid, btype => $type } );
+	} else {
+		$logger->debug("Grabbing buckets by class $class: $svc : $meth :  {owner => $userid}");
+		$buckets = $apputils->simplereq( $svc, $meth, { owner => $userid } );
+	}
+
+	return _sort_buckets($buckets);
+}
+
+__PACKAGE__->register_method(
+	method	=> "bucket_create",
+	api_name	=> "open-ils.actor.container.create",
+	notes		=> <<"	NOTES");
+		Creates a new bucket object.  If requestor is different from
+		bucketOwner, requestor needs CREATE_CONTAINER permissions
+		PARAMS(authtoken, bucketObject);
+		Returns the new bucket object
+	NOTES
+
+sub bucket_create {
+	my( $self, $client, $authtoken, $class, $bucket ) = @_;
+
+	my $e = new_editor(xact=>1, authtoken=>$authtoken);
+	return $e->event unless $e->checkauth;
+
+	if( $bucket->owner ne $e->requestor->id ) {
+		return $e->event unless
+			$e->allowed('CREATE_CONTAINER');
+
+	} else {
+		return $e->event unless
+			$e->allowed('CREATE_MY_CONTAINER');
+	}
+		
+	$bucket->clear_id;
+
+    my $evt = OpenILS::Event->new('CONTAINER_EXISTS', 
+        payload => [$class, $bucket->owner, $bucket->btype, $bucket->name]);
+    my $search = {name => $bucket->name, owner => $bucket->owner, btype => $bucket->btype};
+
+	my $obj;
+	if( $class eq 'copy' ) {
+        return $evt if $e->search_container_copy_bucket($search)->[0];
+		return $e->event unless
+			$obj = $e->create_container_copy_bucket($bucket);
+	}
+
+	if( $class eq 'callnumber' ) {
+        return $evt if $e->search_container_call_number_bucket($search)->[0];
+		return $e->event unless
+			$obj = $e->create_container_call_number_bucket($bucket);
+	}
+
+	if( $class eq 'biblio' ) {
+        return $evt if $e->search_container_biblio_record_entry_bucket($search)->[0];
+		return $e->event unless
+			$obj = $e->create_container_biblio_record_entry_bucket($bucket);
+	}
+
+	if( $class eq 'user') {
+        return $evt if $e->search_container_user_bucket($search)->[0];
+		return $e->event unless
+			$obj = $e->create_container_user_bucket($bucket);
+	}
+
+	$e->commit;
+	return $obj->id;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "item_create",
+	api_name	=> "open-ils.actor.container.item.create",
+    signature => {
+        desc => q/
+            Adds one or more items to an existing container
+        /,
+        params => [
+		    {desc => 'Authentication token', type => 'string'},
+		    {desc => 'Container class.  Can be "copy", "callnumber", "biblio", or "user"', type => 'string'},
+		    {desc => 'Item or items.  Can either be a single container item object, or an array of them', type => 'object'},
+        ],
+        return => {
+            desc => 'The ID of the newly created item(s).  In batch context, an array of IDs is returned'
+        }
+    }
+);
+
+
+sub item_create {
+	my( $self, $client, $authtoken, $class, $item ) = @_;
+
+	my $e = new_editor(xact=>1, authtoken=>$authtoken);
+	return $e->die_event unless $e->checkauth;
+    my $items = (ref $item eq 'ARRAY') ? $item : [$item];
+
+	my ( $bucket, $evt ) = $apputils->fetch_container_e($e, $item->bucket, $class);
+	return $evt if $evt;
+
+	if( $bucket->owner ne $e->requestor->id ) {
+		return $e->die_event unless
+			$e->allowed('CREATE_CONTAINER_ITEM');
+
+	} else {
+#		return $e->event unless
+#			$e->allowed('CREATE_CONTAINER_ITEM'); # new perm here?
+	}
+		
+    for my $one_item (@$items) {
+
+        $one_item->clear_id;
+
+        my $stat;
+        if( $class eq 'copy' ) {
+            return $e->die_event unless
+                $stat = $e->create_container_copy_bucket_item($one_item);
+        }
+
+        if( $class eq 'callnumber' ) {
+            return $e->die_event unless
+                $stat = $e->create_container_call_number_bucket_item($one_item);
+        }
+
+        if( $class eq 'biblio' ) {
+            return $e->die_event unless
+                $stat = $e->create_container_biblio_record_entry_bucket_item($one_item);
+        }
+
+        if( $class eq 'user') {
+            return $e->die_event unless
+                $stat = $e->create_container_user_bucket_item($one_item);
+        }
+    }
+
+	$e->commit;
+
+    # CStoreEeditor inserts the id (pkey) on newly created objects
+    return [ map { $_->id } @$items ] if ref $item eq 'ARRAY';
+	return $item->id; 
+}
+
+
+
+__PACKAGE__->register_method(
+	method	=> "item_delete",
+	api_name	=> "open-ils.actor.container.item.delete",
+	notes		=> <<"	NOTES");
+		PARAMS(authtoken, class, itemId)
+	NOTES
+
+sub item_delete {
+	my( $self, $client, $authtoken, $class, $itemid ) = @_;
+
+	my $e = new_editor(xact=>1, authtoken=>$authtoken);
+	return $e->event unless $e->checkauth;
+
+	my $ret = __item_delete($e, $class, $itemid);
+	$e->commit unless $U->event_code($ret);
+	return $ret;
+}
+
+sub __item_delete {
+	my( $e, $class, $itemid ) = @_;
+	my( $bucket, $item, $evt);
+
+	( $item, $evt ) = $U->fetch_container_item_e( $e, $itemid, $class );
+	return $evt if $evt;
+
+	( $bucket, $evt ) = $U->fetch_container_e($e, $item->bucket, $class);
+	return $evt if $evt;
+
+	if( $bucket->owner ne $e->requestor->id ) {
+      my $owner = $e->retrieve_actor_user($bucket->owner)
+         or return $e->die_event;
+		return $e->event unless $e->allowed('DELETE_CONTAINER_ITEM', $owner->home_ou);
+	}
+
+	my $stat;
+	if( $class eq 'copy' ) {
+        for my $note (@{$e->search_container_copy_bucket_item_note({item => $item->id})}) {
+            return $e->event unless 
+                $e->delete_container_copy_bucket_item_note($note);
+        }
+		return $e->event unless
+			$stat = $e->delete_container_copy_bucket_item($item);
+	}
+
+	if( $class eq 'callnumber' ) {
+        for my $note (@{$e->search_container_call_number_bucket_item_note({item => $item->id})}) {
+            return $e->event unless 
+                $e->delete_container_call_number_bucket_item_note($note);
+        }
+		return $e->event unless
+			$stat = $e->delete_container_call_number_bucket_item($item);
+	}
+
+	if( $class eq 'biblio' ) {
+        for my $note (@{$e->search_container_biblio_record_entry_bucket_item_note({item => $item->id})}) {
+            return $e->event unless 
+                $e->delete_container_biblio_record_entry_bucket_item_note($note);
+        }
+		return $e->event unless
+			$stat = $e->delete_container_biblio_record_entry_bucket_item($item);
+	}
+
+	if( $class eq 'user') {
+        for my $note (@{$e->search_container_user_bucket_item_note({item => $item->id})}) {
+            return $e->event unless 
+                $e->delete_container_user_bucket_item_note($note);
+        }
+		return $e->event unless
+			$stat = $e->delete_container_user_bucket_item($item);
+	}
+
+	return $stat;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> 'full_delete',
+	api_name	=> 'open-ils.actor.container.full_delete',
+	notes		=> "Complety removes a container including all attached items",
+);	
+
+sub full_delete {
+	my( $self, $client, $authtoken, $class, $containerId ) = @_;
+	my( $container, $evt);
+
+	my $e = new_editor(xact=>1, authtoken=>$authtoken);
+	return $e->event unless $e->checkauth;
+
+	( $container, $evt ) = $apputils->fetch_container_e($e, $containerId, $class);
+	return $evt if $evt;
+
+	if( $container->owner ne $e->requestor->id ) {
+      my $owner = $e->retrieve_actor_user($container->owner)
+         or return $e->die_event;
+		return $e->event unless $e->allowed('DELETE_CONTAINER', $owner->home_ou);
+	}
+
+	my $items; 
+
+	my @s = ({bucket => $containerId}, {idlist=>1});
+
+	if( $class eq 'copy' ) {
+		$items = $e->search_container_copy_bucket_item(@s);
+	}
+
+	if( $class eq 'callnumber' ) {
+		$items = $e->search_container_call_number_bucket_item(@s);
+	}
+
+	if( $class eq 'biblio' ) {
+		$items = $e->search_container_biblio_record_entry_bucket_item(@s);
+	}
+
+	if( $class eq 'user') {
+		$items = $e->search_container_user_bucket_item(@s);
+	}
+
+	__item_delete($e, $class, $_) for @$items;
+
+	my $stat;
+	if( $class eq 'copy' ) {
+		return $e->event unless
+			$stat = $e->delete_container_copy_bucket($container);
+	}
+
+	if( $class eq 'callnumber' ) {
+		return $e->event unless
+			$stat = $e->delete_container_call_number_bucket($container);
+	}
+
+	if( $class eq 'biblio' ) {
+		return $e->event unless
+			$stat = $e->delete_container_biblio_record_entry_bucket($container);
+	}
+
+	if( $class eq 'user') {
+		return $e->event unless
+			$stat = $e->delete_container_user_bucket($container);
+	}
+
+	$e->commit;
+	return $stat;
+}
+
+__PACKAGE__->register_method(
+	method		=> 'container_update',
+	api_name		=> 'open-ils.actor.container.update',
+	signature	=> q/
+		Updates the given container item.
+		@param authtoken The login session key
+		@param class The container class
+		@param container The container item
+		@return true on success, 0 on no update, Event on error
+		/
+);
+
+sub container_update {
+	my( $self, $conn, $authtoken, $class, $container )  = @_;
+
+	my $e = new_editor(xact=>1, authtoken=>$authtoken);
+	return $e->event unless $e->checkauth;
+
+	my ( $dbcontainer, $evt ) = $U->fetch_container_e($e, $container->id, $class);
+	return $evt if $evt;
+
+	if( $e->requestor->id ne $container->owner ) {
+		return $e->event unless $e->allowed('UPDATE_CONTAINER');
+	}
+
+	my $stat;
+	if( $class eq 'copy' ) {
+		return $e->event unless
+			$stat = $e->update_container_copy_bucket($container);
+	}
+
+	if( $class eq 'callnumber' ) {
+		return $e->event unless
+			$stat = $e->update_container_call_number_bucket($container);
+	}
+
+	if( $class eq 'biblio' ) {
+		return $e->event unless
+			$stat = $e->update_container_biblio_record_entry_bucket($container);
+	}
+
+	if( $class eq 'user') {
+		return $e->event unless
+			$stat = $e->update_container_user_bucket($container);
+	}
+
+	$e->commit;
+	return $stat;
+}
+
+
+
+__PACKAGE__->register_method(
+	method	=> "anon_cache",
+	api_name	=> "open-ils.actor.anon_cache.set_value",
+    signature => {
+        desc => q/
+            Sets a value in the anon web cache.  If the session key is
+            undefined, one will be automatically generated.
+        /,
+        params => [
+		    {desc => 'Session key', type => 'string'},
+            {
+                desc => q/Field name.  The name of the field in this cache session whose value to set/, 
+                type => 'string'
+            },
+            {
+                desc => q/The cached value.  This can be any type of object (hash, array, string, etc.)/,
+                type => 'any'
+            },
+        ],
+        return => {
+            desc => 'session key on success, undef on error',
+            type => 'string'
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+	method	=> "anon_cache",
+	api_name	=> "open-ils.actor.anon_cache.get_value",
+    signature => {
+        desc => q/
+            Returns the cached data at the specified field within the specified cache session.
+        /,
+        params => [
+		    {desc => 'Session key', type => 'string'},
+            {
+                desc => q/Field name.  The name of the field in this cache session whose value to set/, 
+                type => 'string'
+            },
+        ],
+        return => {
+            desc => 'cached value on success, undef on error',
+            type => 'any'
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+	method	=> "anon_cache",
+	api_name	=> "open-ils.actor.anon_cache.delete_session",
+    signature => {
+        desc => q/
+            Deletes a cache session.
+        /,
+        params => [
+		    {desc => 'Session key', type => 'string'},
+        ],
+        return => {
+            desc => 'Session key',
+            type => 'string'
+        }
+    }
+);
+
+sub anon_cache {
+    my($self, $conn, $ses_key, $field_key, $value) = @_;
+
+    my $sc = OpenSRF::Utils::SettingsClient->new;
+	my $cache = OpenSRF::Utils::Cache->new('anon');
+    my $cache_timeout = $sc->config_value(cache => anon => 'max_cache_time') || 1800; # 30 minutes
+    my $cache_size = $sc->config_value(cache => anon => 'max_cache_size') || 102400; # 100k
+
+    if($self->api_name =~ /delete_session/) {
+
+       return $cache->delete_cache($ses_key); 
+
+    }  elsif( $self->api_name =~ /set_value/ ) {
+
+        $ses_key = md5_hex(time . rand($$)) unless $ses_key;
+        my $blob = $cache->get_cache($ses_key) || {};
+        $blob->{$field_key} = $value;
+        return undef if 
+            length(OpenSRF::Utils::JSON->perl2JSON($blob)) > $cache_size; # bytes, characters, whatever ;)
+        $cache->put_cache($ses_key, $blob, $cache_timeout);
+        return $ses_key;
+
+    } else {
+
+        my $blob = $cache->get_cache($ses_key) or return undef;
+        return $blob if (!defined($field_key));
+        return $blob->{$field_key};
+    }
+}
+
+
+
+1;
+
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor/Friends.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor/Friends.pm
new file mode 100644
index 0000000000..629c3cd682
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor/Friends.pm
@@ -0,0 +1,209 @@
+package OpenILS::Application::Actor::Friends;
+use strict; use warnings;
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenSRF::Utils::Logger q/$logger/;
+use OpenILS::Utils::Fieldmapper;
+my $U = "OpenILS::Application::AppUtils";
+
+# ----------------------------------------------------------------
+# Shared Friend utilities.  Thar be no methods published here...
+# ----------------------------------------------------------------
+
+# export these fields for friend display
+my @expose_user_fields = qw/id usrname first_given_name second_given_name family_name alias/;
+
+my $out_links_query = {
+    select => {cubi => ['target_user']}, 
+    from => {
+        cub => {
+            cubi => {field => 'bucket', fkey => 'id'}
+        }
+    }, 
+    where => {
+        '+cub' => {btype => 'folks', owner => undef}
+    }
+};
+
+my $in_links_query = { 
+    select => {cub =>  ['owner'] }, 
+    from => {
+        cub => {
+            cubi => {field => 'bucket', fkey => 'id'}
+        }
+    }, 
+    where => {
+        '+cubi' => {target_user => undef}, 
+        '+cub' => {btype => 'folks'}
+    }
+};
+
+my $perm_check_query = { 
+    select => {cub =>  ['btype'] }, 
+    from => {
+        cub => {
+            cubi => {field => 'bucket', fkey => 'id'}
+        }
+    }, 
+};
+
+sub retrieve_friends {
+    my($self, $e, $user_id, $options) = @_;
+    $options ||= {};
+
+    # users I have links to
+    $out_links_query->{where}->{'+cub'}->{owner} = $user_id;
+    my @out_linked = map {$_->{target_user}} @{$e->json_query($out_links_query)};
+
+    # users who link to me
+    $in_links_query->{where}->{'+cubi'}->{target_user} = $user_id;
+    my @in_linked = map {$_->{owner}} @{$e->json_query($in_links_query)};
+
+    # determine which users are confirmed, pending outbound 
+    # requests, and pending inbound requests
+    my @confirmed;
+    my @pending_out;
+    my @pending_in;
+
+    for my $out_link (@out_linked) {
+        if(grep {$_ == $out_link} @in_linked) {
+            push(@confirmed, $out_link);
+        } else {
+            push(@pending_out, $out_link);
+        }
+    }
+
+    for my $in_link (@in_linked) {
+        push(@pending_in, $in_link)
+            unless grep {$_ == $in_link} @confirmed;
+    }
+
+    if($$options{confirmed_only}) {
+        return {
+            confirmed => $self->load_linked_user_perms($e, $user_id, @confirmed),
+        };
+    } else {
+        return {
+            confirmed => $self->load_linked_user_perms($e, $user_id, @confirmed),
+            pending_out => $self->load_linked_user_perms($e, $user_id, @pending_out),
+            pending_in => $self->load_linked_user_perms($e, $user_id, @pending_in)
+        };
+    }
+}
+
+# given a base user and set of linked users, returns the trimmed linked user
+# records, plus the perms (by name) each user has been granted
+sub load_linked_user_perms {
+    my($self, $e, $user_id, @users) = @_;
+    my $items = [];
+
+    # use this query to retrieve trimmed linked user objects
+    my $user_select = 
+        {select => {au => \@expose_user_fields}, from => 'au', where => undef};
+
+    for my $d_user (@users) {
+
+        # fetch all of the bucket items linked from base user to 
+        # delegate user with the folks: prefix on the bucket type
+        $perm_check_query->{where} = {
+            '+cubi' => {target_user => $d_user},
+            '+cub' => {btype => {like => 'folks:%'}, owner => $user_id}
+        };
+
+        my $perms_granted = [ 
+            map {substr($_->{btype}, 6)} @{$e->json_query($perm_check_query)}];
+
+        # fetch all of the bucket items linked from the delegate user 
+        # to the base user with the folks: prefix on the bucket type
+        $perm_check_query->{where} = {
+            '+cubi' => {target_user => $user_id},
+            '+cub' => {btype => {like => 'folks:%'}, owner => $d_user}
+        };
+
+        my $perms_received = [ 
+            map {substr($_->{btype}, 6)} @{$e->json_query($perm_check_query)}];
+
+        $user_select->{where} = {id => $d_user};
+        push(@$items, {
+                user => $e->json_query($user_select)->[0],
+                perms_granted => $perms_granted,
+                perms_received => $perms_received
+            }
+        );
+    }
+    return $items;
+}
+
+
+my $direct_links_query = { 
+    select => {cub =>  ['id'] }, 
+    from => {
+        cub => {
+            cubi => {field => 'bucket', fkey => 'id'}
+        }
+    }, 
+    where => {
+        '+cubi' => {target_user => undef}, 
+        '+cub' => {btype => 'folks', owner => undef}
+    },
+    limit => 1
+};
+
+sub confirmed_friends {
+    my($self, $e, $user1_id, $user2_id) = @_;
+
+    $direct_links_query->{where}->{'+cub'}->{owner} = $user1_id;
+    $direct_links_query->{where}->{'+cubi'}->{target_user} = $user2_id;
+
+    if($e->json_query($direct_links_query)->[0]) {
+        
+        $direct_links_query->{where}->{'+cub'}->{owner} = $user2_id;
+        $direct_links_query->{where}->{'+cubi'}->{target_user} = $user1_id;
+        return 1 if $e->json_query($direct_links_query)->[0];
+    }
+
+    return 0;
+}
+
+
+
+# returns 1 if delegate_user is allowed to perform 'perm' for base_user
+sub friend_perm_allowed {
+    my($self, $e, $base_user_id, $delegate_user_id, $perm) = @_;
+    return 0 unless $self->confirmed_friends($e, $base_user_id, $delegate_user_id);
+    $perm_check_query->{where} = {
+        '+cubi' => {target_user => $delegate_user_id},
+        '+cub' => {btype => "folks:$perm", owner => $base_user_id}
+    };
+    return 1 if $e->json_query($perm_check_query)->[0];
+    return 0;
+}
+
+sub apply_friend_perm {
+    my($self, $e, $base_user_id, $delegate_user_id, $perm) = @_;
+
+    my $bucket = $e->search_container_user_bucket(
+        {owner => $base_user_id, btype => "folks:$perm"})->[0];
+
+    if($bucket) {
+        # is the permission already set?
+        return undef if $e->search_container_user_bucket_item(
+            {bucket => $bucket->id, target_user => $delegate_user_id})->[0];
+
+    } else {
+        # make sure the perm-specific bucket exists for this user
+        $bucket = Fieldmapper::container::user_bucket->new;
+        $bucket->owner($base_user_id);
+        $bucket->btype("folks:$perm");
+        $bucket->name("folks:$perm");
+        $e->create_container_user_bucket($bucket) or return $e->die_event;
+    }
+
+    my $item = Fieldmapper::container::user_bucket_item->new;
+    $item->bucket($bucket->id);
+    $item->target_user($delegate_user_id);
+    $e->create_container_user_bucket_item($item) or return $e->die_event;
+    return undef;
+}
+
+23;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor/Stage.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor/Stage.pm
new file mode 100644
index 0000000000..0e65c12c25
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor/Stage.pm
@@ -0,0 +1,176 @@
+package OpenILS::Application::Actor::Stage;
+use strict; use warnings;
+use base 'OpenILS::Application';
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenSRF::Utils::Logger q/$logger/;
+use OpenILS::Utils::Fieldmapper;
+my $U = "OpenILS::Application::AppUtils";
+
+
+__PACKAGE__->register_method (
+	method		=> 'create_user_stage',
+	api_name    => 'open-ils.actor.user.stage.create',
+    signature => {
+        desc => q/
+            Creates a new pending user account including addresses and statcats.
+            Users are added to staging tables pending staff review.
+        /,
+        params => [
+		    {desc => 'user', type => 'object', class => 'stgu'},
+		    {desc => 'Mailing address.  Optional', type => 'object', class => 'stgma'},
+		    {desc => 'Billing address.  Optional', type => 'object', class => 'stgba'},
+		    {desc => 'Statcats.  Optional.  This is an array of "stgsc" objects', type => 'array'},
+        ],
+        return => {
+            desc => 'username on success, Event on error',
+            type => ''
+        }
+
+    }
+);
+
+sub create_user_stage {
+    my($self, $conn, $user, $mail_addr, $bill_addr, $statcats) = @_; # more?
+
+    return 0 unless $U->ou_ancestor_setting_value('opac.allow_pending_user');
+    return OpenILS::Event->new('BAD_PARAMS') unless $user;
+
+    my $e = new_editor(xact => 1);
+
+    my $uname = $U->create_uuid_string;
+    $user->usrname($uname);
+
+    $e->create_staging_user_stage($user) or return $e->die_event;
+
+    if($mail_addr) {
+        $mail_addr->usrname($uname);
+        $e->create_staging_mailing_address_stage($mail_addr) or return $e->die_event;
+    }
+
+    if($bill_addr) {
+        $bill_addr->usrname($uname);
+        $e->create_staging_billing_address_stage($bill_addr) or return $e->die_event;
+    }
+
+    if($statcats) {
+        foreach (@$statcats) {
+            $_->usrname($uname);
+            $e->create_staging_statcat_stage($_) or return $e->die_event;
+        }
+    }
+
+    $e->commit;
+    $conn->respond_complete($uname);
+
+    $U->create_events_for_hook('stgu.create', $user, $user->home_ou);
+    return undef;
+}
+
+__PACKAGE__->register_method (
+	method		=> 'user_stage_by_org',
+	api_name    => 'open-ils.actor.user.stage.retrieve.by_org',
+    stream      => 1
+);
+
+sub user_stage_by_org {
+    my($self, $conn, $auth, $org_id, $limit, $offset) = @_;
+
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+    $org_id ||= $e->requestor->ws_ou;
+    return $e->event unless $e->allowed('VIEW_USER', $org_id);
+
+    $limit ||= 100;
+    $offset ||= 0;
+
+    my $stage_ids = $e->search_staging_user_stage(
+        [
+            {   home_ou => $org_id, complete => 'f'}, 
+            {   limit => $limit, 
+                offset => $offset, 
+                order_by => {stgu => 'row_id'}
+            }
+        ],
+        {idlist => 1}
+    );
+
+    $conn->respond(flesh_user_stage($e, $_)) for @$stage_ids;
+    return undef;
+}
+
+sub flesh_user_stage {
+    my($e, $row_id) = @_;
+    my $user = $e->retrieve_staging_user_stage($row_id) or return undef;
+    return {
+        user => $user,
+        billing_addresses => $e->search_staging_billing_address_stage({usrname => $user->usrname}),
+        mailing_addresses => $e->search_staging_mailing_address_stage({usrname => $user->usrname}),
+        cards => $e->search_staging_card_stage({usrname => $user->usrname}),
+        statcats => $e->search_staging_statcat_stage({usrname => $user->usrname})
+    };
+}
+
+
+__PACKAGE__->register_method (
+	method		=> 'user_stage_by_uname',
+	api_name    => 'open-ils.actor.user.stage.retrieve.by_username',
+);
+
+sub user_stage_by_uname {
+    my($self, $conn, $auth, $username) = @_;
+
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    my $user = $e->search_staging_user_stage({
+        usrname => $username, 
+        complete => 'f'
+    })->[0] or return $e->event;
+
+    return $e->event unless $e->allowed('VIEW_USER', $user->home_ou);
+    return flesh_user_stage($e, $user->row_id);
+}
+
+
+
+
+__PACKAGE__->register_method (
+	method		=> 'delete_user_stage', 
+	api_name    => 'open-ils.actor.user.stage.delete',
+);
+
+sub delete_user_stage {
+    my($self, $conn, $auth, $row_id) = @_;
+
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+    my $data = flesh_user_stage($e, $row_id) or return $e->die_event;
+
+    return $e->die_event unless $e->allowed('UPDATE_USER', $data->{user}->home_ou);
+
+    $e->delete_staging_user_stage($data->{user}) or return $e->die_event;
+
+    for my $addr (@{$data->{mailing_addresses}}) {
+        $e->delete_staging_mailing_address_stage($addr) or return $e->die_event;
+    }
+
+    for my $addr (@{$data->{billing_addresses}}) {
+        $e->delete_staging_billing_address_stage($addr) or return $e->die_event;
+    }
+
+    for my $card (@{$data->{cards}}) {
+        $e->delete_staging_card_stage($card) or return $e->die_event;
+    }
+
+    for my $statcat (@{$data->{statcats}}) {
+        $e->delete_staging_statcat_stage($statcat) or return $e->die_event;
+    }
+
+    $e->commit;
+    return 1;
+}
+
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor/UserGroups.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor/UserGroups.pm
new file mode 100644
index 0000000000..7691fe5c94
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Actor/UserGroups.pm
@@ -0,0 +1,152 @@
+package OpenILS::Application::Actor::UserGroups;
+use base 'OpenILS::Application';
+use strict; use warnings;
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenSRF::Utils::Logger q/$logger/;
+use OpenSRF::EX qw(:try);
+my $U = "OpenILS::Application::AppUtils";
+
+sub initialize { return 1; }
+
+
+
+__PACKAGE__->register_method(
+	method => 'group_money_summary',
+	api_name	=> 'open-ils.actor.usergroup.members.balance_owed',
+    authoritative => 1,
+	signature	=> q/
+	/
+);
+
+sub group_money_summary {
+	my($self, $conn, $auth, $group_id) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('VIEW_USER');
+
+	my $users = $e->search_actor_user({usrgroup => $group_id}, {idlist => 1});
+    my @mous;
+
+    for my $uid ( @$users ) {
+        push @mous, @{$e->json_query(
+            {
+                select => {mous => ['usr', 'balance_owed']},
+                from => 'mous',
+                where => { usr => $uid }
+            }
+        )};
+    }
+
+    return \@mous;
+}
+
+
+__PACKAGE__->register_method(
+	method => 'get_users_from_usergroup',
+	api_name	=> 'open-ils.actor.usergroup.members.retrieve',
+    authoritative => 1,
+	signature	=> q/
+		Returns a list of ids for users that are in the given usergroup
+	/
+);
+
+sub get_users_from_usergroup {
+	my( $self, $conn, $auth, $usergroup ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('VIEW_USER'); # XXX reley on editor perm
+	return $e->search_actor_user({usrgroup => $usergroup}, {idlist => 1});
+}
+
+
+
+__PACKAGE__->register_method(
+	method => 'get_leaders_from_usergroup',
+	api_name	=> 'open-ils.actor.usergroup.leaders.retrieve',
+	signature	=> q/
+		Returns a list of ids for users that are leaders of the given usergroup
+	/
+);
+
+sub get_leaders_from_usergroup {
+	my( $self, $conn, $auth, $usergroup ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('VIEW_USER'); # XXX reley on editor perm
+	my $users = $e->search_actor_user({usrgroup => $usergroup})
+		or return $e->event;
+
+	my @res;
+	for my $u (@$users) {
+		push( @res, $u->id ) if $u->master_account;
+	}
+
+	return \@res;
+}
+
+
+
+__PACKAGE__->register_method(
+	method => 'get_address_members',
+	api_name	=> 'open-ils.actor.address.members',
+	signature	=> q/
+		Returns a list of ids for users that link to the given address
+		@param auth
+		@param addrid The address id
+	/
+);
+
+sub get_address_members {
+	my( $self, $conn, $auth, $addrid ) = @_;
+
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('VIEW_USER'); # XXX reley on editor perm
+
+	my $ad = $e->retrieve_actor_user_address($addrid) or return $e->event;
+	my $ma = $e->search_actor_user({mailing_address => $addrid}, {idlist => 1});
+	my $ba = $e->search_actor_user({billing_address => $addrid}, {idlist => 1});
+
+	my @list = (@$ma, @$ba, $ad->usr);
+	my %dedup = map { $_ => 1 } @list;
+	return [ keys %dedup ];
+}
+
+
+
+__PACKAGE__->register_method(
+	method	=> 'reset_group',
+	api_name	=> 'open-ils.actor.usergroup.new',
+	signature	=> q/
+		Gives the requested user a new empty usergroup.  
+		@param auth The auth token
+		@param userid The id of the user who needs the new usergroup
+		@param leader If true, this user will be marked as the group leader
+	/
+);
+
+sub reset_group {
+	my( $self, $conn, $auth, $userid, $leader ) = @_;
+
+	my $e = new_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('UPDATE_USER'); # XXX reley on editor perm
+
+	my $user = $e->retrieve_actor_user($userid) or return $e->die_event;
+
+	# ask for a new group id
+	my $groupid = $U->storagereq('open-ils.storage.actor.user.group_id.new');
+
+	$user->usrgroup($groupid);
+	$user->master_account('t') if $leader;
+
+	$e->update_actor_user($user) or return $e->die_event;
+	$e->commit;
+	return $groupid;
+}
+
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/AppUtils.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/AppUtils.pm
new file mode 100644
index 0000000000..ec5c56fd93
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/AppUtils.pm
@@ -0,0 +1,1801 @@
+package OpenILS::Application::AppUtils;
+# vim:noet:ts=4
+use strict; use warnings;
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+use OpenSRF::Utils::Cache;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenILS::Utils::ModsParser;
+use OpenSRF::EX qw(:try);
+use OpenILS::Event;
+use Data::Dumper;
+use OpenILS::Utils::CStoreEditor;
+use OpenILS::Const qw/:const/;
+use Unicode::Normalize;
+use OpenSRF::Utils::SettingsClient;
+use UUID::Tiny;
+use Encode;
+
+# ---------------------------------------------------------------------------
+# Pile of utilty methods used accross applications.
+# ---------------------------------------------------------------------------
+my $cache_client = "OpenSRF::Utils::Cache";
+
+
+# ---------------------------------------------------------------------------
+# on sucess, returns the created session, on failure throws ERROR exception
+# ---------------------------------------------------------------------------
+sub start_db_session {
+
+	my $self = shift;
+	my $session = OpenSRF::AppSession->connect( "open-ils.storage" );
+	my $trans_req = $session->request( "open-ils.storage.transaction.begin" );
+
+	my $trans_resp = $trans_req->recv();
+	if(ref($trans_resp) and UNIVERSAL::isa($trans_resp,"Error")) { throw $trans_resp; }
+	if( ! $trans_resp->content() ) {
+		throw OpenSRF::ERROR 
+			("Unable to Begin Transaction with database" );
+	}
+	$trans_req->finish();
+
+	$logger->debug("Setting global storage session to ".
+		"session: " . $session->session_id . " : " . $session->app );
+
+	return $session;
+}
+
+my $PERM_QUERY = {
+    select => {
+        au => [ {
+            transform => 'permission.usr_has_perm',
+            alias => 'has_perm',
+            column => 'id',
+            params => []
+        } ]
+    },
+    from => 'au',
+    where => {},
+};
+
+
+# returns undef if user has all of the perms provided
+# returns the first failed perm on failure
+sub check_user_perms {
+	my($self, $user_id, $org_id, @perm_types ) = @_;
+	$logger->debug("Checking perms with user : $user_id , org: $org_id, @perm_types");
+
+	for my $type (@perm_types) {
+	    $PERM_QUERY->{select}->{au}->[0]->{params} = [$type, $org_id];
+		$PERM_QUERY->{where}->{id} = $user_id;
+		return $type unless $self->is_true(OpenILS::Utils::CStoreEditor->new->json_query($PERM_QUERY)->[0]->{has_perm});
+	}
+	return undef;
+}
+
+# checks the list of user perms.  The first one that fails returns a new
+sub check_perms {
+	my( $self, $user_id, $org_id, @perm_types ) = @_;
+	my $t = $self->check_user_perms( $user_id, $org_id, @perm_types );
+	return OpenILS::Event->new('PERM_FAILURE', ilsperm => $t, ilspermloc => $org_id ) if $t;
+	return undef;
+}
+
+
+
+# ---------------------------------------------------------------------------
+# commits and destroys the session
+# ---------------------------------------------------------------------------
+sub commit_db_session {
+	my( $self, $session ) = @_;
+
+	my $req = $session->request( "open-ils.storage.transaction.commit" );
+	my $resp = $req->recv();
+
+	if(!$resp) {
+		throw OpenSRF::EX::ERROR ("Unable to commit db session");
+	}
+
+	if(UNIVERSAL::isa($resp,"Error")) { 
+		throw $resp ($resp->stringify); 
+	}
+
+	if(!$resp->content) {
+		throw OpenSRF::EX::ERROR ("Unable to commit db session");
+	}
+
+	$session->finish();
+	$session->disconnect();
+	$session->kill_me();
+}
+
+sub rollback_db_session {
+	my( $self, $session ) = @_;
+
+	my $req = $session->request("open-ils.storage.transaction.rollback");
+	my $resp = $req->recv();
+	if(UNIVERSAL::isa($resp,"Error")) { throw $resp;  }
+
+	$session->finish();
+	$session->disconnect();
+	$session->kill_me();
+}
+
+
+# returns undef it the event is not an ILS event
+# returns the event code otherwise
+sub event_code {
+	my( $self, $evt ) = @_;
+	return $evt->{ilsevent} if( ref($evt) eq 'HASH' and defined($evt->{ilsevent})) ;
+	return undef;
+}
+
+# ---------------------------------------------------------------------------
+# Checks to see if a user is logged in.  Returns the user record on success,
+# throws an exception on error.
+# ---------------------------------------------------------------------------
+sub check_user_session {
+	my( $self, $user_session ) = @_;
+
+	my $content = $self->simplereq( 
+		'open-ils.auth', 
+		'open-ils.auth.session.retrieve', $user_session);
+
+    return undef if (!$content) or $self->event_code($content);
+	return $content;
+}
+
+# generic simple request returning a scalar value
+sub simplereq {
+	my($self, $service, $method, @params) = @_;
+	return $self->simple_scalar_request($service, $method, @params);
+}
+
+
+sub simple_scalar_request {
+	my($self, $service, $method, @params) = @_;
+
+	my $session = OpenSRF::AppSession->create( $service );
+
+	my $request = $session->request( $method, @params );
+
+	my $val;
+	my $err;
+	try  {
+
+		$val = $request->gather(1);	
+
+	} catch Error with {
+		$err = shift;
+	};
+
+	if( $err ) {
+		warn "received error : service=$service : method=$method : params=".Dumper(\@params) . "\n $err";
+		throw $err ("Call to $service for method $method \n failed with exception: $err : " );
+	}
+
+	return $val;
+}
+
+
+
+
+
+my $tree						= undef;
+my $orglist					= undef;
+my $org_typelist			= undef;
+my $org_typelist_hash	= {};
+
+sub __get_org_tree {
+	
+	# can we throw this version away??
+
+	my $self = shift;
+	if($tree) { return $tree; }
+
+	# see if it's in the cache
+	$tree = $cache_client->new()->get_cache('_orgtree');
+	if($tree) { return $tree; }
+
+	if(!$orglist) {
+		warn "Retrieving Org Tree\n";
+		$orglist = $self->simple_scalar_request( 
+			"open-ils.cstore", 
+			"open-ils.cstore.direct.actor.org_unit.search.atomic",
+			{ id => { '!=' => undef } }
+		);
+	}
+
+	if( ! $org_typelist ) {
+		warn "Retrieving org types\n";
+		$org_typelist = $self->simple_scalar_request( 
+			"open-ils.cstore", 
+			"open-ils.cstore.direct.actor.org_unit_type.search.atomic",
+			{ id => { '!=' => undef } }
+		);
+		$self->build_org_type($org_typelist);
+	}
+
+	$tree = $self->build_org_tree($orglist,1);
+	$cache_client->new()->put_cache('_orgtree', $tree);
+	return $tree;
+
+}
+
+my $slimtree = undef;
+sub get_slim_org_tree {
+
+	my $self = shift;
+	if($slimtree) { return $slimtree; }
+
+	# see if it's in the cache
+	$slimtree = $cache_client->new()->get_cache('slimorgtree');
+	if($slimtree) { return $slimtree; }
+
+	if(!$orglist) {
+		warn "Retrieving Org Tree\n";
+		$orglist = $self->simple_scalar_request( 
+			"open-ils.cstore", 
+			"open-ils.cstore.direct.actor.org_unit.search.atomic",
+			{ id => { '!=' => undef } }
+		);
+	}
+
+	$slimtree = $self->build_org_tree($orglist);
+	$cache_client->new->put_cache('slimorgtree', $slimtree);
+	return $slimtree;
+
+}
+
+
+sub build_org_type { 
+	my($self, $org_typelist)  = @_;
+	for my $type (@$org_typelist) {
+		$org_typelist_hash->{$type->id()} = $type;
+	}
+}
+
+
+
+sub build_org_tree {
+
+	my( $self, $orglist, $add_types ) = @_;
+
+	return $orglist unless ref $orglist; 
+    return $$orglist[0] if @$orglist == 1;
+
+	my @list = sort { 
+		$a->ou_type <=> $b->ou_type ||
+		$a->name cmp $b->name } @$orglist;
+
+	for my $org (@list) {
+
+		next unless ($org);
+
+		if(!ref($org->ou_type()) and $add_types) {
+			$org->ou_type( $org_typelist_hash->{$org->ou_type()});
+		}
+
+        next if (!defined($org->parent_ou) || $org->parent_ou eq "");
+
+		my ($parent) = grep { $_->id == $org->parent_ou } @list;
+		next unless $parent;
+		$parent->children([]) unless defined($parent->children); 
+		push( @{$parent->children}, $org );
+	}
+
+	return $list[0];
+}
+
+sub fetch_closed_date {
+	my( $self, $cd ) = @_;
+	my $evt;
+	
+	$logger->debug("Fetching closed_date $cd from cstore");
+
+	my $cd_obj = $self->simplereq(
+		'open-ils.cstore',
+		'open-ils.cstore.direct.actor.org_unit.closed_date.retrieve', $cd );
+
+	if(!$cd_obj) {
+		$logger->info("closed_date $cd not found in the db");
+		$evt = OpenILS::Event->new('ACTOR_USER_NOT_FOUND');
+	}
+
+	return ($cd_obj, $evt);
+}
+
+sub fetch_user {
+	my( $self, $userid ) = @_;
+	my( $user, $evt );
+	
+	$logger->debug("Fetching user $userid from cstore");
+
+	$user = $self->simplereq(
+		'open-ils.cstore',
+		'open-ils.cstore.direct.actor.user.retrieve', $userid );
+
+	if(!$user) {
+		$logger->info("User $userid not found in the db");
+		$evt = OpenILS::Event->new('ACTOR_USER_NOT_FOUND');
+	}
+
+	return ($user, $evt);
+}
+
+sub checkses {
+	my( $self, $session ) = @_;
+	my $user = $self->check_user_session($session) or 
+        return (undef, OpenILS::Event->new('NO_SESSION'));
+    return ($user);
+}
+
+
+# verifiese the session and checks the permissions agains the
+# session user and the user's home_ou as the org id
+sub checksesperm {
+	my( $self, $session, @perms ) = @_;
+	my $user; my $evt; my $e; 
+	$logger->debug("Checking user session $session and perms @perms");
+	($user, $evt) = $self->checkses($session);
+	return (undef, $evt) if $evt;
+	$evt = $self->check_perms($user->id, $user->home_ou, @perms);
+	return ($user, $evt);
+}
+
+
+sub checkrequestor {
+	my( $self, $staffobj, $userid, @perms ) = @_;
+	my $user; my $evt;
+	$userid = $staffobj->id unless defined $userid;
+
+	$logger->debug("checkrequestor(): requestor => " . $staffobj->id . ", target => $userid");
+
+	if( $userid ne $staffobj->id ) {
+		($user, $evt) = $self->fetch_user($userid);
+		return (undef, $evt) if $evt;
+		$evt = $self->check_perms( $staffobj->id, $user->home_ou, @perms );
+
+	} else {
+		$user = $staffobj;
+	}
+
+	return ($user, $evt);
+}
+
+sub checkses_requestor {
+	my( $self, $authtoken, $targetid, @perms ) = @_;
+	my( $requestor, $target, $evt );
+
+	($requestor, $evt) = $self->checkses($authtoken);
+	return (undef, undef, $evt) if $evt;
+
+	($target, $evt) = $self->checkrequestor( $requestor, $targetid, @perms );
+	return( $requestor, $target, $evt);
+}
+
+sub fetch_copy {
+	my( $self, $copyid ) = @_;
+	my( $copy, $evt );
+
+	$logger->debug("Fetching copy $copyid from cstore");
+
+	$copy = $self->simplereq(
+		'open-ils.cstore',
+		'open-ils.cstore.direct.asset.copy.retrieve', $copyid );
+
+	if(!$copy) { $evt = OpenILS::Event->new('ASSET_COPY_NOT_FOUND'); }
+
+	return( $copy, $evt );
+}
+
+
+# retrieves a circ object by id
+sub fetch_circulation {
+	my( $self, $circid ) = @_;
+	my $circ; my $evt;
+	
+	$logger->debug("Fetching circ $circid from cstore");
+
+	$circ = $self->simplereq(
+		'open-ils.cstore',
+		"open-ils.cstore.direct.action.circulation.retrieve", $circid );
+
+	if(!$circ) {
+		$evt = OpenILS::Event->new('ACTION_CIRCULATION_NOT_FOUND', circid => $circid );
+	}
+
+	return ( $circ, $evt );
+}
+
+sub fetch_record_by_copy {
+	my( $self, $copyid ) = @_;
+	my( $record, $evt );
+
+	$logger->debug("Fetching record by copy $copyid from cstore");
+
+	$record = $self->simplereq(
+		'open-ils.cstore',
+		'open-ils.cstore.direct.asset.copy.retrieve', $copyid,
+		{ flesh => 3,
+		  flesh_fields => {	bre => [ 'fixed_fields' ],
+					acn => [ 'record' ],
+					acp => [ 'call_number' ],
+				  }
+		}
+	);
+
+	if(!$record) {
+		$evt = OpenILS::Event->new('BIBLIO_RECORD_ENTRY_NOT_FOUND');
+	} else {
+		$record = $record->call_number->record;
+	}
+
+	return ($record, $evt);
+}
+
+# turns a record object into an mvr (mods) object
+sub record_to_mvr {
+	my( $self, $record ) = @_;
+	return undef unless $record and $record->marc;
+	my $u = OpenILS::Utils::ModsParser->new();
+	$u->start_mods_batch( $record->marc );
+	my $mods = $u->finish_mods_batch();
+	$mods->doc_id($record->id);
+   $mods->tcn($record->tcn_value);
+	return $mods;
+}
+
+sub fetch_hold {
+	my( $self, $holdid ) = @_;
+	my( $hold, $evt );
+
+	$logger->debug("Fetching hold $holdid from cstore");
+
+	$hold = $self->simplereq(
+		'open-ils.cstore',
+		'open-ils.cstore.direct.action.hold_request.retrieve', $holdid);
+
+	$evt = OpenILS::Event->new('ACTION_HOLD_REQUEST_NOT_FOUND', holdid => $holdid) unless $hold;
+
+	return ($hold, $evt);
+}
+
+
+sub fetch_hold_transit_by_hold {
+	my( $self, $holdid ) = @_;
+	my( $transit, $evt );
+
+	$logger->debug("Fetching transit by hold $holdid from cstore");
+
+	$transit = $self->simplereq(
+		'open-ils.cstore',
+		'open-ils.cstore.direct.action.hold_transit_copy.search', { hold => $holdid } );
+
+	$evt = OpenILS::Event->new('ACTION_HOLD_TRANSIT_COPY_NOT_FOUND', holdid => $holdid) unless $transit;
+
+	return ($transit, $evt );
+}
+
+# fetches the captured, but not fulfilled hold attached to a given copy
+sub fetch_open_hold_by_copy {
+	my( $self, $copyid ) = @_;
+	$logger->debug("Searching for active hold for copy $copyid");
+	my( $hold, $evt );
+
+	$hold = $self->cstorereq(
+		'open-ils.cstore.direct.action.hold_request.search',
+		{ 
+			current_copy		=> $copyid , 
+			capture_time		=> { "!=" => undef }, 
+			fulfillment_time	=> undef,
+			cancel_time			=> undef,
+		} );
+
+	$evt = OpenILS::Event->new('ACTION_HOLD_REQUEST_NOT_FOUND', copyid => $copyid) unless $hold;
+	return ($hold, $evt);
+}
+
+sub fetch_hold_transit {
+	my( $self, $transid ) = @_;
+	my( $htransit, $evt );
+	$logger->debug("Fetching hold transit with hold id $transid");
+	$htransit = $self->cstorereq(
+		'open-ils.cstore.direct.action.hold_transit_copy.retrieve', $transid );
+	$evt = OpenILS::Event->new('ACTION_HOLD_TRANSIT_COPY_NOT_FOUND', id => $transid) unless $htransit;
+	return ($htransit, $evt);
+}
+
+sub fetch_copy_by_barcode {
+	my( $self, $barcode ) = @_;
+	my( $copy, $evt );
+
+	$logger->debug("Fetching copy by barcode $barcode from cstore");
+
+	$copy = $self->simplereq( 'open-ils.cstore',
+		'open-ils.cstore.direct.asset.copy.search', { barcode => $barcode, deleted => 'f'} );
+		#'open-ils.storage.direct.asset.copy.search.barcode', $barcode );
+
+	$evt = OpenILS::Event->new('ASSET_COPY_NOT_FOUND', barcode => $barcode) unless $copy;
+
+	return ($copy, $evt);
+}
+
+sub fetch_open_billable_transaction {
+	my( $self, $transid ) = @_;
+	my( $transaction, $evt );
+
+	$logger->debug("Fetching open billable transaction $transid from cstore");
+
+	$transaction = $self->simplereq(
+		'open-ils.cstore',
+		'open-ils.cstore.direct.money.open_billable_transaction_summary.retrieve',  $transid);
+
+	$evt = OpenILS::Event->new(
+		'MONEY_OPEN_BILLABLE_TRANSACTION_SUMMARY_NOT_FOUND', transid => $transid ) unless $transaction;
+
+	return ($transaction, $evt);
+}
+
+
+
+my %buckets;
+$buckets{'biblio'} = 'biblio_record_entry_bucket';
+$buckets{'callnumber'} = 'call_number_bucket';
+$buckets{'copy'} = 'copy_bucket';
+$buckets{'user'} = 'user_bucket';
+
+sub fetch_container {
+	my( $self, $id, $type ) = @_;
+	my( $bucket, $evt );
+
+	$logger->debug("Fetching container $id with type $type");
+
+	my $e = 'CONTAINER_CALL_NUMBER_BUCKET_NOT_FOUND';
+	$e = 'CONTAINER_BIBLIO_RECORD_ENTRY_BUCKET_NOT_FOUND' if $type eq 'biblio';
+	$e = 'CONTAINER_USER_BUCKET_NOT_FOUND' if $type eq 'user';
+	$e = 'CONTAINER_COPY_BUCKET_NOT_FOUND' if $type eq 'copy';
+
+	my $meth = $buckets{$type};
+	$bucket = $self->simplereq(
+		'open-ils.cstore',
+		"open-ils.cstore.direct.container.$meth.retrieve", $id );
+
+	$evt = OpenILS::Event->new(
+		$e, container => $id, container_type => $type ) unless $bucket;
+
+	return ($bucket, $evt);
+}
+
+
+sub fetch_container_e {
+	my( $self, $editor, $id, $type ) = @_;
+
+	my( $bucket, $evt );
+	$bucket = $editor->retrieve_container_copy_bucket($id) if $type eq 'copy';
+	$bucket = $editor->retrieve_container_call_number_bucket($id) if $type eq 'callnumber';
+	$bucket = $editor->retrieve_container_biblio_record_entry_bucket($id) if $type eq 'biblio';
+	$bucket = $editor->retrieve_container_user_bucket($id) if $type eq 'user';
+
+	$evt = $editor->event unless $bucket;
+	return ($bucket, $evt);
+}
+
+sub fetch_container_item_e {
+	my( $self, $editor, $id, $type ) = @_;
+
+	my( $bucket, $evt );
+	$bucket = $editor->retrieve_container_copy_bucket_item($id) if $type eq 'copy';
+	$bucket = $editor->retrieve_container_call_number_bucket_item($id) if $type eq 'callnumber';
+	$bucket = $editor->retrieve_container_biblio_record_entry_bucket_item($id) if $type eq 'biblio';
+	$bucket = $editor->retrieve_container_user_bucket_item($id) if $type eq 'user';
+
+	$evt = $editor->event unless $bucket;
+	return ($bucket, $evt);
+}
+
+
+
+
+
+sub fetch_container_item {
+	my( $self, $id, $type ) = @_;
+	my( $bucket, $evt );
+
+	$logger->debug("Fetching container item $id with type $type");
+
+	my $meth = $buckets{$type} . "_item";
+
+	$bucket = $self->simplereq(
+		'open-ils.cstore',
+		"open-ils.cstore.direct.container.$meth.retrieve", $id );
+
+
+	my $e = 'CONTAINER_CALL_NUMBER_BUCKET_ITEM_NOT_FOUND';
+	$e = 'CONTAINER_BIBLIO_RECORD_ENTRY_BUCKET_ITEM_NOT_FOUND' if $type eq 'biblio';
+	$e = 'CONTAINER_USER_BUCKET_ITEM_NOT_FOUND' if $type eq 'user';
+	$e = 'CONTAINER_COPY_BUCKET_ITEM_NOT_FOUND' if $type eq 'copy';
+
+	$evt = OpenILS::Event->new(
+		$e, itemid => $id, container_type => $type ) unless $bucket;
+
+	return ($bucket, $evt);
+}
+
+
+sub fetch_patron_standings {
+	my $self = shift;
+	$logger->debug("Fetching patron standings");	
+	return $self->simplereq(
+		'open-ils.cstore', 
+		'open-ils.cstore.direct.config.standing.search.atomic', { id => { '!=' => undef } });
+}
+
+
+sub fetch_permission_group_tree {
+	my $self = shift;
+	$logger->debug("Fetching patron profiles");	
+	return $self->simplereq(
+		'open-ils.actor', 
+		'open-ils.actor.groups.tree.retrieve' );
+}
+
+sub fetch_permission_group_descendants {
+    my( $self, $profile ) = @_;
+    my $group_tree = $self->fetch_permission_group_tree();
+    my $start_here;
+    my @groups;
+
+    # FIXME: okay, so it's not an org tree, but it is compatible
+    $self->walk_org_tree($group_tree, sub {
+        my $g = shift;
+        if ($g->id == $profile) {
+            $start_here = $g;
+        }
+    });
+
+    $self->walk_org_tree($start_here, sub {
+        my $g = shift;
+        push(@groups,$g->id);
+    });
+
+    return \@groups;
+}
+
+sub fetch_patron_circ_summary {
+	my( $self, $userid ) = @_;
+	$logger->debug("Fetching patron summary for $userid");
+	my $summary = $self->simplereq(
+		'open-ils.storage', 
+		"open-ils.storage.action.circulation.patron_summary", $userid );
+
+	if( $summary ) {
+		$summary->[0] ||= 0;
+		$summary->[1] ||= 0.0;
+		return $summary;
+	}
+	return undef;
+}
+
+
+sub fetch_copy_statuses {
+	my( $self ) = @_;
+	$logger->debug("Fetching copy statuses");
+	return $self->simplereq(
+		'open-ils.cstore', 
+		'open-ils.cstore.direct.config.copy_status.search.atomic', { id => { '!=' => undef } });
+}
+
+sub fetch_copy_location {
+	my( $self, $id ) = @_;
+	my $evt;
+	my $cl = $self->cstorereq(
+		'open-ils.cstore.direct.asset.copy_location.retrieve', $id );
+	$evt = OpenILS::Event->new('ASSET_COPY_LOCATION_NOT_FOUND') unless $cl;
+	return ($cl, $evt);
+}
+
+sub fetch_copy_locations {
+	my $self = shift; 
+	return $self->simplereq(
+		'open-ils.cstore', 
+		'open-ils.cstore.direct.asset.copy_location.search.atomic', { id => { '!=' => undef } });
+}
+
+sub fetch_copy_location_by_name {
+	my( $self, $name, $org ) = @_;
+	my $evt;
+	my $cl = $self->cstorereq(
+		'open-ils.cstore.direct.asset.copy_location.search',
+			{ name => $name, owning_lib => $org } );
+	$evt = OpenILS::Event->new('ASSET_COPY_LOCATION_NOT_FOUND') unless $cl;
+	return ($cl, $evt);
+}
+
+sub fetch_callnumber {
+	my( $self, $id ) = @_;
+	my $evt = undef;
+
+	my $e = OpenILS::Event->new( 'ASSET_CALL_NUMBER_NOT_FOUND', id => $id );
+	return( undef, $e ) unless $id;
+
+	$logger->debug("Fetching callnumber $id");
+
+	my $cn = $self->simplereq(
+		'open-ils.cstore',
+		'open-ils.cstore.direct.asset.call_number.retrieve', $id );
+	$evt = $e  unless $cn;
+
+	return ( $cn, $evt );
+}
+
+my %ORG_CACHE; # - these rarely change, so cache them..
+sub fetch_org_unit {
+	my( $self, $id ) = @_;
+	return undef unless $id;
+	return $id if( ref($id) eq 'Fieldmapper::actor::org_unit' );
+	return $ORG_CACHE{$id} if $ORG_CACHE{$id};
+	$logger->debug("Fetching org unit $id");
+	my $evt = undef;
+
+	my $org = $self->simplereq(
+		'open-ils.cstore', 
+		'open-ils.cstore.direct.actor.org_unit.retrieve', $id );
+	$evt = OpenILS::Event->new( 'ACTOR_ORG_UNIT_NOT_FOUND', id => $id ) unless $org;
+	$ORG_CACHE{$id}  = $org;
+
+	return ($org, $evt);
+}
+
+sub fetch_stat_cat {
+	my( $self, $type, $id ) = @_;
+	my( $cat, $evt );
+	$logger->debug("Fetching $type stat cat: $id");
+	$cat = $self->simplereq(
+		'open-ils.cstore', 
+		"open-ils.cstore.direct.$type.stat_cat.retrieve", $id );
+
+	my $e = 'ASSET_STAT_CAT_NOT_FOUND';
+	$e = 'ACTOR_STAT_CAT_NOT_FOUND' if $type eq 'actor';
+
+	$evt = OpenILS::Event->new( $e, id => $id ) unless $cat;
+	return ( $cat, $evt );
+}
+
+sub fetch_stat_cat_entry {
+	my( $self, $type, $id ) = @_;
+	my( $entry, $evt );
+	$logger->debug("Fetching $type stat cat entry: $id");
+	$entry = $self->simplereq(
+		'open-ils.cstore', 
+		"open-ils.cstore.direct.$type.stat_cat_entry.retrieve", $id );
+
+	my $e = 'ASSET_STAT_CAT_ENTRY_NOT_FOUND';
+	$e = 'ACTOR_STAT_CAT_ENTRY_NOT_FOUND' if $type eq 'actor';
+
+	$evt = OpenILS::Event->new( $e, id => $id ) unless $entry;
+	return ( $entry, $evt );
+}
+
+
+sub find_org {
+	my( $self, $org_tree, $orgid )  = @_;
+    return undef unless $org_tree and defined $orgid;
+	return $org_tree if ( $org_tree->id eq $orgid );
+	return undef unless ref($org_tree->children);
+	for my $c (@{$org_tree->children}) {
+		my $o = $self->find_org($c, $orgid);
+		return $o if $o;
+	}
+	return undef;
+}
+
+sub fetch_non_cat_type_by_name_and_org {
+	my( $self, $name, $orgId ) = @_;
+	$logger->debug("Fetching non cat type $name at org $orgId");
+	my $types = $self->simplereq(
+		'open-ils.cstore',
+		'open-ils.cstore.direct.config.non_cataloged_type.search.atomic',
+		{ name => $name, owning_lib => $orgId } );
+	return ($types->[0], undef) if($types and @$types);
+	return (undef, OpenILS::Event->new('CONFIG_NON_CATALOGED_TYPE_NOT_FOUND') );
+}
+
+sub fetch_non_cat_type {
+	my( $self, $id ) = @_;
+	$logger->debug("Fetching non cat type $id");
+	my( $type, $evt );
+	$type = $self->simplereq(
+		'open-ils.cstore', 
+		'open-ils.cstore.direct.config.non_cataloged_type.retrieve', $id );
+	$evt = OpenILS::Event->new('CONFIG_NON_CATALOGED_TYPE_NOT_FOUND') unless $type;
+	return ($type, $evt);
+}
+
+sub DB_UPDATE_FAILED { 
+	my( $self, $payload ) = @_;
+	return OpenILS::Event->new('DATABASE_UPDATE_FAILED', 
+		payload => ($payload) ? $payload : undef ); 
+}
+
+sub fetch_booking_reservation {
+	my( $self, $id ) = @_;
+	my( $res, $evt );
+
+	$res = $self->simplereq(
+		'open-ils.cstore', 
+		'open-ils.cstore.direct.booking.reservation.retrieve', $id
+	);
+
+	# simplereq doesn't know how to flesh so ...
+	if ($res) {
+		$res->usr(
+			$self->simplereq(
+				'open-ils.cstore', 
+				'open-ils.cstore.direct.actor.user.retrieve', $res->usr
+			)
+		);
+
+		$res->target_resource_type(
+			$self->simplereq(
+				'open-ils.cstore', 
+				'open-ils.cstore.direct.booking.resource_type.retrieve', $res->target_resource_type
+			)
+		);
+
+		if ($res->current_resource) {
+			$res->current_resource(
+				$self->simplereq(
+					'open-ils.cstore', 
+					'open-ils.cstore.direct.booking.resource.retrieve', $res->current_resource
+				)
+			);
+
+			if ($self->is_true( $res->target_resource_type->catalog_item )) {
+				$res->current_resource->catalog_item( $self->fetch_copy_by_barcode( $res->current_resource->barcode ) );
+			}
+		}
+
+		if ($res->target_resource) {
+			$res->target_resource(
+				$self->simplereq(
+					'open-ils.cstore', 
+					'open-ils.cstore.direct.booking.resource.retrieve', $res->target_resource
+				)
+			);
+
+			if ($self->is_true( $res->target_resource_type->catalog_item )) {
+				$res->target_resource->catalog_item( $self->fetch_copy_by_barcode( $res->target_resource->barcode ) );
+			}
+		}
+
+	} else {
+		$evt = OpenILS::Event->new('RESERVATION_NOT_FOUND');
+	}
+
+	return ($res, $evt);
+}
+
+sub fetch_circ_duration_by_name {
+	my( $self, $name ) = @_;
+	my( $dur, $evt );
+	$dur = $self->simplereq(
+		'open-ils.cstore', 
+		'open-ils.cstore.direct.config.rules.circ_duration.search.atomic', { name => $name } );
+	$dur = $dur->[0];
+	$evt = OpenILS::Event->new('CONFIG_RULES_CIRC_DURATION_NOT_FOUND') unless $dur;
+	return ($dur, $evt);
+}
+
+sub fetch_recurring_fine_by_name {
+	my( $self, $name ) = @_;
+	my( $obj, $evt );
+	$obj = $self->simplereq(
+		'open-ils.cstore', 
+		'open-ils.cstore.direct.config.rules.recurring_fine.search.atomic', { name => $name } );
+	$obj = $obj->[0];
+	$evt = OpenILS::Event->new('CONFIG_RULES_RECURRING_FINE_NOT_FOUND') unless $obj;
+	return ($obj, $evt);
+}
+
+sub fetch_max_fine_by_name {
+	my( $self, $name ) = @_;
+	my( $obj, $evt );
+	$obj = $self->simplereq(
+		'open-ils.cstore', 
+		'open-ils.cstore.direct.config.rules.max_fine.search.atomic', { name => $name } );
+	$obj = $obj->[0];
+	$evt = OpenILS::Event->new('CONFIG_RULES_MAX_FINE_NOT_FOUND') unless $obj;
+	return ($obj, $evt);
+}
+
+sub fetch_hard_due_date_by_name {
+	my( $self, $name ) = @_;
+	my( $obj, $evt );
+	$obj = $self->simplereq(
+		'open-ils.cstore', 
+		'open-ils.cstore.direct.config.hard_due_date.search.atomic', { name => $name } );
+	$obj = $obj->[0];
+	$evt = OpenILS::Event->new('CONFIG_RULES_HARD_DUE_DATE_NOT_FOUND') unless $obj;
+	return ($obj, $evt);
+}
+
+sub storagereq {
+	my( $self, $method, @params ) = @_;
+	return $self->simplereq(
+		'open-ils.storage', $method, @params );
+}
+
+sub storagereq_xact {
+	my($self, $method, @params) = @_;
+	my $ses = $self->start_db_session();
+	my $val = $ses->request($method, @params)->gather(1);
+	$self->rollback_db_session($ses);
+    return $val;
+}
+
+sub cstorereq {
+	my( $self, $method, @params ) = @_;
+	return $self->simplereq(
+		'open-ils.cstore', $method, @params );
+}
+
+sub event_equals {
+	my( $self, $e, $name ) =  @_;
+	if( $e and ref($e) eq 'HASH' and 
+		defined($e->{textcode}) and $e->{textcode} eq $name ) {
+		return 1 ;
+	}
+	return 0;
+}
+
+sub logmark {
+	my( undef, $f, $l ) = caller(0);
+	my( undef, undef, undef, $s ) = caller(1);
+	$s =~ s/.*:://g;
+	$f =~ s/.*\///g;
+	$logger->debug("LOGMARK: $f:$l:$s");
+}
+
+# takes a copy id 
+sub fetch_open_circulation {
+	my( $self, $cid ) = @_;
+	$self->logmark;
+
+	my $e = OpenILS::Utils::CStoreEditor->new;
+    my $circ = $e->search_action_circulation({
+        target_copy => $cid, 
+        stop_fines_time => undef, 
+        checkin_time => undef
+    })->[0];
+    
+    return ($circ, $e->event);
+}
+
+my $copy_statuses;
+sub copy_status_from_name {
+	my( $self, $name ) = @_;
+	$copy_statuses = $self->fetch_copy_statuses unless $copy_statuses;
+	for my $status (@$copy_statuses) { 
+		return $status if( $status->name =~ /$name/i );
+	}
+	return undef;
+}
+
+sub copy_status_to_name {
+	my( $self, $sid ) = @_;
+	$copy_statuses = $self->fetch_copy_statuses unless $copy_statuses;
+	for my $status (@$copy_statuses) { 
+		return $status->name if( $status->id == $sid );
+	}
+	return undef;
+}
+
+
+sub copy_status {
+	my( $self, $arg ) = @_;
+	return $arg if ref $arg;
+	$copy_statuses = $self->fetch_copy_statuses unless $copy_statuses;
+	my ($stat) = grep { $_->id == $arg } @$copy_statuses;
+	return $stat;
+}
+
+sub fetch_open_transit_by_copy {
+	my( $self, $copyid ) = @_;
+	my($transit, $evt);
+	$transit = $self->cstorereq(
+		'open-ils.cstore.direct.action.transit_copy.search',
+		{ target_copy => $copyid, dest_recv_time => undef });
+	$evt = OpenILS::Event->new('ACTION_TRANSIT_COPY_NOT_FOUND') unless $transit;
+	return ($transit, $evt);
+}
+
+sub unflesh_copy {
+	my( $self, $copy ) = @_;
+	return undef unless $copy;
+	$copy->status( $copy->status->id ) if ref($copy->status);
+	$copy->location( $copy->location->id ) if ref($copy->location);
+	$copy->circ_lib( $copy->circ_lib->id ) if ref($copy->circ_lib);
+	return $copy;
+}
+
+sub unflesh_reservation {
+	my( $self, $reservation ) = @_;
+	return undef unless $reservation;
+	$reservation->usr( $reservation->usr->id ) if ref($reservation->usr);
+	$reservation->target_resource_type( $reservation->target_resource_type->id ) if ref($reservation->target_resource_type);
+	$reservation->target_resource( $reservation->target_resource->id ) if ref($reservation->target_resource);
+	$reservation->current_resource( $reservation->current_resource->id ) if ref($reservation->current_resource);
+	return $reservation;
+}
+
+# un-fleshes a copy and updates it in the DB
+# returns a DB_UPDATE_FAILED event on error
+# returns undef on success
+sub update_copy {
+	my( $self, %params ) = @_;
+
+	my $copy		= $params{copy}	|| die "update_copy(): copy required";
+	my $editor	= $params{editor} || die "update_copy(): copy editor required";
+	my $session = $params{session};
+
+	$logger->debug("Updating copy in the database: " . $copy->id);
+
+	$self->unflesh_copy($copy);
+	$copy->editor( $editor );
+	$copy->edit_date( 'now' );
+
+	my $s;
+	my $meth = 'open-ils.storage.direct.asset.copy.update';
+
+	$s = $session->request( $meth, $copy )->gather(1) if $session;
+	$s = $self->storagereq( $meth, $copy ) unless $session;
+
+	$logger->debug("Update of copy ".$copy->id." returned: $s");
+
+	return $self->DB_UPDATE_FAILED($copy) unless $s;
+	return undef;
+}
+
+sub update_reservation {
+	my( $self, %params ) = @_;
+
+	my $reservation	= $params{reservation}	|| die "update_reservation(): reservation required";
+	my $editor		= $params{editor} || die "update_reservation(): copy editor required";
+	my $session		= $params{session};
+
+	$logger->debug("Updating copy in the database: " . $reservation->id);
+
+	$self->unflesh_reservation($reservation);
+
+	my $s;
+	my $meth = 'open-ils.cstore.direct.booking.reservation.update';
+
+	$s = $session->request( $meth, $reservation )->gather(1) if $session;
+	$s = $self->cstorereq( $meth, $reservation ) unless $session;
+
+	$logger->debug("Update of copy ".$reservation->id." returned: $s");
+
+	return $self->DB_UPDATE_FAILED($reservation) unless $s;
+	return undef;
+}
+
+sub fetch_billable_xact {
+	my( $self, $id ) = @_;
+	my($xact, $evt);
+	$logger->debug("Fetching billable transaction %id");
+	$xact = $self->cstorereq(
+		'open-ils.cstore.direct.money.billable_transaction.retrieve', $id );
+	$evt = OpenILS::Event->new('MONEY_BILLABLE_TRANSACTION_NOT_FOUND') unless $xact;
+	return ($xact, $evt);
+}
+
+sub fetch_billable_xact_summary {
+	my( $self, $id ) = @_;
+	my($xact, $evt);
+	$logger->debug("Fetching billable transaction summary %id");
+	$xact = $self->cstorereq(
+		'open-ils.cstore.direct.money.billable_transaction_summary.retrieve', $id );
+	$evt = OpenILS::Event->new('MONEY_BILLABLE_TRANSACTION_NOT_FOUND') unless $xact;
+	return ($xact, $evt);
+}
+
+sub fetch_fleshed_copy {
+	my( $self, $id ) = @_;
+	my( $copy, $evt );
+	$logger->info("Fetching fleshed copy $id");
+	$copy = $self->cstorereq(
+		"open-ils.cstore.direct.asset.copy.retrieve", $id,
+		{ flesh => 1,
+		  flesh_fields => { acp => [ qw/ circ_lib location status stat_cat_entries / ] }
+		}
+	);
+	$evt = OpenILS::Event->new('ASSET_COPY_NOT_FOUND', id => $id) unless $copy;
+	return ($copy, $evt);
+}
+
+
+# returns the org that owns the callnumber that the copy
+# is attached to
+sub fetch_copy_owner {
+	my( $self, $copyid ) = @_;
+	my( $copy, $cn, $evt );
+	$logger->debug("Fetching copy owner $copyid");
+	($copy, $evt) = $self->fetch_copy($copyid);
+	return (undef,$evt) if $evt;
+	($cn, $evt) = $self->fetch_callnumber($copy->call_number);
+	return (undef,$evt) if $evt;
+	return ($cn->owning_lib);
+}
+
+sub fetch_copy_note {
+	my( $self, $id ) = @_;
+	my( $note, $evt );
+	$logger->debug("Fetching copy note $id");
+	$note = $self->cstorereq(
+		'open-ils.cstore.direct.asset.copy_note.retrieve', $id );
+	$evt = OpenILS::Event->new('ASSET_COPY_NOTE_NOT_FOUND', id => $id ) unless $note;
+	return ($note, $evt);
+}
+
+sub fetch_call_numbers_by_title {
+	my( $self, $titleid ) = @_;
+	$logger->info("Fetching call numbers by title $titleid");
+	return $self->cstorereq(
+		'open-ils.cstore.direct.asset.call_number.search.atomic', 
+		{ record => $titleid, deleted => 'f' });
+		#'open-ils.storage.direct.asset.call_number.search.record.atomic', $titleid);
+}
+
+sub fetch_copies_by_call_number {
+	my( $self, $cnid ) = @_;
+	$logger->info("Fetching copies by call number $cnid");
+	return $self->cstorereq(
+		'open-ils.cstore.direct.asset.copy.search.atomic', { call_number => $cnid, deleted => 'f' } );
+		#'open-ils.storage.direct.asset.copy.search.call_number.atomic', $cnid );
+}
+
+sub fetch_user_by_barcode {
+	my( $self, $bc ) = @_;
+	my $cardid = $self->cstorereq(
+		'open-ils.cstore.direct.actor.card.id_list', { barcode => $bc } );
+	return (undef, OpenILS::Event->new('ACTOR_CARD_NOT_FOUND', barcode => $bc)) unless $cardid;
+	my $user = $self->cstorereq(
+		'open-ils.cstore.direct.actor.user.search', { card => $cardid } );
+	return (undef, OpenILS::Event->new('ACTOR_USER_NOT_FOUND', card => $cardid)) unless $user;
+	return ($user);
+	
+}
+
+sub fetch_bill {
+	my( $self, $billid ) = @_;
+	$logger->debug("Fetching billing $billid");
+	my $bill = $self->cstorereq(
+		'open-ils.cstore.direct.money.billing.retrieve', $billid );
+	my $evt = OpenILS::Event->new('MONEY_BILLING_NOT_FOUND') unless $bill;
+	return($bill, $evt);
+}
+
+my $ORG_TREE;
+sub fetch_org_tree {
+	my $self = shift;
+	return $ORG_TREE if $ORG_TREE;
+	return $ORG_TREE = OpenILS::Utils::CStoreEditor->new->search_actor_org_unit( 
+		[
+			{"parent_ou" => undef },
+			{
+				flesh				=> -1,
+				flesh_fields	=> { aou =>  ['children'] },
+				order_by       => { aou => 'name'}
+			}
+		]
+	)->[0];
+}
+
+sub walk_org_tree {
+	my( $self, $node, $callback ) = @_;
+	return unless $node;
+	$callback->($node);
+	if( $node->children ) {
+		$self->walk_org_tree($_, $callback) for @{$node->children};
+	}
+}
+
+sub is_true {
+	my( $self, $item ) = @_;
+	return 1 if $item and $item !~ /^f$/i;
+	return 0;
+}
+
+
+sub patientreq {
+    my ($self, $client, $service, $method, @params) = @_;
+    my ($response, $err);
+
+    my $session = create OpenSRF::AppSession($service);
+    my $request = $session->request($method, @params);
+
+    my $spurt = 10;
+    my $give_up = time + 1000;
+
+    try {
+        while (time < $give_up) {
+            $response = $request->recv("timeout" => $spurt);
+            last if $request->complete;
+
+            $client->status(new OpenSRF::DomainObject::oilsContinueStatus);
+        }
+    } catch Error with {
+        $err = shift;
+    };
+
+    if ($err) {
+        warn "received error : service=$service : method=$method : params=".Dumper(\@params) . "\n $err";
+        throw $err ("Call to $service for method $method \n failed with exception: $err : " );
+    }
+
+    return $response->content;
+}
+
+# This logic now lives in storage
+sub __patron_money_owed {
+	my( $self, $patronid ) = @_;
+	my $ses = OpenSRF::AppSession->create('open-ils.storage');
+	my $req = $ses->request(
+		'open-ils.storage.money.billable_transaction.summary.search',
+		{ usr => $patronid, xact_finish => undef } );
+
+	my $total = 0;
+	my $data;
+	while( $data = $req->recv ) {
+		$data = $data->content;
+		$total += $data->balance_owed;
+	}
+	return $total;
+}
+
+sub patron_money_owed {
+	my( $self, $userid ) = @_;
+	my $ses = $self->start_db_session();
+	my $val = $ses->request(
+		'open-ils.storage.actor.user.total_owed', $userid)->gather(1);
+	$self->rollback_db_session($ses);
+	return $val;
+}
+
+sub patron_total_items_out {
+	my( $self, $userid ) = @_;
+	my $ses = $self->start_db_session();
+	my $val = $ses->request(
+		'open-ils.storage.actor.user.total_out', $userid)->gather(1);
+	$self->rollback_db_session($ses);
+	return $val;
+}
+
+
+
+
+#---------------------------------------------------------------------
+# Returns  ($summary, $event) 
+#---------------------------------------------------------------------
+sub fetch_mbts {
+	my $self = shift;
+	my $id	= shift;
+	my $e = shift || OpenILS::Utils::CStoreEditor->new;
+	$id = $id->id if ref($id);
+    
+    my $xact = $e->retrieve_money_billable_transaction_summary($id)
+	    or return (undef, $e->event);
+
+    return ($xact);
+}
+
+
+#---------------------------------------------------------------------
+# Given a list of money.billable_transaction objects, this creates
+# transaction summary objects for each
+#--------------------------------------------------------------------
+sub make_mbts {
+	my $self = shift;
+    my $e = shift;
+	my @xacts = @_;
+	return () if (!@xacts);
+    return @{$e->search_money_billable_transaction_summary({id => [ map { $_->id } @xacts ]})};
+}
+		
+		
+sub ou_ancestor_setting_value {
+    my($self, $org_id, $name, $e) = @_;
+    $e = $e || OpenILS::Utils::CStoreEditor->new;
+    my $set = $self->ou_ancestor_setting($org_id, $name, $e);
+    return $set->{value} if $set;
+    return undef;
+}
+
+
+# If an authentication token is provided AND this org unit setting has a
+# view_perm, then make sure the user referenced by the auth token has
+# that permission.  This means that if you call this method without an
+# authtoken param, you can get whatever org unit setting values you want.
+# API users beware.
+#
+# NOTE: If you supply an editor ($e) arg AND an auth token arg, the editor's
+# authtoken is checked, but the $auth arg is NOT checked.  To say that another
+# way, be sure NOT to pass an editor argument if you want your token checked.
+# Otherwise the auth arg is just a flag saying "check the editor".  
+
+sub ou_ancestor_setting {
+    my( $self, $orgid, $name, $e, $auth ) = @_;
+    $e = $e || OpenILS::Utils::CStoreEditor->new(
+        (defined $auth) ? (authtoken => $auth) : ()
+    );
+    my $coust = $e->retrieve_config_org_unit_setting_type([
+        $name, {flesh => 1, flesh_fields => {coust => ['view_perm']}}
+    ]);
+
+    if ($auth && $coust && $coust->view_perm) {
+        # And you can't have permission if you don't have a valid session.
+        return undef if not $e->checkauth;
+        # And now that we know you MIGHT have permission, we check it.
+        return undef if not $e->allowed($coust->view_perm->code, $orgid);
+    }
+
+    my $query = {from => ['actor.org_unit_ancestor_setting', $name, $orgid]};
+    my $setting = $e->json_query($query)->[0];
+    return undef unless $setting;
+    return {org => $setting->{org_unit}, value => OpenSRF::Utils::JSON->JSON2perl($setting->{value})};
+}	
+		
+
+# returns the ISO8601 string representation of the requested epoch in GMT
+sub epoch2ISO8601 {
+    my( $self, $epoch ) = @_;
+    my ($sec,$min,$hour,$mday,$mon,$year) = gmtime($epoch);
+    $year += 1900; $mon += 1;
+    my $date = sprintf(
+        '%s-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d-00',
+        $year, $mon, $mday, $hour, $min, $sec);
+    return $date;
+}
+			
+sub find_highest_perm_org {
+	my ( $self, $perm, $userid, $start_org, $org_tree ) = @_;
+	my $org = $self->find_org($org_tree, $start_org );
+
+	my $lastid = -1;
+	while( $org ) {
+		last if ($self->check_perms( $userid, $org->id, $perm )); # perm failed
+		$lastid = $org->id;
+		$org = $self->find_org( $org_tree, $org->parent_ou() );
+	}
+
+	return $lastid;
+}
+
+
+# returns the org_unit ID's 
+sub user_has_work_perm_at {
+    my($self, $e, $perm, $options, $user_id) = @_;
+    $options ||= {};
+    $user_id = (defined $user_id) ? $user_id : $e->requestor->id;
+
+    my $func = 'permission.usr_has_perm_at';
+    $func = $func.'_all' if $$options{descendants};
+
+    my $orgs = $e->json_query({from => [$func, $user_id, $perm]});
+    $orgs = [map { $_->{ (keys %$_)[0] } } @$orgs];
+
+    return $orgs unless $$options{objects};
+
+    return $e->search_actor_org_unit({id => $orgs});
+}
+
+sub get_user_work_ou_ids {
+    my($self, $e, $userid) = @_;
+    my $work_orgs = $e->json_query({
+        select => {puwoum => ['work_ou']},
+        from => 'puwoum',
+        where => {usr => $e->requestor->id}});
+
+    return [] unless @$work_orgs;
+    my @work_orgs;
+    push(@work_orgs, $_->{work_ou}) for @$work_orgs;
+
+    return \@work_orgs;
+}
+
+
+my $org_types;
+sub get_org_types {
+	my($self, $client) = @_;
+	return $org_types if $org_types;
+	return $org_types = OpenILS::Utils::CStoreEditor->new->retrieve_all_actor_org_unit_type();
+}
+
+sub get_org_tree {
+	my $self = shift;
+	my $locale = shift || '';
+	my $cache = OpenSRF::Utils::Cache->new("global", 0);
+	my $tree = $cache->get_cache("orgtree.$locale");
+	return $tree if $tree;
+
+	my $ses = OpenILS::Utils::CStoreEditor->new;
+	$ses->session->session_locale($locale);
+	$tree = $ses->search_actor_org_unit( 
+		[
+			{"parent_ou" => undef },
+			{
+				flesh				=> -1,
+				flesh_fields	=> { aou =>  ['children'] },
+				order_by			=> { aou => 'name'}
+			}
+		]
+	)->[0];
+
+	$cache->put_cache("orgtree.$locale", $tree);
+	return $tree;
+}
+
+sub get_org_descendants {
+	my($self, $org_id, $depth) = @_;
+
+	my $select = {
+		transform => 'actor.org_unit_descendants',
+		column => 'id',
+		result_field => 'id',
+	};
+	$select->{params} = [$depth] if defined $depth;
+
+	my $org_list = OpenILS::Utils::CStoreEditor->new->json_query({
+		select => {aou => [$select]},
+        from => 'aou',
+		where => {id => $org_id}
+	});
+	my @orgs;
+	push(@orgs, $_->{id}) for @$org_list;
+	return \@orgs;
+}
+
+sub get_org_ancestors {
+	my($self, $org_id) = @_;
+
+	my $org_list = OpenILS::Utils::CStoreEditor->new->json_query({
+		select => {
+			aou => [{
+				transform => 'actor.org_unit_ancestors',
+				column => 'id',
+				result_field => 'id',
+				params => []
+			}],
+		},
+		from => 'aou',
+		where => {id => $org_id}
+	});
+
+	my @orgs;
+	push(@orgs, $_->{id}) for @$org_list;
+	return \@orgs;
+}
+
+sub get_org_full_path {
+	my($self, $org_id, $depth) = @_;
+
+    my $query = {
+        select => {
+			aou => [{
+				transform => 'actor.org_unit_full_path',
+				column => 'id',
+				result_field => 'id',
+			}],
+		},
+		from => 'aou',
+		where => {id => $org_id}
+	};
+
+    $query->{select}->{aou}->[0]->{params} = [$depth] if defined $depth;
+	my $org_list = OpenILS::Utils::CStoreEditor->new->json_query($query);
+    return [ map {$_->{id}} @$org_list ];
+}
+
+# returns the ID of the org unit ancestor at the specified depth
+sub org_unit_ancestor_at_depth {
+    my($class, $org_id, $depth) = @_;
+    my $resp = OpenILS::Utils::CStoreEditor->new->json_query(
+        {from => ['actor.org_unit_ancestor_at_depth', $org_id, $depth]})->[0];
+    return ($resp) ? $resp->{id} : undef;
+}
+
+# returns the user's configured locale as a string.  Defaults to en-US if none is configured.
+sub get_user_locale {
+	my($self, $user_id, $e) = @_;
+	$e ||= OpenILS::Utils::CStoreEditor->new;
+
+	# first, see if the user has an explicit locale set
+	my $setting = $e->search_actor_user_setting(
+		{usr => $user_id, name => 'global.locale'})->[0];
+	return OpenSRF::Utils::JSON->JSON2perl($setting->value) if $setting;
+
+	my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+	return $self->get_org_locale($user->home_ou, $e);
+}
+
+# returns org locale setting
+sub get_org_locale {
+	my($self, $org_id, $e) = @_;
+	$e ||= OpenILS::Utils::CStoreEditor->new;
+
+	my $locale;
+	if(defined $org_id) {
+		$locale = $self->ou_ancestor_setting_value($org_id, 'global.default_locale', $e);
+		return $locale if $locale;
+	}
+
+	# system-wide default
+	my $sclient = OpenSRF::Utils::SettingsClient->new;
+	$locale = $sclient->config_value('default_locale');
+    return $locale if $locale;
+
+	# if nothing else, fallback to locale=cowboy
+	return 'en-US';
+}
+
+
+# xml-escape non-ascii characters
+sub entityize { 
+    my($self, $string, $form) = @_;
+	$form ||= "";
+
+	# If we're going to convert non-ASCII characters to XML entities,
+	# we had better be dealing with a UTF8 string to begin with
+	$string = decode_utf8($string);
+
+	if ($form eq 'D') {
+		$string = NFD($string);
+	} else {
+		$string = NFC($string);
+	}
+
+	# Convert raw ampersands to entities
+	$string =~ s/&(?!\S+;)/&/gso;
+
+	# Convert Unicode characters to entities
+	$string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
+
+	return $string;
+}
+
+# x0000-x0008 isn't legal in XML documents
+# XXX Perhaps this should just go into our standard entityize method
+sub strip_ctrl_chars {
+	my ($self, $string) = @_;
+
+	$string =~ s/([\x{0000}-\x{0008}])//sgoe; 
+	return $string;
+}
+
+sub get_copy_price {
+	my($self, $e, $copy, $volume) = @_;
+
+	$copy->price(0) if $copy->price and $copy->price < 0;
+
+	return $copy->price if $copy->price and $copy->price > 0;
+
+
+	my $owner;
+	if(ref $volume) {
+		if($volume->id == OILS_PRECAT_CALL_NUMBER) {
+			$owner = $copy->circ_lib;
+		} else {
+			$owner = $volume->owning_lib;
+		}
+	} else {
+		if($copy->call_number == OILS_PRECAT_CALL_NUMBER) {
+			$owner = $copy->circ_lib;
+		} else {
+			$owner = $e->retrieve_asset_call_number($copy->call_number)->owning_lib;
+		}
+	}
+
+	my $default_price = $self->ou_ancestor_setting_value(
+		$owner, OILS_SETTING_DEF_ITEM_PRICE, $e) || 0;
+
+	return $default_price unless defined $copy->price;
+
+	# price is 0.  Use the default?
+    my $charge_on_0 = $self->ou_ancestor_setting_value(
+        $owner, OILS_SETTING_CHARGE_LOST_ON_ZERO, $e) || 0;
+
+	return $default_price if $charge_on_0;
+	return 0;
+}
+
+# given a transaction ID, this returns the context org_unit for the transaction
+sub xact_org {
+    my($self, $xact_id, $e) = @_;
+    $e ||= OpenILS::Utils::CStoreEditor->new;
+    
+    my $loc = $e->json_query({
+        "select" => {circ => ["circ_lib"]},
+        from     => "circ",
+        "where"  => {id => $xact_id},
+    });
+
+    return $loc->[0]->{circ_lib} if @$loc;
+
+    $loc = $e->json_query({
+        "select" => {bresv => ["request_lib"]},
+        from     => "bresv",
+        "where"  => {id => $xact_id},
+    });
+
+    return $loc->[0]->{request_lib} if @$loc;
+
+    $loc = $e->json_query({
+        "select" => {mg => ["billing_location"]},
+        from     => "mg",
+        "where"  => {id => $xact_id},
+    });
+
+    return $loc->[0]->{billing_location};
+}
+
+
+sub find_event_def_by_hook {
+    my($self, $hook, $context_org, $e) = @_;
+
+    $e ||= OpenILS::Utils::CStoreEditor->new;
+
+    my $orgs = $self->get_org_ancestors($context_org);
+
+    # search from the context org up
+    for my $org_id (reverse @$orgs) {
+
+        my $def = $e->search_action_trigger_event_definition(
+            {hook => $hook, owner => $org_id})->[0];
+
+        return $def if $def;
+    }
+
+    return undef;
+}
+
+
+
+# If an event_def ID is not provided, use the hook and context org to find the 
+# most appropriate event.  create the event, fire it, then return the resulting
+# event with fleshed template_output and error_output
+sub fire_object_event {
+    my($self, $event_def, $hook, $object, $context_org, $granularity, $user_data, $client) = @_;
+
+    my $e = OpenILS::Utils::CStoreEditor->new;
+    my $def;
+
+    my $auto_method = "open-ils.trigger.event.autocreate.by_definition";
+
+    if($event_def) {
+        $def = $e->retrieve_action_trigger_event_definition($event_def)
+            or return $e->event;
+
+        $auto_method .= '.include_inactive';
+
+    } else {
+
+        # find the most appropriate event def depending on context org
+        $def = $self->find_event_def_by_hook($hook, $context_org, $e) 
+            or return $e->event;
+    }
+
+    my $final_resp;
+
+    if($def->group_field) {
+        # we have a list of objects
+        $object = [$object] unless ref $object eq 'ARRAY';
+
+        my @event_ids;
+        $user_data ||= [];
+        for my $i (0..$#$object) {
+            my $obj = $$object[$i];
+            my $udata = $$user_data[$i];
+            my $event_id = $self->simplereq(
+                'open-ils.trigger', $auto_method, $def->id, $obj, $context_org, $udata);
+            push(@event_ids, $event_id);
+        }
+
+        $logger->info("EVENTS = " . OpenSRF::Utils::JSON->perl2JSON(\@event_ids));
+
+        my $resp;
+        if (not defined $client) {
+            $resp = $self->simplereq(
+                'open-ils.trigger',
+                'open-ils.trigger.event_group.fire',
+                \@event_ids);
+        } else {
+            $resp = $self->patientreq(
+                $client,
+                "open-ils.trigger", "open-ils.trigger.event_group.fire",
+                \@event_ids
+            );
+        }
+
+        if($resp and $resp->{events} and @{$resp->{events}}) {
+
+            $e->xact_begin;
+            $final_resp = $e->retrieve_action_trigger_event([
+                $resp->{events}->[0]->id,
+                {flesh => 1, flesh_fields => {atev => ['template_output', 'error_output']}}
+            ]);
+            $e->rollback;
+        }
+
+    } else {
+
+        $object = $$object[0] if ref $object eq 'ARRAY';
+
+        my $event_id;
+        my $resp;
+
+        if (not defined $client) {
+            $event_id = $self->simplereq(
+                'open-ils.trigger',
+                $auto_method, $def->id, $object, $context_org, $user_data
+            );
+
+            $resp = $self->simplereq(
+                'open-ils.trigger',
+                'open-ils.trigger.event.fire',
+                $event_id
+            );
+        } else {
+            $event_id = $self->patientreq(
+                $client,
+                'open-ils.trigger',
+                $auto_method, $def->id, $object, $context_org, $user_data
+            );
+
+            $resp = $self->patientreq(
+                $client,
+                'open-ils.trigger',
+                'open-ils.trigger.event.fire',
+                $event_id
+            );
+        }
+        
+        if($resp and $resp->{event}) {
+            $e->xact_begin;
+            $final_resp = $e->retrieve_action_trigger_event([
+                $resp->{event}->id,
+                {flesh => 1, flesh_fields => {atev => ['template_output', 'error_output']}}
+            ]);
+            $e->rollback;
+        }
+    }
+
+    return $final_resp;
+}
+
+
+sub create_events_for_hook {
+    my($self, $hook, $obj, $org_id, $granularity, $user_data, $wait) = @_;
+    my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+    my $req = $ses->request('open-ils.trigger.event.autocreate', 
+        $hook, $obj, $org_id, $granularity, $user_data);
+    return undef unless $wait;
+    my $resp = $req->recv;
+    return $resp->content if $resp;
+}
+
+sub create_uuid_string {
+    return create_UUID_as_string();
+}
+
+sub create_circ_chain_summary {
+    my($class, $e, $circ_id) = @_;
+    my $sum = $e->json_query({from => ['action.summarize_circ_chain', $circ_id]})->[0];
+    return undef unless $sum;
+    my $obj = Fieldmapper::action::circ_chain_summary->new;
+    $obj->$_($sum->{$_}) for keys %$sum;
+    return $obj;
+}
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Booking.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Booking.pm
new file mode 100644
index 0000000000..5e75fa840d
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Booking.pm
@@ -0,0 +1,1328 @@
+package OpenILS::Application::Booking;
+
+use strict;
+use warnings;
+
+use POSIX qw/strftime/;
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+
+use OpenSRF::Utils qw/:datetime/;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Application::AppUtils;
+my $U = "OpenILS::Application::AppUtils";
+
+use OpenSRF::Utils::Logger qw/$logger/;
+
+sub prepare_new_brt {
+    my ($record_id, $owning_lib, $mvr) = @_;
+
+    my $brt = new Fieldmapper::booking::resource_type;
+    $brt->isnew(1);
+    $brt->name($mvr->title);
+    $brt->record($record_id);
+    $brt->catalog_item('t');
+    $brt->transferable('t');
+    $brt->owner($owning_lib);
+
+    return $brt;
+}
+
+sub get_existing_brt {
+    my ($e, $record_id, $owning_lib, $mvr) = @_;
+    my $results = $e->search_booking_resource_type(
+        {name => $mvr->title, owner => $owning_lib, record => $record_id}
+    );
+
+    return $results->[0] if scalar(@$results) > 0;
+    return undef;
+}
+
+sub get_mvr {
+    return $U->simplereq(
+        'open-ils.search',
+        'open-ils.search.biblio.record.mods_slim.retrieve.authoritative',
+        shift # record id
+    );
+}
+
+sub get_unique_owning_libs {
+    my %hash = ();
+    $hash{$_->call_number->owning_lib} = 1 foreach (@_);    # @_ are copies
+    return keys %hash;
+}
+
+sub fetch_copies_by_ids {
+    my ($e, $copy_ids) = @_;
+    my $results = $e->search_asset_copy([
+        {id => $copy_ids},
+        {flesh => 1, flesh_fields => {acp => ['call_number']}}
+    ]);
+    return $results if ref($results) eq 'ARRAY';
+    return [];
+}
+
+sub get_single_record_id {
+    my $record_id = undef;
+    foreach (@_) {  # @_ are copies
+        return undef if
+            (defined $record_id && $record_id != $_->call_number->record);
+        $record_id = $_->call_number->record;
+    }
+    return $record_id;
+}
+
+# This function generates the correct json_query clause for determining
+# whether two given ranges overlap.  Each range is composed of a start
+# and an end point.  All four points should be the same type (could be int,
+# date, time, timestamp, or perhaps other types).
+#
+# The first range (or the first two points) should be specified as
+# literal values.  The second range (or the last two points) should be
+# specified as the names of columns, the values of which in a given row
+# will constitute the second range in the comparison.
+#
+# ALSO: PostgreSQL includes an OVERLAPS operator which provides the same
+# functionality in a much more concise way, but json_query does not (yet).
+sub json_query_ranges_overlap {
+    +{ '-or' => [
+        { '-and' => [{$_[2] => {'>=', $_[0]}}, {$_[2] => {'<',  $_[1]}}]},
+        { '-and' => [{$_[3] => {'>',  $_[0]}}, {$_[3] => {'<',  $_[1]}}]},
+        { '-and' => { $_[3] => {'>',  $_[0]},   $_[2] => {'<=', $_[0]}}},
+        { '-and' => { $_[3] => {'>',  $_[1]},   $_[2] => {'<',  $_[1]}}},
+    ]};
+}
+
+sub create_brt_and_brsrc {
+    my ($self, $conn, $authtoken, $copy_ids) = @_;
+    my (@created_brt, @created_brsrc);
+    my %brt_table = ();
+
+    my $e = new_editor(xact => 1, authtoken => $authtoken);
+    return $e->die_event unless $e->checkauth;
+
+    my @copies = @{fetch_copies_by_ids($e, $copy_ids)};
+    my $record_id = get_single_record_id(@copies) or return $e->die_event;
+    my $mvr = get_mvr($record_id) or return $e->die_event;
+
+    foreach (get_unique_owning_libs(@copies)) {
+        $brt_table{$_} = get_existing_brt($e, $record_id, $_, $mvr) ||
+            prepare_new_brt($record_id, $_, $mvr);
+    }
+
+    while (my ($owning_lib, $brt) = each %brt_table) {
+        my $pre_existing = 1;
+        if ($brt->isnew) {
+            if ($e->allowed('ADMIN_BOOKING_RESOURCE_TYPE', $owning_lib)) {
+                $pre_existing = 0;
+                return $e->die_event unless (
+                    #    v-- Important: assignment modifies original hash
+                    $brt = $e->create_booking_resource_type($brt)
+                );
+            }
+        }
+        push @created_brt, [$brt->id, $brt->record, $pre_existing];
+    }
+
+    foreach (@copies) {
+        if ($e->allowed(
+            'ADMIN_BOOKING_RESOURCE', $_->call_number->owning_lib
+        )) {
+            # This block needs to disregard any cstore failures and just
+            # return what results it can.
+            my $brsrc = new Fieldmapper::booking::resource;
+            $brsrc->isnew(1);
+            $brsrc->type($brt_table{$_->call_number->owning_lib}->id);
+            $brsrc->owner($_->call_number->owning_lib);
+            $brsrc->barcode($_->barcode);
+
+            $e->set_savepoint("alpha");
+            my $pre_existing = 0;
+            my $usable_result = undef;
+            if (!($usable_result = $e->create_booking_resource($brsrc))) {
+                $e->rollback_savepoint("alpha");
+                if (($usable_result = $e->search_booking_resource(
+                    +{ map { ($_, $brsrc->$_()) } qw/type owner barcode/ }
+                ))) {
+                    $usable_result = $usable_result->[0];
+                    $pre_existing = 1;
+                } else {
+                    # So we failed to create a booking resource for this copy.
+                    # For now, let's just keep going.  If the calling app wants
+                    # to consider this an error, it can notice the absence
+                    # of a booking resource for the copy in the returned
+                    # results.
+                    $logger->warn(
+                        "Couldn't create or find brsrc for acp #" .  $_->id
+                    );
+                }
+            } else {
+                $e->release_savepoint("alpha");
+            }
+
+            if ($usable_result) {
+                push @created_brsrc,
+                    [$usable_result->id, $_->id, $pre_existing];
+            }
+        }
+    }
+
+    $e->commit and
+        return {brt => \@created_brt, brsrc => \@created_brsrc} or
+        return $e->die_event;
+}
+__PACKAGE__->register_method(
+    method   => "create_brt_and_brsrc",
+    api_name => "open-ils.booking.resources.create_from_copies",
+    signature => {
+        params => [
+            {type => 'string', desc => 'Authentication token'},
+            {type => 'array', desc => 'Copy IDs'},
+        ],
+        return => { desc => "A two-element hash. The 'brt' element " .
+            "is a list of created booking resource types described by " .
+            "3-tuples (id, copy id, was pre-existing).  The 'brsrc' " .
+            "element is a similar list of created booking resources " .
+            "described by (id, record id, was pre-existing) 3-tuples."}
+    }
+);
+
+
+sub create_bresv {
+    my ($self, $client, $authtoken,
+        $target_user_barcode, $datetime_range, $pickup_lib,
+        $brt, $brsrc_list, $attr_values) = @_;
+
+    $brsrc_list = [ undef ] if not defined $brsrc_list;
+    return undef if scalar(@$brsrc_list) < 1; # Empty list not ok.
+
+    my $e = new_editor(xact => 1, authtoken => $authtoken);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed("ADMIN_BOOKING_RESERVATION");
+
+    my $usr = $U->fetch_user_by_barcode($target_user_barcode);
+    return $usr if ref($usr) eq 'HASH' and exists($usr->{"ilsevent"});
+
+    my $results = [];
+    foreach my $brsrc (@$brsrc_list) {
+        my $bresv = new Fieldmapper::booking::reservation;
+        $bresv->usr($usr->id);
+        $bresv->request_lib($e->requestor->ws_ou);
+        $bresv->pickup_lib($pickup_lib);
+        $bresv->start_time($datetime_range->[0]);
+        $bresv->end_time($datetime_range->[1]);
+
+        # A little sanity checking: don't agree to put a reservation on a
+        # brsrc and a brt when they don't match.  In fact, bomb out of
+        # this transaction entirely.
+        if ($brsrc) {
+            my $brsrc_itself = $e->retrieve_booking_resource([
+                $brsrc, {
+                    "flesh" => 1,
+                    "flesh_fields" => {"brsrc" => ["type"]}
+                }
+            ]);
+
+            if (not $brsrc_itself) {
+                my $ev = new OpenILS::Event(
+                    "RESERVATION_BAD_PARAMS",
+                    desc => "brsrc $brsrc doesn't exist"
+                );
+                $e->disconnect;
+                return $ev;
+            }
+            elsif ($brsrc_itself->type->id != $brt) {
+                my $ev = new OpenILS::Event(
+                    "RESERVATION_BAD_PARAMS",
+                    desc => "brsrc $brsrc doesn't match given brt $brt"
+                );
+                $e->disconnect;
+                return $ev;
+            }
+
+            # Also bail if the user is trying to create a reservation at
+            # a pickup lib to which our resource won't go.
+            if (
+                $brsrc_itself->owner != $pickup_lib and
+                    not $brsrc_itself->type->transferable
+            ) {
+                my $ev = new OpenILS::Event(
+                    "RESERVATION_BAD_PARAMS",
+                    desc => "brsrc $brsrc doesn't belong to $pickup_lib and " .
+                        "is not transferable"
+                );
+                $e->disconnect;
+                return $ev;
+            }
+        }
+        $bresv->target_resource($brsrc);    # undef is ok here
+        $bresv->target_resource_type($brt);
+
+        ($bresv = $e->create_booking_reservation($bresv)) or
+            return $e->die_event;
+
+        # We could/should do some sanity checking on this too: namely, on
+        # whether the attribute values given actually apply to the relevant
+        # brt.  Not seeing any grievous side effects of not checking, though.
+        my @bravm = ();
+        foreach my $value (@$attr_values) {
+            my $bravm = new Fieldmapper::booking::reservation_attr_value_map;
+            $bravm->reservation($bresv->id);
+            $bravm->attr_value($value);
+            $bravm = $e->create_booking_reservation_attr_value_map($bravm) or
+                return $e->die_event;
+            push @bravm, $bravm;
+        }
+        push @$results, {
+            "bresv" => $bresv->id,
+            "bravm" => \@bravm,
+        };
+    }
+
+    $e->commit or return $e->die_event;
+
+    # Targeting must be tacked on _after_ committing the transaction where the
+    # reservations are actually created.
+    foreach (@$results) {
+        $_->{"targeting"} = $U->storagereq(
+            "open-ils.storage.booking.reservation.resource_targeter",
+            $_->{"bresv"}
+        )->[0];
+    }
+    return $results;
+}
+__PACKAGE__->register_method(
+    method   => "create_bresv",
+    api_name => "open-ils.booking.reservations.create",
+    signature => {
+        params => [
+            {type => 'string', desc => 'Authentication token'},
+            {type => 'string', desc => 'Barcode of user for whom to reserve'},
+            {type => 'array', desc => 'Two elements: start and end timestamp'},
+            {type => 'int', desc => 'Desired reservation pickup lib'},
+            {type => 'int', desc => 'Booking resource type'},
+            {type => 'list', desc => 'Booking resource (undef ok; empty not ok)'},
+            {type => 'array', desc => 'Attribute values selected'},
+        ],
+        return => { desc => "A hash containing the new bresv and a list " .
+            "of new bravm"}
+    }
+);
+
+
+sub resource_list_by_attrs {
+    my $self = shift;
+    my $client = shift;
+    my $auth = shift; # Keep as argument, though not used just now.
+    my $filters = shift;
+
+    return undef unless ($filters->{type} || $filters->{attribute_values});
+
+    my $query = {
+        "select"   => {brsrc => [qw/id owner/], brt => ["elbow_room"]},
+        "from"     => {brsrc => {"brt" => {}}},
+        "where"    => {},
+        "distinct" => 1
+    };
+
+    $query->{where} = {"-and" => []};
+    if ($filters->{type}) {
+        push @{$query->{where}->{"-and"}}, {"type" => $filters->{type}};
+    }
+
+    if ($filters->{pickup_lib}) {
+        push @{$query->{where}->{"-and"}},
+            {"-or" => [
+                {"owner" => $filters->{pickup_lib}},
+                {"+brt" => {"transferable" => "t"}}
+            ]};
+    }
+
+    if ($filters->{attribute_values}) {
+
+        $query->{from}->{brsrc}->{bram} = { field => 'resource' };
+
+        $filters->{attribute_values} = [$filters->{attribute_values}]
+            if (!ref($filters->{attribute_values}));
+
+        $query->{having}->{'+bram'}->{value}->{'@>'} = {
+            transform => 'array_accum',
+            value => '$_' . $$ . '${' .
+                join(',', @{$filters->{attribute_values}}) .
+                '}$_' . $$ . '$'
+        };
+    }
+
+    if ($filters->{available}) {
+        # If only one timestamp has been provided, make it into a range.
+        if (!ref($filters->{available})) {
+            $filters->{available} = [($filters->{available}) x 2];
+        }
+
+        push @{$query->{where}->{"-and"}}, {
+            "-or" => [
+                {"overbook" => "t"},
+                {"-not-exists" => {
+                    "select" => {"bresv" => ["id"]},
+                    "from" => "bresv",
+                    "where" => {"-and" => [
+                        json_query_ranges_overlap(
+                            $filters->{available}->[0],
+                            $filters->{available}->[1],
+                            "start_time",
+                            "end_time"
+                        ),
+                        {"cancel_time" => undef},
+                        {"return_time" => undef},
+                        {"current_resource" => {"=" => {"+brsrc" => "id"}}}
+                    ]},
+                }}
+            ]
+        };
+    }
+    if ($filters->{booked}) {
+        # If only one timestamp has been provided, make it into a range.
+        if (!ref($filters->{booked})) {
+            $filters->{booked} = [($filters->{booked}) x 2];
+        }
+
+        push @{$query->{where}->{"-and"}}, {
+            "-exists" => {
+                "select" => {"bresv" => ["id"]},
+                "from" => "bresv",
+                "where" => {"-and" => [
+                    json_query_ranges_overlap(
+                        $filters->{booked}->[0],
+                        $filters->{booked}->[1],
+                        "start_time",
+                        "end_time"
+                    ),
+                    {"cancel_time" => undef},
+                    {"current_resource" => { "=" => {"+brsrc" => "id"}}}
+                ]},
+            }
+        };
+        # I think that the "booked" case could be done with a JOIN instead of
+        # an EXISTS, but I'm leaving it this way for symmetry with the
+        # "available" case for now.  The available case cannot be done with a
+        # join.
+    }
+
+    my $cstore = OpenSRF::AppSession->connect('open-ils.cstore');
+    my $rows = $cstore->request(
+        "open-ils.cstore.json_query.atomic", $query
+    )->gather(1);
+    $cstore->disconnect;
+
+    return [] if not @$rows;
+
+    if ($filters->{"pickup_lib"} && $filters->{"available"}) {
+        my @new_rows = ();
+        my $general_elbow_room = $U->ou_ancestor_setting_value(
+            $filters->{"pickup_lib"},
+            "circ.booking_reservation.default_elbow_room"
+        ) || '0 seconds';
+        my $would_start = $filters->{"available"}->[0];
+        my $dt_parser = new DateTime::Format::ISO8601;
+
+        $logger->info(
+            "general_elbow_room: '$general_elbow_room', " .
+            "would_start: '$would_start'"
+        );
+
+        # Here, elbow_room will double as required transit time padding.
+        foreach (@$rows) {
+            my $elbow_room = $_->{"elbow_room"} || $general_elbow_room;
+            if ($_->{"owner"} != $filters->{"pickup_lib"}) {
+                (my $ws = $would_start) =~ s/ /T/;
+                push @new_rows, $_ if DateTime->compare(
+                    $dt_parser->parse_datetime($ws),
+                    DateTime->now(
+                        "time_zone" => DateTime::TimeZone->new(
+                            "name" => "local"
+                        )
+                    )->add(seconds => interval_to_seconds($elbow_room))
+                ) >= 0;
+            } else {
+                push @new_rows, $_;
+            }
+        }
+        return [map { $_->{id} } @new_rows];
+    } else {
+        return [map { $_->{id} } @$rows];
+    }
+}
+__PACKAGE__->register_method(
+    method   => "resource_list_by_attrs",
+    api_name => "open-ils.booking.resources.filtered_id_list",
+    argc     => 2,
+    signature=> {
+        params => [
+            {type => 'string', desc => 'Authentication token (unused for now,' .
+               ' but at least pass undef here)'},
+            {type => 'object', desc => 'Filter object: see notes for details'},
+        ],
+        return => { desc => "An array of brsrc ids matching the requested filters." },
+    },
+    notes    => <<'NOTES'
+
+The filter object parameter can contain the following keys:
+ * type             => The id of a booking resource type (brt)
+ * attribute_values => The ids of booking resource type attribute values that the resource must have assigned to it (brav)
+ * available        => Either:
+                        A timestamp during which the resources are not reserved.  If the resource is overbookable, this is ignored.
+                        A range of two timestamps which do not overlap any reservations for the resources.  If the resource is overbookable, this is ignored.
+ * booked           => Either:
+                        A timestamp during which the resources are reserved.
+                        A range of two timestamps which overlap a reservation of the resources.
+
+Note that at least one of 'type' or 'attribute_values' is required.
+
+NOTES
+);
+
+
+sub reservation_list_by_filters {
+    my $self = shift;
+    my $client = shift;
+    my $auth = shift;
+    my $filters = shift;
+    my $whole_obj = shift;
+
+    return undef unless ($filters->{user} || $filters->{user_barcode} || $filters->{resource} || $filters->{type} || $filters->{attribute_values});
+
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('VIEW_TRANSACTION');
+
+    my $query = {
+        'select'   => { bresv => [ 'id', 'start_time' ] },
+        'from'     => { bresv => {} },
+        'where'    => {},
+        'order_by' => [{ class => bresv => field => start_time => direction => 'asc' }],
+        'distinct' => 1
+    };
+
+    if ($filters->{fields}) {
+        $query->{where} = $filters->{fields};
+    }
+
+
+    if ($filters->{user}) {
+        $query->{where}->{usr} = $filters->{user};
+    }
+    elsif ($filters->{user_barcode}) {  # just one of user and user_barcode
+        my $usr = $U->fetch_user_by_barcode($filters->{user_barcode});
+        return $usr if ref($usr) eq 'HASH' and exists($usr->{"ilsevent"});
+        $query->{where}->{usr} = $usr->id;
+    }
+
+
+    if ($filters->{type}) {
+        $query->{where}->{target_resource_type} = $filters->{type};
+    }
+
+    $query->{where}->{"-and"} = [];
+    if ($filters->{resource}) {
+#       $query->{where}->{target_resource} = $filters->{resource};
+        push @{$query->{where}->{"-and"}}, {
+            "-or" => {
+                "target_resource" => $filters->{resource},
+                "current_resource" => $filters->{resource}
+            }
+        };
+    }
+
+    if ($filters->{attribute_values}) {
+
+        $query->{from}->{bresv}->{bravm} = { field => 'reservation' };
+
+        $filters->{attribute_values} = [$filters->{attribute_values}]
+            if (!ref($filters->{attribute_values}));
+
+        $query->{having}->{'+bravm'}->{attr_value}->{'@>'} = {
+            transform => 'array_accum',
+            value => '$_' . $$ . '${' .
+                join(',', @{$filters->{attribute_values}}) .
+                '}$_' . $$ . '$'
+        };
+    }
+
+    if ($filters->{search_start} || $filters->{search_end}) {
+        my $or = {};
+
+        $or->{start_time} =
+            {'between' => [ $filters->{search_start}, $filters->{search_end}]}
+                if $filters->{search_start};
+
+        $or->{end_time} =
+            {'between' =>[$filters->{search_start}, $filters->{search_end}]}
+                if $filters->{search_end};
+
+        push @{$query->{where}->{"-and"}}, {"-or" => $or};
+    }
+
+    if (not scalar @{$query->{"where"}->{"-and"}}) {
+        delete $query->{"where"}->{"-and"};
+    }
+
+    my $cstore = OpenSRF::AppSession->connect('open-ils.cstore');
+    my $ids = [ map { $_->{id} } @{
+        $cstore->request(
+            'open-ils.cstore.json_query.atomic', $query
+        )->gather(1)
+    } ];
+    $cstore->disconnect;
+
+    if (not $whole_obj or @$ids < 1) {
+        $e->disconnect;
+        return $ids;
+    }
+
+    my $bresv_list = $e->search_booking_reservation([
+        {"id" => $ids},
+        {"flesh" => 1,
+            "flesh_fields" => {
+                "bresv" =>
+                    [qw/target_resource current_resource target_resource_type/]
+            }
+        }]
+    );
+    $e->disconnect;
+    return $bresv_list ? $bresv_list : [];
+}
+__PACKAGE__->register_method(
+    method   => "reservation_list_by_filters",
+    api_name => "open-ils.booking.reservations.filtered_id_list",
+    argc     => 3,
+    signature=> {
+        params => [
+            {type => 'string', desc => 'Authentication token'},
+            {type => "object", desc => "Filter object: see notes for details"},
+            {type => "bool", desc => "Return whole object instead of ID? (default false)"}
+        ],
+        return => { desc => "An array of bresv ids matching the requested filters." },
+    },
+    notes    => <<'NOTES'
+
+The filter object parameter can contain the following keys:
+ * user             => The id of a user that has requested a bookable item -- filters on bresv.usr
+ * barcode          => The barcode of a user that has requested a bookable item
+ * type             => The id of a booking resource type (brt) -- filters on bresv.target_resource_type
+ * resource         => The id of a booking resource (brsrc) -- filters on bresv.target_resource
+ * attribute_values => The ids of booking resource type attribute values that the resource must have assigned to it (brav)
+ * search_start     => If search_end is not specified, booking interval (start_time to end_time) must contain this timestamp.
+ * search_end       => If search_start is not specified, booking interval (start_time to end_time) must contain this timestamp.
+ * fields           => An object containing any combination of bresv search filters in standard cstore/pcrud search format.
+
+Note that at least one of 'user', 'type', 'resource' or 'attribute_values' is required.  If both search_start and search_end are specified,
+then the result includes any reservations that overlap with that time range.  Any filter fields supplied in 'fields' are overridden
+by the top-level filters ('user', 'type', 'resource').
+
+NOTES
+);
+
+
+sub naive_ts_string {strftime("%F %T", localtime($_[0] || time));}
+sub naive_start_of_day {strftime("%F", localtime($_[0] || time))." 00:00:00";}
+
+# Return a map of bresv or an ilsevent on failure.
+sub get_uncaptured_bresv_for_brsrc {
+    my ($e, $o) = @_; # o's keys (all optional): owning_lib, barcode, range
+
+    my $from_clause = {
+        "bresv" => {
+            "brsrc" => {"field" => "id", "fkey" => "current_resource"}
+        }
+    };
+
+    my $query = {
+        "select" => {
+            "bresv" => [
+                "current_resource",
+                {
+                    "column" => "start_time",
+                    "transform" => "min",
+                    "aggregate" => 1
+                }
+            ]
+        },
+        "from" => $from_clause,
+        "where" => {
+            "-and" => [
+                {"current_resource" => {"!=" => undef}},
+                {"capture_time" => undef},
+                {"cancel_time" => undef},
+                {"return_time" => undef},
+                {"pickup_time" => undef}
+            ]
+        }
+    };
+    if ($o->{"owning_lib"}) {
+        push @{$query->{"where"}->{"-and"}},
+            {"+brsrc" => {"owner" => $o->{"owning_lib"}}};
+    }
+    if ($o->{"range"}) {
+        push @{$query->{"where"}->{"-and"}},
+            json_query_ranges_overlap(
+                $o->{"range"}->[0], $o->{"range"}->[1],
+                "start_time", "end_time"
+            );
+    }
+    if ($o->{"barcode"}) {
+        push @{$query->{"where"}->{"-and"}},
+            {"+brsrc" => {"barcode" => $o->{"barcode"}}};
+    }
+
+    my $rows = $e->json_query($query);
+    my $current_resource_bresv_map = {};
+    if (@$rows) {
+        my $id_query = {
+            "select" => {"bresv" => ["id"]},
+            "from" => $from_clause,
+            "where" => {
+                "-and" => [
+                    {"current_resource" => "PLACEHOLDER"},
+                    {"start_time" => "PLACEHOLDER"},
+                    {"capture_time" => undef},
+                    {"cancel_time" => undef},
+                    {"return_time" => undef},
+                    {"pickup_time" => undef}
+                ]
+            }
+        };
+        if ($o->{"owning_lib"}) {
+            push @{$id_query->{"where"}->{"-and"}},
+                {"+brsrc" => {"owner" => $o->{"owning_lib"}}};
+        }
+
+        foreach (@$rows) {
+            $id_query->{"where"}->{"-and"}->[0]->{"current_resource"} =
+                $_->{"current_resource"};
+            $id_query->{"where"}->{"-and"}->[1]->{"start_time"} =
+                $_->{"start_time"};
+
+            my $results = $e->json_query($id_query);
+            if ($results && @$results) {
+                $current_resource_bresv_map->{$_->{"current_resource"}} =
+                    [map { $_->{"id"} } @$results];
+            }
+        }
+    }
+    return $current_resource_bresv_map;
+}
+
+sub get_pull_list {
+    my ($self, $client, $auth, $range, $interval_secs, $owning_lib) = @_;
+
+    my $e = new_editor(xact => 1, authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed("RETRIEVE_RESERVATION_PULL_LIST");
+    return $e->die_event unless (
+        ref($range) eq "ARRAY" or
+        ($interval_secs = int($interval_secs)) > 0
+    );
+
+    $owning_lib = $e->requestor->ws_ou if not $owning_lib;
+    $range = [ naive_ts_string(time), naive_ts_string(time + $interval_secs) ]
+        if not $range;
+
+    my $uncaptured = get_uncaptured_bresv_for_brsrc(
+        $e, {"range" => $range, "owning_lib" => $owning_lib}
+    );
+
+    if (keys(%$uncaptured)) {
+        my @all_bresv_ids = map { @{$_} } values %$uncaptured;
+        my %bresv_lookup = (
+            map { $_->id => $_ } @{
+                $e->search_booking_reservation([{"id" => [@all_bresv_ids]}, {
+                    flesh => 1,
+                    flesh_fields => { bresv => [
+                        "usr", "target_resource_type", "current_resource"
+                    ]}
+                }])
+            }
+        );
+        $e->disconnect;
+        return [ map {
+            my $key = $_;
+            my $one = $bresv_lookup{$uncaptured->{$key}->[0]};
+            my $result = {
+                "current_resource" => $one->current_resource,
+                "target_resource_type" => $one->target_resource_type,
+                "reservations" => [
+                    map { $bresv_lookup{$_} } @{$uncaptured->{$key}}
+                ]
+            };
+            foreach (@{$result->{"reservations"}}) {    # deflesh
+                $_->current_resource($_->current_resource->id);
+                $_->target_resource_type($_->target_resource_type->id);
+            }
+            $result;
+        } keys %$uncaptured ];
+    } else {
+        $e->disconnect;
+        return [];
+    }
+}
+__PACKAGE__->register_method(
+    method   => "get_pull_list",
+    api_name => "open-ils.booking.reservations.get_pull_list",
+    argc     => 4,
+    signature=> {
+        params => [
+            {type => "string", desc => "Authentication token"},
+            {type => "array", desc =>
+                "range: Date/time range for reservations (opt)"},
+            {type => "int", desc =>
+                "interval: Seconds from now (instead of range)"},
+            {type => "number", desc => "(Optional) Owning library"}
+        ],
+        return => { desc => "An array of hashes, each containing key/value " .
+            "pairs describing resource, resource type, and a list of " .
+            "reservations that claim the given resource." }
+    }
+);
+
+
+sub could_capture {
+    my ($self, $client, $auth, $barcode) = @_;
+
+    my $e = new_editor("authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed("COPY_CHECKIN");
+
+    my $dt_parser = new DateTime::Format::ISO8601;
+    my $now = now DateTime; # sic
+    my $res = get_uncaptured_bresv_for_brsrc($e, {"barcode" => $barcode});
+
+    if ($res and keys %$res) {
+        my $id;
+        while ((undef, $id) = each %$res) {
+            my $bresv = $e->retrieve_booking_reservation([
+                $id, {
+                    "flesh" => 1, "flesh_fields" => {
+                        "bresv" => [qw(
+                            usr target_resource_type
+                            target_resource current_resource
+                        )]
+                    }
+                }
+            ]);
+            my $elbow_room = interval_to_seconds(
+                $bresv->target_resource_type->elbow_room ||
+                $U->ou_ancestor_setting_value(
+                    $bresv->pickup_lib,
+                    "circ.booking_reservation.default_elbow_room"
+                ) ||
+                "0 seconds"
+            );
+
+            unless ($elbow_room) {
+                $client->respond($bresv);
+            } else {
+                my $start_time = $dt_parser->parse_datetime(
+                    clense_ISO8601($bresv->start_time)
+                );
+
+                if ($now >= $start_time->subtract("seconds" => $elbow_room)) {
+                    $client->respond($bresv);
+                } else {
+                    $logger->info(
+                        "not within elbow room: $elbow_room, " .
+                        "else would have returned bresv " . $bresv->id
+                    );
+                }
+            }
+        }
+    }
+    $e->disconnect;
+    undef;
+}
+__PACKAGE__->register_method(
+    method   => "could_capture",
+    api_name => "open-ils.booking.reservations.could_capture",
+    argc     => 2,
+    streaming=> 1,
+    signature=> {
+        params => [
+            {type => "string", desc => "Authentication token"},
+            {type => "string", desc => "Resource barcode"}
+        ],
+        return => {desc => "One or zero reservations; event on error."}
+    }
+);
+
+
+sub get_copy_fleshed_just_right {
+    my ($self, $client, $auth, $barcode) = @_;
+
+    return undef if not defined $barcode;
+    return {} if ref($barcode) eq "ARRAY" and not @$barcode;
+
+    my $e = new_editor(authtoken => $auth);
+    my $results = $e->search_asset_copy([
+        {"barcode" => $barcode},
+        {
+            "flesh" => 1,
+            "flesh_fields" => {"acp" => [qw/call_number location/]}
+        }
+    ]);
+
+    if (ref($results) eq "ARRAY") {
+        $e->disconnect;
+        return $results->[0] unless ref $barcode;
+        return +{ map { $_->barcode => $_ } @$results };
+    } else {
+        return $e->die_event;
+    }
+}
+__PACKAGE__->register_method(
+    method   => "get_copy_fleshed_just_right",
+    api_name => "open-ils.booking.asset.get_copy_fleshed_just_right",
+    argc     => 2,
+    signature=> {
+        params => [
+            {type => "string", desc => "Authentication token"},
+            {type => "mixed", desc => "One barcode or an array of them"},
+        ],
+        return => { desc =>
+            "A copy, or a hash of copies keyed by barcode if an array of " .
+            "barcodes was given"
+        }
+    }
+);
+
+
+sub best_bresv_candidate {
+    my ($e, $id_list) = @_;
+
+    # This will almost always be the case.
+    if (@$id_list == 1) {
+        $logger->info("best_bresv_candidate (only) " . $id_list->[0]);
+        return $id_list->[0];
+    }
+
+    my @here = ();
+    my $this_ou = $e->requestor->ws_ou;
+    my $results = $e->json_query({
+        "select" => {"brsrc" => ["pickup_lib"], "bresv" => ["id"]},
+        "from" => {
+            "bresv" => {
+                "brsrc" => {"field" => "id", "fkey" => "current_resource"}
+            }
+        },
+        "where" => {
+            {"+bresv" => {"id" => $id_list}}
+        }
+    });
+
+    foreach (@$results) {
+        push @here, $_->{"id"} if $_->{"pickup_lib"} == $this_ou;
+    }
+
+    my $result;
+    if (@here > 0) {
+        $result = @here == 1 ? pop @here : (sort @here)[0];
+    } else {
+        $result = (sort @$id_list)[0];
+    }
+    $logger->info(
+        "best_bresv_candidate from " . join(",", @$id_list) . ": $result"
+    );
+    return $result;
+}
+
+
+sub capture_resource_for_reservation {
+    my ($self, $client, $auth, $barcode, $no_update_copy) = @_;
+
+    my $e = new_editor(authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed("COPY_CHECKIN");
+
+    my $uncaptured = get_uncaptured_bresv_for_brsrc(
+        $e, {"barcode" => $barcode}
+    );
+
+    if (keys %$uncaptured) {
+        # Note this will only capture one reservation at a time, even in
+        # cases with overbooking (multiple "soonest" bresv's on a resource).
+        my $bresv = best_bresv_candidate(
+            $e, $uncaptured->{
+                (sort(keys %$uncaptured))[0]
+            }
+        );
+        $e->disconnect;
+        return capture_reservation(
+            $self, $client, $auth, $bresv, $no_update_copy
+        );
+    } else {
+        return new OpenILS::Event(
+            "RESERVATION_NOT_FOUND",
+            "desc" => "No capturable reservation found pertaining " .
+                "to a resource with barcode $barcode",
+            "payload" => {"fail_cause" => "no-reservation", "captured" => 0}
+        );
+    }
+}
+__PACKAGE__->register_method(
+    method   => "capture_resource_for_reservation",
+    api_name => "open-ils.booking.resources.capture_for_reservation",
+    argc     => 3,
+    signature=> {
+        params => [
+            {type => "string", desc => "Authentication token"},
+            {type => "string", desc => "Barcode of booked & targeted resource"},
+            {type => "number", desc => "(optional) 1 to not update copy"}
+        ],
+        return => { desc => "An OpenILS event describing the capture outcome" }
+    }
+);
+
+
+sub capture_reservation {
+    my ($self, $client, $auth, $res_id, $no_update_copy) = @_;
+
+    my $e = new_editor("xact" => 1, "authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed("COPY_CHECKIN");
+    my $here = $e->requestor->ws_ou;
+
+    my $reservation = $e->retrieve_booking_reservation([
+        $res_id, {
+            "flesh" => 2, "flesh_fields" => {
+                "bresv" => [qw/usr current_resource type/],
+                "au" => ["card"],
+                "brsrc" => ["type"]
+            }
+        }
+    ]);
+
+    return new OpenILS::Event("RESERVATION_NOT_FOUND") unless $reservation;
+    return new OpenILS::Event(
+        "RESERVATION_CAPTURE_FAILED",
+        payload => {"captured" => 0, "fail_cause" => "no-resource"}
+    ) unless $reservation->current_resource;
+
+    return new OpenILS::Event(
+        "RESERVATION_CAPTURE_FAILED",
+        "payload" => {"captured" => 0, "fail_cause" => "cancelled"}
+    ) if $reservation->cancel_time;
+
+    $reservation->capture_staff($e->requestor->id);
+    $reservation->capture_time("now");
+
+    $e->update_booking_reservation($reservation) or return $e->die_event;
+
+    my $ret = {"captured" => 1, "reservation" => $reservation};
+
+    my $search_acp_like_this = [
+        {
+            "barcode" => $reservation->current_resource->barcode,
+            "deleted" => "f"
+        },
+        {"flesh" => 1, "flesh_fields" => {"acp" => ["call_number"]}}
+    ];
+
+    if ($here != $reservation->pickup_lib) {
+        $logger->info("resource isn't at the reservation's pickup lib...");
+        return new OpenILS::Event(
+            "RESERVATION_CAPTURE_FAILED",
+            "payload" => {"captured" => 0, "fail_cause" => "not-transferable"}
+        ) unless $U->is_true(
+            $reservation->current_resource->type->transferable
+        );
+
+        # need to transit the item ... is it already in transit?
+        my $transit = $e->search_action_reservation_transit_copy(
+            {"reservation" => $res_id, "dest_recv_time" => undef}
+        )->[0];
+
+        if (!$transit) { # not yet in transit
+            $transit = new Fieldmapper::action::reservation_transit_copy;
+
+            $transit->reservation($reservation->id);
+            $transit->target_copy($reservation->current_resource->id);
+            $transit->copy_status(15);
+            $transit->source_send_time("now");
+            $transit->source($here);
+            $transit->dest($reservation->pickup_lib);
+
+            $e->create_action_reservation_transit_copy($transit);
+
+            if ($U->is_true(
+                $reservation->current_resource->type->catalog_item
+            )) {
+                my $copy = $e->search_asset_copy($search_acp_like_this)->[0];
+
+                if ($copy) {
+                    return new OpenILS::Event(
+                        "OPEN_CIRCULATION_EXISTS",
+                        "payload" => {"captured" => 0, "copy" => $copy}
+                    ) if $copy->status == 1 and not $no_update_copy;
+
+                    $ret->{"mvr"} = get_mvr($copy->call_number->record);
+                    if ($no_update_copy) {
+                        $ret->{"new_copy_status"} = 6;
+                    } else {
+                        $copy->status(6);
+                        $e->update_asset_copy($copy) or return $e->die_event;
+                    }
+                }
+            }
+        }
+
+        $ret->{"transit"} = $transit;
+    } elsif ($U->is_true($reservation->current_resource->type->catalog_item)) {
+        $logger->info("resource is a catalog item...");
+        my $copy = $e->search_asset_copy($search_acp_like_this)->[0];
+
+        if ($copy) {
+            return new OpenILS::Event(
+                "OPEN_CIRCULATION_EXISTS",
+                "payload" => {"captured" => 0, "copy" => $copy}
+            ) if $copy->status == 1 and not $no_update_copy;
+
+            $ret->{"mvr"} = get_mvr($copy->call_number->record);
+            if ($no_update_copy) {
+                $ret->{"new_copy_status"} = 15;
+            } else {
+                $copy->status(15);
+                $e->update_asset_copy($copy) or return $e->die_event;
+            }
+        }
+    }
+
+    $e->commit or return $e->die_event;
+
+    # XXX I'm not sure whether these last two elements of the payload
+    # actually get used anywhere.
+    $ret->{"resource"} = $reservation->current_resource;
+    $ret->{"type"} = $reservation->current_resource->type;
+    return new OpenILS::Event("SUCCESS", "payload" => $ret);
+}
+__PACKAGE__->register_method(
+    method   => "capture_reservation",
+    api_name => "open-ils.booking.reservations.capture",
+    argc     => 2,
+    signature=> {
+        params => [
+            {type => 'string', desc => 'Authentication token'},
+            {type => 'mixed', desc =>
+                'Reservation ID (number) or array of resource barcodes'}
+        ],
+        return => { desc => "An OpenILS Event object describing the outcome of the capture, with relevant payload." },
+    }
+);
+
+
+sub cancel_reservation {
+    my ($self, $client, $auth, $id_list) = @_;
+
+    my $e = new_editor(xact => 1, authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+    # Should the following permission really be checked as relates to each
+    # individual reservation's request_lib?  Hrmm...
+    return $e->die_event unless $e->allowed("ADMIN_BOOKING_RESERVATION");
+
+    my $bresv_list = $e->search_booking_reservation([
+        {"id" => $id_list},
+        {"flesh" => 1, "flesh_fields" => {"bresv" => [
+            "current_resource", "target_resource_type"
+        ]}}
+    ]);
+    return $e->die_event if not $bresv_list;
+
+    my @results = ();
+    my $circ = OpenSRF::AppSession->connect("open-ils.circ") or
+        return $e->die_event;
+    foreach my $bresv (@$bresv_list) {
+        $bresv->cancel_time("now");
+        $e->update_booking_reservation($bresv) or do {
+            $circ->disconnect;
+            return $e->die_event;
+        };
+        $e->xact_commit;
+        $e->xact_begin;
+
+        if (
+            $bresv->target_resource_type->catalog_item == "t" &&
+            $bresv->current_resource
+        ) {
+            $logger->info("result of no-op checkin (upon cxl bresv) is " .
+                $circ->request(
+                    "open-ils.circ.checkin", $auth,
+                    {"barcode" => $bresv->current_resource->barcode,
+                        "noop" => 1}
+                )->gather(1)->{"textcode"});
+        }
+        push @results, $bresv->id;
+    }
+
+    $e->disconnect;
+    $circ->disconnect;
+
+    return \@results;
+}
+__PACKAGE__->register_method(
+    method   => "cancel_reservation",
+    api_name => "open-ils.booking.reservations.cancel",
+    argc     => 2,
+    signature=> {
+        params => [
+            {type => "string", desc => "Authentication token"},
+            {type => "array", desc => "List of reservation IDs"}
+        ],
+        return => { desc => "A list of canceled reservation IDs" },
+    }
+);
+
+
+sub get_captured_reservations {
+    my ($self, $client, $auth, $barcode, $which) = @_;
+
+    my $e = new_editor(xact => 1, authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed("VIEW_USER");
+    return $e->die_event unless $e->allowed("ADMIN_BOOKING_RESERVATION");
+
+    # fetch the patron for our uses in any case...
+    my $patron = $U->fetch_user_by_barcode($barcode);
+    return $patron if ref($patron) eq "HASH" and exists $patron->{"ilsevent"};
+
+    my $bresv_flesh = {
+        "flesh" => 1,
+        "flesh_fields" => {"bresv" => [
+            qw/target_resource_type current_resource/
+        ]}
+    };
+
+    my $dispatch = {
+        "patron" => sub {
+            return $patron;
+        },
+        "ready" => sub {
+            return $e->search_booking_reservation([
+                {
+                    "usr" => $patron->id,
+                    "capture_time" => {"!=" => undef},
+                    "pickup_time" => undef,
+                    "start_time" => {">=" => naive_start_of_day()},
+                    "cancel_time" => undef
+                },
+                $bresv_flesh
+            ]) or $e->die_event;
+        },
+        "out" => sub {
+            return $e->search_booking_reservation([
+                {
+                    "usr" => $patron->id,
+                    "pickup_time" => {"!=" => undef},
+                    "return_time" => undef,
+                    "cancel_time" => undef
+                },
+                $bresv_flesh
+            ]) or $e->die_event;
+        },
+        "in" => sub {
+            return $e->search_booking_reservation([
+                {
+                    "usr" => $patron->id,
+                    "return_time" => {">=" => naive_start_of_day()},
+                    "cancel_time" => undef
+                },
+                $bresv_flesh
+            ]) or $e->die_event;
+        }
+    };
+
+    my $result = {};
+    foreach (@$which) {
+        my $f = $dispatch->{$_};
+        if ($f) {
+            my $r = &{$f}();
+            return $r if (ref($r) eq "HASH" and exists $r->{"ilsevent"});
+            $result->{$_} = $r;
+        }
+    }
+
+    return $result;
+}
+__PACKAGE__->register_method(
+    method   => "get_captured_reservations",
+    api_name => "open-ils.booking.reservations.get_captured",
+    argc     => 3,
+    signature=> {
+        params => [
+            {type => "string", desc => "Authentication token"},
+            {type => "string", desc => "Patron barcode"},
+            {type => "array", desc => "Parts wanted (patron, ready, out, in?)"}
+        ],
+        return => { desc => "A hash of parts." } # XXX describe more fully
+    }
+);
+
+
+sub get_bresv_by_returnable_resource_barcode {
+    my ($self, $client, $auth, $barcode) = @_;
+
+    my $e = new_editor(xact => 1, authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed("VIEW_USER");
+#    return $e->die_event unless $e->allowed("ADMIN_BOOKING_RESERVATION");
+
+    my $rows = $e->json_query({
+        "select" => {"bresv" => ["id"]},
+        "from" => {
+            "bresv" => {
+                "brsrc" => {"field" => "id", "fkey" => "current_resource"}
+            }
+        },
+        "where" => {
+            "+brsrc" => {"barcode" => $barcode},
+            "-and" => {
+                "pickup_time" => {"!=" => undef},
+                "cancel_time" => undef,
+                "return_time" => undef
+            }
+        }
+    }) or return $e->die_event;
+
+    if (@$rows < 1) {
+        $e->rollback;
+        return $rows;
+    } else {
+        # More than one result might be possible, but we don't want to return
+        # more than one at this time.
+        my $id = $rows->[0]->{"id"};
+        my $resp =$e->retrieve_booking_reservation([
+            $id, {
+                "flesh" => 2,
+                "flesh_fields" => {
+                    "bresv" => [qw/usr target_resource_type current_resource/],
+                    "au" => ["card"]
+                }
+            }
+        ]) or $e->die_event;
+        $e->rollback;
+        return $resp;
+    }
+}
+
+__PACKAGE__->register_method(
+    method   => "get_bresv_by_returnable_resource_barcode",
+    api_name => "open-ils.booking.reservations.by_returnable_resource_barcode",
+    argc     => 2,
+    signature=> {
+        params => [
+            {type => "string", desc => "Authentication token"},
+            {type => "string", desc => "Resource barcode"},
+        ],
+        return => { desc => "A fleshed bresv or an ilsevent on error" }
+    }
+);
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat.pm
new file mode 100644
index 0000000000..b787999899
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat.pm
@@ -0,0 +1,1229 @@
+use strict; use warnings;
+package OpenILS::Application::Cat;
+use OpenILS::Application::AppUtils;
+use OpenILS::Application;
+use OpenILS::Application::Cat::Merge;
+use OpenILS::Application::Cat::Authority;
+use OpenILS::Application::Cat::BibCommon;
+use OpenILS::Application::Cat::AssetCommon;
+use base qw/OpenILS::Application/;
+use Time::HiRes qw(time);
+use OpenSRF::EX qw(:try);
+use OpenSRF::Utils::JSON;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Event;
+use OpenILS::Const qw/:const/;
+
+use XML::LibXML;
+use Unicode::Normalize;
+use Data::Dumper;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Perm;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Logger qw($logger);
+use OpenSRF::AppSession;
+
+my $U = "OpenILS::Application::AppUtils";
+my $conf;
+my %marctemplates;
+
+__PACKAGE__->register_method(
+    method   => "retrieve_marc_template",
+    api_name => "open-ils.cat.biblio.marc_template.retrieve",
+    notes    => <<"    NOTES");
+    Returns a MARC 'record tree' based on a set of pre-defined templates.
+    Templates include : book
+    NOTES
+
+sub retrieve_marc_template {
+    my( $self, $client, $type ) = @_;
+    return $marctemplates{$type} if defined($marctemplates{$type});
+    $marctemplates{$type} = _load_marc_template($type);
+    return $marctemplates{$type};
+}
+
+__PACKAGE__->register_method(
+    method   => 'fetch_marc_template_types',
+    api_name => 'open-ils.cat.marc_template.types.retrieve'
+);
+
+my $marc_template_files;
+
+sub fetch_marc_template_types {
+    my( $self, $conn ) = @_;
+    __load_marc_templates();
+    return [ keys %$marc_template_files ];
+}
+
+sub __load_marc_templates {
+    return if $marc_template_files;
+    if(!$conf) { $conf = OpenSRF::Utils::SettingsClient->new; }
+
+    $marc_template_files = $conf->config_value(                    
+        "apps", "open-ils.cat","app_settings", "marctemplates" );
+
+    $logger->info("Loaded marc templates: " . Dumper($marc_template_files));
+}
+
+sub _load_marc_template {
+    my $type = shift;
+
+    __load_marc_templates();
+
+    my $template = $$marc_template_files{$type};
+    open( F, $template ) or 
+        throw OpenSRF::EX::ERROR ("Unable to open MARC template file: $template : $@");
+
+    my @xml = ;
+    close(F);
+    my $xml = join('', @xml);
+
+    return XML::LibXML->new->parse_string($xml)->documentElement->toString;
+}
+
+
+
+__PACKAGE__->register_method(
+    method   => 'fetch_bib_sources',
+    api_name => 'open-ils.cat.bib_sources.retrieve.all');
+
+sub fetch_bib_sources {
+    return OpenILS::Application::Cat::BibCommon->fetch_bib_sources();
+}
+
+__PACKAGE__->register_method(
+    method    => "create_record_xml",
+    api_name  => "open-ils.cat.biblio.record.xml.create.override",
+    signature => q/@see open-ils.cat.biblio.record.xml.create/);
+
+__PACKAGE__->register_method(
+    method    => "create_record_xml",
+    api_name  => "open-ils.cat.biblio.record.xml.create",
+    signature => q/
+        Inserts a new biblio with the given XML
+    /
+);
+
+sub create_record_xml {
+    my( $self, $client, $login, $xml, $source ) = @_;
+
+    my $override = 1 if $self->api_name =~ /override/;
+
+    my( $user_obj, $evt ) = $U->checksesperm($login, 'CREATE_MARC');
+    return $evt if $evt;
+
+    $logger->activity("user ".$user_obj->id." creating new MARC record");
+
+    my $meth = $self->method_lookup("open-ils.cat.biblio.record.xml.import");
+
+    $meth = $self->method_lookup(
+        "open-ils.cat.biblio.record.xml.import.override") if $override;
+
+    my ($s) = $meth->run($login, $xml, $source);
+    return $s;
+}
+
+
+
+__PACKAGE__->register_method(
+    method    => "biblio_record_replace_marc",
+    api_name  => "open-ils.cat.biblio.record.xml.update",
+    argc      => 3, 
+    signature => q/
+        Updates the XML for a given biblio record.
+        This does not change any other aspect of the record entry
+        exception the XML, the editor, and the edit date.
+        @return The update record object
+    /
+);
+
+__PACKAGE__->register_method(
+    method    => 'biblio_record_replace_marc',
+    api_name  => 'open-ils.cat.biblio.record.marc.replace',
+    signature => q/
+        @param auth The authtoken
+        @param recid The record whose MARC we're replacing
+        @param newxml The new xml to use
+    /
+);
+
+__PACKAGE__->register_method(
+    method    => 'biblio_record_replace_marc',
+    api_name  => 'open-ils.cat.biblio.record.marc.replace.override',
+    signature => q/@see open-ils.cat.biblio.record.marc.replace/
+);
+
+sub biblio_record_replace_marc  {
+    my( $self, $conn, $auth, $recid, $newxml, $source ) = @_;
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('CREATE_MARC', $e->requestor->ws_ou);
+
+    my $fix_tcn = $self->api_name =~ /replace/o;
+    my $override = $self->api_name =~ /override/o;
+
+    my $res = OpenILS::Application::Cat::BibCommon->biblio_record_replace_marc(
+        $e, $recid, $newxml, $source, $fix_tcn, $override);
+
+    $e->commit unless $U->event_code($res);
+
+    #my $ses = OpenSRF::AppSession->create('open-ils.ingest');
+    #$ses->request('open-ils.ingest.full.biblio.record', $recid);
+
+    return $res;
+}
+
+__PACKAGE__->register_method(
+    method    => "template_overlay_biblio_record_entry",
+    api_name  => "open-ils.cat.biblio.record_entry.template_overlay",
+    stream    => 1,
+    signature => q#
+        Overlays biblio.record_entry MARC values
+        @param auth The authtoken
+        @param records The record ids to be updated by the template
+        @param template The overlay template
+        @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
+    #
+);
+
+sub template_overlay_biblio_record_entry {
+    my($self, $conn, $auth, $records, $template) = @_;
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+
+    $records = [$records] if (!ref($records));
+
+    for my $rid ( @$records ) {
+        my $rec = $e->retrieve_biblio_record_entry($rid);
+        next unless $rec;
+
+        unless ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
+            $conn->respond({ record => $rid, success => 'f' });
+            next;
+        }
+
+        my $success = $e->json_query(
+            { from => [ 'vandelay.template_overlay_bib_record', $template, $rid ] }
+        )->[0]->{'vandelay.template_overlay_bib_record'};
+
+        $conn->respond({ record => $rid, success => $success });
+    }
+
+    $e->commit;
+    return undef;
+}
+
+__PACKAGE__->register_method(
+    method    => "template_overlay_container",
+    api_name  => "open-ils.cat.container.template_overlay",
+    stream    => 1,
+    signature => q#
+        Overlays biblio.record_entry MARC values
+        @param auth The authtoken
+        @param container The container, um, containing the records to be updated by the template
+        @param template The overlay template, or nothing and the method will look for a negative bib id in the container
+        @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
+    #
+);
+
+__PACKAGE__->register_method(
+    method    => "template_overlay_container",
+    api_name  => "open-ils.cat.container.template_overlay.background",
+    stream    => 1,
+    signature => q#
+        Overlays biblio.record_entry MARC values
+        @param auth The authtoken
+        @param container The container, um, containing the records to be updated by the template
+        @param template The overlay template, or nothing and the method will look for a negative bib id in the container
+        @return Cache key to check for status of the container overlay
+    #
+);
+
+sub template_overlay_container {
+    my($self, $conn, $auth, $container, $template) = @_;
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+
+    my $actor = OpenSRF::AppSession->create('open-ils.actor') if ($self->api_name =~ /background$/);
+
+    my $items = $e->search_container_biblio_record_entry_bucket_item({ bucket => $container });
+
+    my $titem;
+    if (!$template) {
+        ($titem) = grep { $_->target_biblio_record_entry < 0 } @$items;
+        if (!$titem) {
+            $e->rollback;
+            return undef;
+        }
+        $items = [grep { $_->target_biblio_record_entry > 0 } @$items];
+
+        $template = $e->retrieve_biblio_record_entry( $titem->target_biblio_record_entry )->marc;
+    }
+
+    my $responses = [];
+    my $some_failed = 0;
+
+    $self->respond_complete(
+        $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses)->gather(1)
+    ) if ($actor);
+
+    for my $item ( @$items ) {
+        my $rec = $e->retrieve_biblio_record_entry($item->target_biblio_record_entry);
+        next unless $rec;
+
+        my $success = 'f';
+        if ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
+            $success = $e->json_query(
+                { from => [ 'vandelay.template_overlay_bib_record', $template, $rec->id ] }
+            )->[0]->{'vandelay.template_overlay_bib_record'};
+        }
+
+        $some_failed++ if ($success eq 'f');
+
+        if ($actor) {
+            push @$responses, { record => $rec->id, success => $success };
+            $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
+        } else {
+            $conn->respond({ record => $rec->id, success => $success });
+        }
+
+        if ($success eq 't') {
+            unless ($e->delete_container_biblio_record_entry_bucket_item($item)) {
+                $e->rollback;
+                if ($actor) {
+                    push @$responses, { complete => 1, success => 'f' };
+                    $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
+                    return undef;
+                } else {
+                    return { complete => 1, success => 'f' };
+                }
+            }
+        }
+    }
+
+    if ($titem && !$some_failed) {
+        return $e->die_event unless ($e->delete_container_biblio_record_entry_bucket_item($titem));
+    }
+
+    if ($e->commit) {
+        if ($actor) {
+            push @$responses, { complete => 1, success => 't' };
+            $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
+        } else {
+            return { complete => 1, success => 't' };
+        }
+    } else {
+        if ($actor) {
+            push @$responses, { complete => 1, success => 'f' };
+            $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
+        } else {
+            return { complete => 1, success => 'f' };
+        }
+    }
+    return undef;
+}
+
+__PACKAGE__->register_method(
+    method    => "update_biblio_record_entry",
+    api_name  => "open-ils.cat.biblio.record_entry.update",
+    signature => q/
+        Updates a biblio.record_entry
+        @param auth The authtoken
+        @param record The record with updated values
+        @return 1 on success, Event on error.
+    /
+);
+
+sub update_biblio_record_entry {
+    my($self, $conn, $auth, $record) = @_;
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('UPDATE_RECORD');
+    $e->update_biblio_record_entry($record) or return $e->die_event;
+    $e->commit;
+    return 1;
+}
+
+__PACKAGE__->register_method(
+    method    => "undelete_biblio_record_entry",
+    api_name  => "open-ils.cat.biblio.record_entry.undelete",
+    signature => q/
+        Un-deletes a record and sets active=true
+        @param auth The authtoken
+        @param record The record_id to ressurect
+        @return 1 on success, Event on error.
+    /
+);
+sub undelete_biblio_record_entry {
+    my($self, $conn, $auth, $record_id) = @_;
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('UPDATE_RECORD');
+
+    my $record = $e->retrieve_biblio_record_entry($record_id)
+        or return $e->die_event;
+    $record->deleted('f');
+    $record->active('t');
+
+    # Set the leader/05 to indicate that the record has been corrected/revised
+    my $marc = $record->marc();
+    $marc =~ s{(.{5}).}{$1c};
+    $record->marc($marc);
+
+    # no 2 non-deleted records can have the same tcn_value
+    my $existing = $e->search_biblio_record_entry(
+        {   deleted => 'f', 
+            tcn_value => $record->tcn_value, 
+            id => {'!=' => $record_id}
+        }, {idlist => 1});
+    return OpenILS::Event->new('TCN_EXISTS') if @$existing;
+
+    $e->update_biblio_record_entry($record) or return $e->die_event;
+    $e->commit;
+    return 1;
+}
+
+
+__PACKAGE__->register_method(
+    method    => "biblio_record_xml_import",
+    api_name  => "open-ils.cat.biblio.record.xml.import.override",
+    signature => q/@see open-ils.cat.biblio.record.xml.import/);
+
+__PACKAGE__->register_method(
+    method    => "biblio_record_xml_import",
+    api_name  => "open-ils.cat.biblio.record.xml.import",
+    notes     => <<"    NOTES");
+    Takes a marcxml record and imports the record into the database.  In this
+    case, the marcxml record is assumed to be a complete record (i.e. valid
+    MARC).  The title control number is taken from (whichever comes first)
+    tags 001, 039[ab], 020a, 022a, 010, 035a and whichever does not already exist
+    in the database.
+    user_session must have IMPORT_MARC permissions
+    NOTES
+
+
+sub biblio_record_xml_import {
+    my( $self, $client, $authtoken, $xml, $source, $auto_tcn) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$authtoken);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('IMPORT_MARC', $e->requestor->ws_ou);
+
+    my $override = $self->api_name =~ /override/;
+    my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
+        $e, $xml, $source, $auto_tcn, $override);
+
+    return $record if $U->event_code($record);
+
+    $e->commit;
+
+    #my $ses = OpenSRF::AppSession->create('open-ils.ingest');
+    #$ses->request('open-ils.ingest.full.biblio.record', $record->id);
+
+    return $record;
+}
+
+__PACKAGE__->register_method(
+    method        => "biblio_record_record_metadata",
+    api_name      => "open-ils.cat.biblio.record.metadata.retrieve",
+    authoritative => 1,
+    argc          => 1, #(session_id, biblio_tree ) 
+    notes         => "Walks the tree and commits any changed nodes " .
+                     "adds any new nodes, and deletes any deleted nodes",
+);
+
+sub biblio_record_record_metadata {
+    my( $self, $client, $authtoken, $ids ) = @_;
+
+    return [] unless $ids and @$ids;
+
+    my $editor = new_editor(authtoken => $authtoken);
+    return $editor->event unless $editor->checkauth;
+    return $editor->event unless $editor->allowed('VIEW_USER');
+
+    my @results;
+
+    for(@$ids) {
+        return $editor->event unless 
+            my $rec = $editor->retrieve_biblio_record_entry($_);
+        $rec->creator($editor->retrieve_actor_user($rec->creator));
+        $rec->editor($editor->retrieve_actor_user($rec->editor));
+        $rec->clear_marc; # slim the record down
+        push( @results, $rec );
+    }
+
+    return \@results;
+}
+
+
+
+__PACKAGE__->register_method(
+    method    => "biblio_record_marc_cn",
+    api_name  => "open-ils.cat.biblio.record.marc_cn.retrieve",
+    argc      => 1, #(bib id ) 
+    signature => {
+        desc   => 'Extracts call number candidates from a bibliographic record',
+        params => [
+            {desc => 'Record ID', type => 'number'},
+            {desc => '(Optional) Classification scheme ID', type => 'number'},
+        ]
+    },
+    return => {desc => 'Hash of candidate call numbers identified by tag' }
+);
+
+sub biblio_record_marc_cn {
+    my( $self, $client, $id, $class ) = @_;
+
+    my $e = new_editor();
+    my $marc = $e->retrieve_biblio_record_entry($id)->marc;
+
+    my $doc = XML::LibXML->new->parse_string($marc);
+    $doc->documentElement->setNamespace( "http://www.loc.gov/MARC21/slim", "marc", 1 );
+
+    my @fields;
+    my @res;
+    if ($class) {
+        @fields = split(/,/, $e->retrieve_asset_call_number_class($class)->field);
+    } else {
+        @fields = qw/050ab 055ab 060ab 070ab 080ab 082ab 086ab 088ab 090 092 096 098 099/;
+    }
+
+    # Get field/subfield combos based on acnc value; for example "050ab,055ab"
+
+    foreach my $field (@fields) {
+        my $tag = substr($field, 0, 3);
+        $logger->debug("Tag = $tag");
+        my @node = $doc->findnodes("//marc:datafield[\@tag='$tag']");
+
+        # Now parse the subfields and build up the subfield XPath
+        my @subfields = split(//, substr($field, 3));
+
+        # If they give us no subfields to parse, default to just the 'a'
+        if (!@subfields) {
+            @subfields = ('a');
+        }
+        my $subxpath;
+        foreach my $sf (@subfields) {
+            $subxpath .= "\@code='$sf' or ";
+        }
+        $subxpath = substr($subxpath, 0, -4);
+        $logger->debug("subxpath = $subxpath");
+
+        # Find the contents of the specified subfields
+        foreach my $x (@node) {
+            my $cn = $x->findvalue("marc:subfield[$subxpath]");
+            push @res, {$tag => $cn} if ($cn);
+        }
+    }
+
+    return \@res;
+}
+
+__PACKAGE__->register_method(
+    method    => 'autogen_barcodes',
+    api_name  => "open-ils.cat.item.barcode.autogen",
+    signature => {
+        desc   => 'Returns N generated barcodes following a specified barcode.',
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Barcode which the sequence should follow from', type => 'string'},
+            {desc => 'Number of barcodes to generate', type => 'number'},
+            {desc => 'Options hash.  Currently you can pass in checkdigit : false to disable the use of checkdigits.'}
+        ],
+        return => {desc => 'Array of generated barcodes'}
+    }
+);
+
+sub autogen_barcodes {
+    my( $self, $client, $auth, $barcode, $num_of_barcodes, $options ) = @_;
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('UPDATE_COPY', $e->requestor->ws_ou);
+    $options ||= {};
+
+    my $barcode_text = '';
+    my $barcode_number = 0;
+
+    if ($barcode =~ /^(\D+)/) { $barcode_text = $1; }
+    if ($barcode =~ /(\d+)$/) { $barcode_number = $1; }
+
+    my @res;
+    for (my $i = 1; $i <= $num_of_barcodes; $i++) {
+        my $calculated_barcode;
+
+        # default is to use checkdigits, so looking for an explicit false here
+        if (defined $$options{'checkdigit'} && ! $$options{'checkdigit'}) { 
+            $calculated_barcode = $barcode_number + $i;
+        } else {
+            if ($barcode_number =~ /^\d{8}$/) {
+                $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
+            } elsif ($barcode_number =~ /^\d{9}$/) {
+                $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
+            } elsif ($barcode_number =~ /^\d{13}$/) {
+                $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
+            } elsif ($barcode_number =~ /^\d{14}$/) {
+                $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
+            } else {
+                $calculated_barcode = $barcode_number + $i;
+            }
+        }
+        push @res, $barcode_text . $calculated_barcode;
+    }
+    return \@res
+}
+
+# Codabar doesn't define a checkdigit algorithm, but this one is typically used by libraries.  gmcharlt++
+sub add_codabar_checkdigit {
+    my $barcode = shift;
+    my $strip_last_digit = shift;
+
+    return $barcode if $barcode =~ /\D/;
+    $barcode = substr($barcode, 0, length($barcode)-1) if $strip_last_digit;
+    my @digits = split //, $barcode;
+    my $total = 0;
+    for (my $i = 1; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 1,3,5,7,9,11
+        $total += $digits[$i];
+    }
+    for (my $i = 0; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 0,2,4,6,8,10,12
+        $total += (2 * $digits[$i] >= 10) ? (2 * $digits[$i] - 9) : (2 * $digits[$i]);
+    }
+    my $remainder = $total % 10;
+    my $checkdigit = ($remainder == 0) ? $remainder : 10 - $remainder;
+    return $barcode . $checkdigit;
+}
+
+__PACKAGE__->register_method(
+    method        => "orgs_for_title",
+    authoritative => 1,
+    api_name      => "open-ils.cat.actor.org_unit.retrieve_by_title"
+);
+
+sub orgs_for_title {
+    my( $self, $client, $record_id ) = @_;
+
+    my $vols = $U->simple_scalar_request(
+        "open-ils.cstore",
+        "open-ils.cstore.direct.asset.call_number.search.atomic",
+        { record => $record_id, deleted => 'f' });
+
+    my $orgs = { map {$_->owning_lib => 1 } @$vols };
+    return [ keys %$orgs ];
+}
+
+
+__PACKAGE__->register_method(
+    method        => "retrieve_copies",
+    authoritative => 1,
+    api_name      => "open-ils.cat.asset.copy_tree.retrieve");
+
+__PACKAGE__->register_method(
+    method   => "retrieve_copies",
+    api_name => "open-ils.cat.asset.copy_tree.global.retrieve");
+
+# user_session may be null/undef
+sub retrieve_copies {
+
+    my( $self, $client, $user_session, $docid, @org_ids ) = @_;
+
+    if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
+
+    $docid = "$docid";
+
+    # grabbing copy trees should be available for everyone..
+    if(!@org_ids and $user_session) {
+        my($user_obj, $evt) = OpenILS::Application::AppUtils->checkses($user_session); 
+        return $evt if $evt;
+        @org_ids = ($user_obj->home_ou);
+    }
+
+    if( $self->api_name =~ /global/ ) {
+        return _build_volume_list( { record => $docid, deleted => 'f', label => { '<>' => '##URI##' } } );
+
+    } else {
+
+        my @all_vols;
+        for my $orgid (@org_ids) {
+            my $vols = _build_volume_list( 
+                    { record => $docid, owning_lib => $orgid, deleted => 'f', label => { '<>' => '##URI##' } } );
+            push( @all_vols, @$vols );
+        }
+        
+        return \@all_vols;
+    }
+
+    return undef;
+}
+
+
+sub _build_volume_list {
+    my $search_hash = shift;
+
+    $search_hash->{deleted} = 'f';
+    my $e = new_editor();
+
+    my $vols = $e->search_asset_call_number([$search_hash, { 'order_by' => {
+        'acn' => 'oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib'
+    } } ] );
+
+    my @volumes;
+
+    for my $volume (@$vols) {
+
+        my $copies = $e->search_asset_copy(
+            { call_number => $volume->id , deleted => 'f' });
+
+        $copies = [ sort { $a->barcode cmp $b->barcode } @$copies  ];
+
+        for my $c (@$copies) {
+            if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) {
+                $c->circulations(
+                    $e->search_action_circulation(
+                        [
+                            { target_copy => $c->id },
+                            {
+                                order_by => { circ => 'xact_start desc' },
+                                limit => 1
+                            }
+                        ]
+                    )
+                )
+            }
+        }
+
+        $volume->copies($copies);
+        push( @volumes, $volume );
+    }
+
+    #$session->disconnect();
+    return \@volumes;
+
+}
+
+
+__PACKAGE__->register_method(
+    method   => "fleshed_copy_update",
+    api_name => "open-ils.cat.asset.copy.fleshed.batch.update",);
+
+__PACKAGE__->register_method(
+    method   => "fleshed_copy_update",
+    api_name => "open-ils.cat.asset.copy.fleshed.batch.update.override",);
+
+
+sub fleshed_copy_update {
+    my( $self, $conn, $auth, $copies, $delete_stats ) = @_;
+    return 1 unless ref $copies;
+    my( $reqr, $evt ) = $U->checkses($auth);
+    return $evt if $evt;
+    my $editor = new_editor(requestor => $reqr, xact => 1);
+    my $override = $self->api_name =~ /override/;
+    my $retarget_holds = [];
+    $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
+        $editor, $override, undef, $copies, $delete_stats, $retarget_holds, undef);
+
+    if( $evt ) { 
+        $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
+        $editor->rollback; 
+        return $evt; 
+    }
+
+    $editor->commit;
+    $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies");
+    reset_hold_list($auth, $retarget_holds);
+
+    return 1;
+}
+
+sub reset_hold_list {
+    my($auth, $hold_ids) = @_;
+    return unless @$hold_ids;
+    $logger->info("reseting holds after copy status change: @$hold_ids");
+    my $ses = OpenSRF::AppSession->create('open-ils.circ');
+    $ses->request('open-ils.circ.hold.reset.batch', $auth, $hold_ids);
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'in_db_merge',
+    api_name  => 'open-ils.cat.biblio.records.merge',
+    signature => q/
+        Merges a group of records
+        @param auth The login session key
+        @param master The id of the record all other records should be merged into
+        @param records Array of records to be merged into the master record
+        @return 1 on success, Event on error.
+    /
+);
+
+sub in_db_merge {
+    my( $self, $conn, $auth, $master, $records ) = @_;
+
+    my $editor = new_editor( authtoken => $auth, xact => 1 );
+    return $editor->die_event unless $editor->checkauth;
+    return $editor->die_event unless $editor->allowed('MERGE_BIB_RECORDS'); # TODO see below about record ownership
+
+    my $count = 0;
+    for my $source ( @$records ) {
+        #XXX we actually /will/ want to check perms for master and sources after record ownership exists
+
+        # This stored proc (asset.merge_record_assets(target,source)) has the side effects of
+        # moving call_number, title-type (and some volume-type) hold_request and uri-mapping
+        # objects from the source record to the target record, so must be called from within
+        # a transaction.
+
+        $count += $editor->json_query({
+            select => {
+                bre => [{
+                    alias => 'count',
+                    transform => 'asset.merge_record_assets',
+                    column => 'id',
+                    params => [$source]
+                }]
+            },
+            from   => 'bre',
+            where  => { id => $master }
+        })->[0]->{count}; # count of objects moved, of all types
+
+    }
+
+    $editor->commit;
+    return $count;
+}
+
+__PACKAGE__->register_method(
+    method    => 'in_db_auth_merge',
+    api_name  => 'open-ils.cat.authority.records.merge',
+    signature => q/
+        Merges a group of authority records
+        @param auth The login session key
+        @param master The id of the record all other records should be merged into
+        @param records Array of records to be merged into the master record
+        @return 1 on success, Event on error.
+    /
+);
+
+sub in_db_auth_merge {
+    my( $self, $conn, $auth, $master, $records ) = @_;
+
+    my $editor = new_editor( authtoken => $auth, xact => 1 );
+    return $editor->die_event unless $editor->checkauth;
+    return $editor->die_event unless $editor->allowed('MERGE_AUTH_RECORDS'); # TODO see below about record ownership
+
+    my $count = 0;
+    for my $source ( @$records ) {
+        $count += $editor->json_query({
+            select => {
+                are => [{
+                    alias => 'count',
+                    transform => 'authority.merge_records',
+                    column => 'id',
+                    params => [$source]
+                }]
+            },
+            from   => 'are',
+            where  => { id => $master }
+        })->[0]->{count}; # count of objects moved, of all types
+    }
+
+    $editor->commit;
+    return $count;
+}
+
+__PACKAGE__->register_method(
+    method   => "fleshed_volume_update",
+    api_name => "open-ils.cat.asset.volume.fleshed.batch.update",);
+
+__PACKAGE__->register_method(
+    method   => "fleshed_volume_update",
+    api_name => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
+
+sub fleshed_volume_update {
+    my( $self, $conn, $auth, $volumes, $delete_stats, $options ) = @_;
+    my( $reqr, $evt ) = $U->checkses($auth);
+    return $evt if $evt;
+    $options ||= {};
+
+    my $override = ($self->api_name =~ /override/);
+    my $editor = new_editor( requestor => $reqr, xact => 1 );
+    my $retarget_holds = [];
+    my $auto_merge_vols = $options->{auto_merge_vols};
+
+    for my $vol (@$volumes) {
+        $logger->info("vol-update: investigating volume ".$vol->id);
+
+        $vol->editor($reqr->id);
+        $vol->edit_date('now');
+
+        my $copies = $vol->copies;
+        $vol->clear_copies;
+
+        $vol->editor($editor->requestor->id);
+        $vol->edit_date('now');
+
+        if( $vol->isdeleted ) {
+
+            $logger->info("vol-update: deleting volume");
+            my $cs = $editor->search_asset_copy(
+                { call_number => $vol->id, deleted => 'f' } );
+            return OpenILS::Event->new(
+                'VOLUME_NOT_EMPTY', payload => $vol->id ) if @$cs;
+
+            $vol->deleted('t');
+            return $editor->event unless
+                $editor->update_asset_call_number($vol);
+
+            
+        } elsif( $vol->isnew ) {
+            $logger->info("vol-update: creating volume");
+            $evt = OpenILS::Application::Cat::AssetCommon->create_volume( $override, $editor, $vol );
+            return $evt if $evt;
+
+        } elsif( $vol->ischanged ) {
+            $logger->info("vol-update: update volume");
+            my $resp = update_volume($vol, $editor, ($override or $auto_merge_vols));
+            return $resp->{evt} if $resp->{evt};
+            $vol = $resp->{merge_vol};
+        }
+
+        # now update any attached copies
+        if( $copies and @$copies and !$vol->isdeleted ) {
+            $_->call_number($vol->id) for @$copies;
+            $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
+                $editor, $override, $vol, $copies, $delete_stats, $retarget_holds, undef);
+            return $evt if $evt;
+        }
+    }
+
+    $editor->finish;
+    reset_hold_list($auth, $retarget_holds);
+    return scalar(@$volumes);
+}
+
+
+sub update_volume {
+    my $vol = shift;
+    my $editor = shift;
+    my $auto_merge = shift;
+    my $evt;
+    my $merge_vol;
+
+    return {evt => $evt} 
+        if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) );
+
+    my $vols = $editor->search_asset_call_number({ 
+        owning_lib => $vol->owning_lib,
+        record     => $vol->record,
+        label      => $vol->label,
+        deleted    => 'f',
+        id         => {'!=' => $vol->id}
+    });
+
+    if(@$vols) {
+
+        if($auto_merge) {
+
+            # If the auto-merge option is on, merge our updated volume into the existing
+            # volume with the same record + owner + label.
+            ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]);
+            return {evt => $evt, merge_vol => $merge_vol};
+
+        } else {
+            return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)};
+        }
+    }
+
+    return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol);
+    return {};
+}
+
+
+
+__PACKAGE__->register_method (
+    method   => 'delete_bib_record',
+    api_name => 'open-ils.cat.biblio.record_entry.delete');
+
+sub delete_bib_record {
+    my($self, $conn, $auth, $rec_id) = @_;
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
+    my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
+    return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
+    my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id);
+    if($evt) { $e->rollback; return $evt; }   
+    $e->commit;
+    return 1;
+}
+
+
+
+__PACKAGE__->register_method (
+    method   => 'batch_volume_transfer',
+    api_name => 'open-ils.cat.asset.volume.batch.transfer',
+);
+
+__PACKAGE__->register_method (
+    method   => 'batch_volume_transfer',
+    api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
+);
+
+
+sub batch_volume_transfer {
+    my( $self, $conn, $auth, $args ) = @_;
+
+    my $evt;
+    my $rec     = $$args{docid};
+    my $o_lib   = $$args{lib};
+    my $vol_ids = $$args{volumes};
+
+    my $override = 1 if $self->api_name =~ /override/;
+
+    $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
+
+    my $e = new_editor(authtoken => $auth, xact =>1);
+    return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
+
+    my $dorg = $e->retrieve_actor_org_unit($o_lib)
+        or return $e->event;
+
+    my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
+        or return $e->event;
+
+    return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) );
+
+    my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
+    my @seen;
+
+   my @rec_ids;
+
+    for my $vol (@$vols) {
+
+        # if we've already looked at this volume, go to the next
+        next if !$vol or grep { $vol->id == $_ } @seen;
+
+        # grab all of the volumes in the list that have 
+        # the same label so they can be merged
+        my @all = grep { $_->label eq $vol->label } @$vols;
+
+        # take note of the fact that we've looked at this set of volumes
+        push( @seen, $_->id ) for @all;
+        push( @rec_ids, $_->record ) for @all;
+
+        # for each volume, see if there are any copies that have a 
+        # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).  
+        # if so, warn them
+        unless( $override ) {
+            for my $v (@all) {
+
+                $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
+                my $args = { 
+                    call_number => $v->id, 
+                    circ_lib    => { "not in" => [ $o_lib, $v->owning_lib ] },
+                    deleted     => 'f'
+                };
+
+                my $copies = $e->search_asset_copy($args, {idlist=>1});
+
+                # if the copy's circ_lib matches the destination lib,
+                # that's ok too
+                return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
+            }
+        }
+
+        # see if there is a volume at the destination lib that 
+        # already has the requested label
+        my $existing_vol = $e->search_asset_call_number(
+            {
+                label      => $vol->label, 
+                record     => $rec, 
+                owning_lib => $o_lib,
+                deleted    => 'f'
+            }
+        )->[0];
+
+        if( $existing_vol ) {
+
+            if( grep { $_->id == $existing_vol->id } @all ) {
+                # this volume is already accounted for in our list of volumes to merge
+                $existing_vol = undef;
+
+            } else {
+                # this volume exists on the destination record/owning_lib and must
+                # be used as the destination for merging
+                $logger->debug("merge: volume already exists at destination record: ".
+                    $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
+            }
+        } 
+
+        if( @all > 1 || $existing_vol ) {
+            $logger->info("merge: found collisions in volume transfer");
+            my @args = ($e, \@all);
+            @args = ($e, \@all, $existing_vol) if $existing_vol;
+            ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
+            return $evt if $evt;
+        } 
+        
+        if( !$existing_vol ) {
+
+            $vol->owning_lib($o_lib);
+            $vol->record($rec);
+            $vol->editor($e->requestor->id);
+            $vol->edit_date('now');
+    
+            $logger->info("merge: updating volume ".$vol->id);
+            $e->update_asset_call_number($vol) or return $e->event;
+
+        } else {
+            $logger->info("merge: bypassing volume update because existing volume used as target");
+        }
+
+        # regardless of what volume was used as the destination, 
+        # update any copies that have moved over to the new lib
+        my $copies = $e->search_asset_copy({call_number=>$vol->id, deleted => 'f'});
+
+        # update circ lib on the copies - make this a method flag?
+        for my $copy (@$copies) {
+            next if $copy->circ_lib == $o_lib;
+            $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
+            $copy->circ_lib($o_lib);
+            $copy->editor($e->requestor->id);
+            $copy->edit_date('now');
+            $e->update_asset_copy($copy) or return $e->event;
+        }
+
+        # Now see if any empty records need to be deleted after all of this
+
+        for(@rec_ids) {
+            $logger->debug("merge: seeing if we should delete record $_...");
+            $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_) 
+                if OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_);
+            return $evt if $evt;
+        }
+    }
+
+    $logger->info("merge: transfer succeeded");
+    $e->commit;
+    return 1;
+}
+
+
+
+
+__PACKAGE__->register_method(
+    api_name => 'open-ils.cat.call_number.find_or_create',
+    method   => 'find_or_create_volume',
+);
+
+sub find_or_create_volume {
+    my( $self, $conn, $auth, $label, $record_id, $org_id ) = @_;
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+    my ($vol, $evt, $exists) = 
+        OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id);
+    return $evt if $evt;
+    $e->rollback if $exists;
+    $e->commit if $vol;
+    return $vol->id;
+}
+
+
+__PACKAGE__->register_method(
+    method    => "create_serial_record_xml",
+    api_name  => "open-ils.cat.serial.record.xml.create.override",
+    signature => q/@see open-ils.cat.serial.record.xml.create/);
+
+__PACKAGE__->register_method(
+    method    => "create_serial_record_xml",
+    api_name  => "open-ils.cat.serial.record.xml.create",
+    signature => q/
+        Inserts a new serial record with the given XML
+    /
+);
+
+sub create_serial_record_xml {
+    my( $self, $client, $login, $source, $owning_lib, $record_id, $xml ) = @_;
+
+    my $override = 1 if $self->api_name =~ /override/; # not currently used
+
+    my $e = new_editor(xact=>1, authtoken=>$login);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib);
+
+    # Auto-populate the location field of a placeholder MFHD record with the library name
+    my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event;
+
+    my $mfhd = Fieldmapper::serial::record_entry->new;
+
+    $mfhd->source($source) if $source;
+    $mfhd->record($record_id);
+    $mfhd->creator($e->requestor->id);
+    $mfhd->editor($e->requestor->id);
+    $mfhd->create_date('now');
+    $mfhd->edit_date('now');
+    $mfhd->owning_lib($owning_lib);
+
+    # If the caller did not pass in MFHD XML, create a placeholder record.
+    # The placeholder will only contain the name of the owning library.
+    # The goal is to generate common patterns for the caller in the UI that
+    # then get passed in here.
+    if (!$xml) {
+        my $aou_name = $aou->name;
+        $xml = <
+00307ny  a22001094  4500
+42153
+20090601182414.0
+$record_id
+      4u####8###l# 4   uueng1      
+ $aou_name
+
+HERE
+    }
+    my $marcxml = XML::LibXML->new->parse_string($xml);
+    $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 );
+    $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim");
+
+    $mfhd->marc($U->entityize($marcxml->documentElement->toString));
+
+    $e->create_serial_record_entry($mfhd) or return $e->die_event;
+
+    $e->commit;
+    return $mfhd->id;
+}
+
+__PACKAGE__->register_method(
+    method   => "create_update_asset_copy_template",
+    api_name => "open-ils.cat.asset.copy_template.create_or_update"
+);
+
+sub create_update_asset_copy_template {
+    my ($self, $client, $authtoken, $act) = @_;
+
+    my $e = new_editor("xact" => 1, "authtoken" => $authtoken);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed(
+        "ADMIN_ASSET_COPY_TEMPLATE", $act->owning_lib
+    );
+
+    $act->editor($e->requestor->id);
+    $act->edit_date("now");
+
+    my $retval;
+    if (!$act->id) {
+        $act->creator($e->requestor->id);
+        $act->create_date("now");
+
+        $e->create_asset_copy_template($act) or return $e->die_event;
+        $retval = $e->data;
+    } else {
+        $e->update_asset_copy_template($act) or return $e->die_event;
+        $retval = $e->retrieve_asset_copy_template($e->data);
+    }
+    $e->commit and return $retval;
+}
+
+1;
+
+# vi:et:ts=4:sw=4
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/AssetCommon.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/AssetCommon.pm
new file mode 100644
index 0000000000..b2dffc5518
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/AssetCommon.pm
@@ -0,0 +1,513 @@
+package OpenILS::Application::Cat::AssetCommon;
+use strict; use warnings;
+use OpenILS::Application::Cat::BibCommon;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenSRF::Utils::Logger qw($logger);
+use OpenILS::Application::Cat::Merge;
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Const qw/:const/;
+use OpenSRF::AppSession;
+use OpenILS::Event;
+use OpenILS::Application::Circ::CircCommon;
+my $U = 'OpenILS::Application::AppUtils';
+
+
+# ---------------------------------------------------------------------------
+# Shared copy mangling code.  Do not publish methods from here.
+# ---------------------------------------------------------------------------
+
+sub org_cannot_have_vols {
+    my($class, $e, $org_id) = @_;
+	my $org = $e->retrieve_actor_org_unit([
+        $org_id,
+        {   flesh => 1,
+            flesh_fields => {aou => ['ou_type']}
+        }]) or return $e->event;
+
+	return OpenILS::Event->new('ORG_CANNOT_HAVE_VOLS')
+		unless $U->is_true($org->ou_type->can_have_vols);
+
+	return 0;
+}
+
+sub fix_copy_price {
+    my $class = shift;
+	my $copy = shift;
+
+    if(defined $copy->price) {
+	    my $p = $copy->price || 0;
+	    $p =~ s/\$//og;
+	    $copy->price($p);
+    }
+
+	my $d = $copy->deposit_amount || 0;
+	$d =~ s/\$//og;
+	$copy->deposit_amount($d);
+}
+
+sub create_copy {
+	my($class, $editor, $vol, $copy) = @_;
+
+	my $existing = $editor->search_asset_copy(
+		{ barcode => $copy->barcode, deleted => 'f' } );
+	
+	return OpenILS::Event->new('ITEM_BARCODE_EXISTS') if @$existing;
+
+   # see if the volume this copy references is marked as deleted
+    return OpenILS::Event->new('VOLUME_DELETED', vol => $vol->id) 
+        if $U->is_true($vol->deleted);
+
+	my $evt;
+	my $org = (ref $copy->circ_lib) ? $copy->circ_lib->id : $copy->circ_lib;
+	return $evt if ($evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $org));
+
+	$copy->clear_id;
+	$copy->editor($editor->requestor->id);
+	$copy->creator($editor->requestor->id);
+	$copy->create_date('now');
+    $copy->call_number($vol->id);
+	$class->fix_copy_price($copy);
+
+	$editor->create_asset_copy($copy) or return $editor->die_event;
+	return undef;
+}
+
+
+# if 'delete_stats' is true, the copy->stat_cat_entries data is 
+# treated as the authoritative list for the copy. existing entries
+# that are not in said list will be deleted from the DB
+sub update_copy_stat_entries {
+	my($class, $editor, $copy, $delete_stats) = @_;
+
+	return undef if $copy->isdeleted;
+	return undef unless $copy->ischanged or $copy->isnew;
+
+	my $evt;
+	my $entries = $copy->stat_cat_entries;
+
+	if( $delete_stats ) {
+		$entries = ($entries and @$entries) ? $entries : [];
+	} else {
+		return undef unless ($entries and @$entries);
+	}
+
+	my $maps = $editor->search_asset_stat_cat_entry_copy_map({owning_copy=>$copy->id});
+
+	if(!$copy->isnew) {
+		# if there is no stat cat entry on the copy who's id matches the
+		# current map's id, remove the map from the database
+		for my $map (@$maps) {
+			if(! grep { $_->id == $map->stat_cat_entry } @$entries ) {
+
+				$logger->info("copy update found stale ".
+					"stat cat entry map ".$map->id. " on copy ".$copy->id);
+
+				$editor->delete_asset_stat_cat_entry_copy_map($map)
+					or return $editor->event;
+			}
+		}
+	}
+
+	# go through the stat cat update/create process
+	for my $entry (@$entries) { 
+		next unless $entry;
+
+		# if this link already exists in the DB, don't attempt to re-create it
+		next if( grep{$_->stat_cat_entry == $entry->id} @$maps );
+	
+		my $new_map = Fieldmapper::asset::stat_cat_entry_copy_map->new();
+
+		my $sc = ref($entry->stat_cat) ? $entry->stat_cat->id : $entry->stat_cat;
+		
+		$new_map->stat_cat( $sc );
+		$new_map->stat_cat_entry( $entry->id );
+		$new_map->owning_copy( $copy->id );
+
+		$editor->create_asset_stat_cat_entry_copy_map($new_map)
+			or return $editor->event;
+
+		$logger->info("copy update created new stat cat entry map ".$editor->data);
+	}
+
+	return undef;
+}
+
+
+sub update_copy {
+	my($class, $editor, $override, $vol, $copy, $retarget_holds, $force_delete_empty_bib) = @_;
+
+	my $evt;
+	my $org = (ref $copy->circ_lib) ? $copy->circ_lib->id : $copy->circ_lib;
+	return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $org) );
+
+	$logger->info("vol-update: updating copy ".$copy->id);
+	my $orig_copy = $editor->retrieve_asset_copy($copy->id);
+	my $orig_vol  = $editor->retrieve_asset_call_number($copy->call_number);
+
+	$copy->editor($editor->requestor->id);
+	$copy->edit_date('now');
+
+	$copy->age_protect( $copy->age_protect->id )
+		if ref $copy->age_protect;
+
+	$class->fix_copy_price($copy);
+    $class->check_hold_retarget($editor, $copy, $orig_copy, $retarget_holds);
+
+	return $editor->event unless $editor->update_asset_copy($copy);
+	return $class->remove_empty_objects($editor, $override, $orig_vol, $force_delete_empty_bib);
+}
+
+sub check_hold_retarget {
+    my($class, $editor, $copy, $orig_copy, $retarget_holds) = @_;
+    return unless $retarget_holds;
+
+    if( !($copy->isdeleted or $U->is_true($copy->deleted)) ) {
+        # see if a status change warrants a retarget
+
+        $orig_copy = $editor->retrieve_asset_copy($copy->id) unless $orig_copy;
+
+        if($orig_copy->status == $copy->status) {
+            # no status change, no retarget
+            return;
+        }
+
+        my $stat = $editor->retrieve_config_copy_status($copy->status);
+
+        # new status is holdable, no retarget. Later add logic to find potential 
+        # holds and retarget those to pick up the newly available copy
+        return if $U->is_true($stat->holdable); 
+    }
+
+    my $hold_ids = $editor->search_action_hold_request(
+        {   current_copy        => $copy->id, 
+            cancel_time         => undef, 
+            fulfillment_time    => undef 
+        }, {idlist => 1}
+    );
+
+    push(@$retarget_holds, @$hold_ids);
+}
+
+
+# this does the actual work
+sub update_fleshed_copies {
+	my($class, $editor, $override, $vol, $copies, $delete_stats, $retarget_holds, $force_delete_empty_bib) = @_;
+
+	my $evt;
+	my $fetchvol = ($vol) ? 0 : 1;
+
+	my %cache;
+	$cache{$vol->id} = $vol if $vol;
+
+	for my $copy (@$copies) {
+
+		my $copyid = $copy->id;
+		$logger->info("vol-update: inspecting copy $copyid");
+
+		if( !($vol = $cache{$copy->call_number}) ) {
+			$vol = $cache{$copy->call_number} = 
+				$editor->retrieve_asset_call_number($copy->call_number);
+			return $editor->event unless $vol;
+		}
+
+		return $editor->event unless 
+			$editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy));
+
+		$copy->editor($editor->requestor->id);
+		$copy->edit_date('now');
+
+		$copy->status( $copy->status->id ) if ref($copy->status);
+		$copy->location( $copy->location->id ) if ref($copy->location);
+		$copy->circ_lib( $copy->circ_lib->id ) if ref($copy->circ_lib);
+		
+		my $sc_entries = $copy->stat_cat_entries;
+		$copy->clear_stat_cat_entries;
+
+		if( $copy->isdeleted ) {
+			$evt = $class->delete_copy($editor, $override, $vol, $copy, $retarget_holds, $force_delete_empty_bib);
+			return $evt if $evt;
+
+		} elsif( $copy->isnew ) {
+			$evt = $class->create_copy( $editor, $vol, $copy );
+			return $evt if $evt;
+
+		} elsif( $copy->ischanged ) {
+
+			$evt = $class->update_copy( $editor, $override, $vol, $copy, $retarget_holds, $force_delete_empty_bib);
+			return $evt if $evt;
+		}
+
+		$copy->stat_cat_entries( $sc_entries );
+		$evt = $class->update_copy_stat_entries($editor, $copy, $delete_stats);
+		return $evt if $evt;
+	}
+
+	$logger->debug("vol-update: done updating copy batch");
+
+	return undef;
+}
+
+
+sub delete_copy {
+	my($class, $editor, $override, $vol, $copy, $retarget_holds, $force_delete_empty_bib) = @_;
+
+   return $editor->event unless 
+      $editor->allowed('DELETE_COPY', $class->copy_perm_org($vol, $copy));
+
+	my $stat = $U->copy_status($copy->status)->id;
+
+	unless($override) {
+		return OpenILS::Event->new('COPY_DELETE_WARNING', payload => $copy->id )
+			if $stat == OILS_COPY_STATUS_CHECKED_OUT or
+				$stat == OILS_COPY_STATUS_IN_TRANSIT or
+				$stat == OILS_COPY_STATUS_ON_HOLDS_SHELF or
+				$stat == OILS_COPY_STATUS_ILL;
+	}
+
+	$logger->info("vol-update: deleting copy ".$copy->id);
+	$copy->deleted('t');
+
+	$copy->editor($editor->requestor->id);
+	$copy->edit_date('now');
+	$editor->update_asset_copy($copy) or return $editor->event;
+
+	# Delete any open transits for this copy
+	my $transits = $editor->search_action_transit_copy(
+		{ target_copy=>$copy->id, dest_recv_time => undef } );
+
+	for my $t (@$transits) {
+		$editor->delete_action_transit_copy($t)
+			or return $editor->event;
+	}
+
+    $class->check_hold_retarget($editor, $copy, undef, $retarget_holds);
+
+	return $class->remove_empty_objects($editor, $override, $vol, $force_delete_empty_bib);
+}
+
+
+
+sub create_volume {
+	my($class, $override, $editor, $vol) = @_;
+	my $evt;
+
+	return $evt if ( $evt = $class->org_cannot_have_vols($editor, $vol->owning_lib) );
+
+   # see if the record this volume references is marked as deleted
+   my $rec = $editor->retrieve_biblio_record_entry($vol->record)
+      or return $editor->die_event;
+   return OpenILS::Event->new('BIB_RECORD_DELETED', rec => $rec->id) 
+      if $U->is_true($rec->deleted);
+
+	# first lets see if there are any collisions
+	my $vols = $editor->search_asset_call_number( { 
+			owning_lib	=> $vol->owning_lib,
+			record		=> $vol->record,
+			label			=> $vol->label,
+			deleted		=> 'f'
+		}
+	);
+
+	my $label = undef;
+	if(@$vols) {
+      # we've found an exising volume
+		if($override) { 
+			$label = $vol->label;
+		} else {
+			return OpenILS::Event->new(
+				'VOLUME_LABEL_EXISTS', payload => $vol->id);
+		}
+	}
+
+	# create a temp label so we can create the new volume, 
+    # then de-dup it with the existing volume
+	$vol->label( "__SYSTEM_TMP_$$".time) if $label;
+
+	$vol->creator($editor->requestor->id);
+	$vol->create_date('now');
+	$vol->editor($editor->requestor->id);
+	$vol->edit_date('now');
+	$vol->clear_id;
+
+	$editor->create_asset_call_number($vol) or return $editor->die_event;
+
+	if($label) {
+		# now restore the label and merge into the existing record
+		$vol->label($label);
+		(undef, $evt) = 
+			OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $$vols[0]);
+		return $evt if $evt;
+	}
+
+	return undef;
+}
+
+# returns the volume if it exists
+sub volume_exists {
+    my($class, $e, $rec_id, $label, $owning_lib) = @_;
+    return $e->search_asset_call_number(
+        {label => $label, record => $rec_id, owning_lib => $owning_lib, deleted => 'f'})->[0];
+}
+
+sub find_or_create_volume {
+	my($class, $e, $label, $record_id, $org_id) = @_;
+
+    my $vol;
+
+    if($record_id == OILS_PRECAT_RECORD) {
+        $vol = $e->retrieve_asset_call_number(OILS_PRECAT_CALL_NUMBER)
+            or return (undef, $e->die_event);
+
+    } else {
+        $vol = $class->volume_exists($e, $record_id, $label, $org_id);
+    }
+
+	# If the volume exists, return the ID
+    return ($vol, undef, 1) if $vol;
+
+	# -----------------------------------------------------------------
+	# Otherwise, create a new volume with the given attributes
+	# -----------------------------------------------------------------
+	return (undef, $e->die_event) unless $e->allowed('UPDATE_VOLUME', $org_id);
+
+	$vol = Fieldmapper::asset::call_number->new;
+	$vol->owning_lib($org_id);
+	$vol->label($label);
+	$vol->record($record_id);
+
+    my $evt = OpenILS::Application::Cat::AssetCommon->create_volume(0, $e, $vol);
+    return (undef, $evt) if $evt;
+
+	return ($vol);
+}
+
+
+sub create_copy_note {
+    my($class, $e, $copy, $title, $value, $pub) = @_;
+    my $note = Fieldmapper::asset::copy_note->new;
+    $note->owning_copy($copy->id);
+    $note->creator($e->requestor->id);
+    $note->pub('t');
+    $note->value($value);
+    $note->title($title);
+    $e->create_asset_copy_note($note) or return $e->die_event;
+    return undef;
+}
+
+
+sub remove_empty_objects {
+	my($class, $editor, $override, $vol, $force_delete_empty_bib) = @_; 
+
+    my $koe = $U->ou_ancestor_setting_value(
+        $editor->requestor->ws_ou, 'cat.bib.keep_on_empty', $editor);
+    my $aoe =  $U->ou_ancestor_setting_value(
+        $editor->requestor->ws_ou, 'cat.bib.alert_on_empty', $editor);
+
+	if( OpenILS::Application::Cat::BibCommon->title_is_empty($editor, $vol->record, $vol->id) ) {
+
+        # delete this volume if it's not already marked as deleted
+        unless( $U->is_true($vol->deleted) || $vol->isdeleted ) {
+            $vol->deleted('t');
+            $vol->editor($editor->requestor->id);
+            $vol->edit_date('now');
+            $editor->update_asset_call_number($vol) or return $editor->event;
+        }
+
+        return OpenILS::Event->new('TITLE_LAST_COPY', payload => $vol->record ) 
+            if $aoe and not $override and not $force_delete_empty_bib;
+
+        unless($koe and not $force_delete_empty_bib) {
+            # delete the bib record if the keep-on-empty setting is not set (and we're not otherwise forcing things, say through acq settings)
+            my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($editor, $vol->record);
+            return $evt if $evt;
+        }
+	}
+
+	return undef;
+}
+
+
+sub copy_perm_org {
+	my($class, $vol, $copy) = @_;
+	my $org = $vol->owning_lib;
+	if( $vol->id == OILS_PRECAT_CALL_NUMBER ) {
+		$org = ref($copy->circ_lib) ? $copy->circ_lib->id : $copy->circ_lib;
+	}
+	$logger->debug("using copy perm org $org");
+	return $org;
+}
+
+
+sub set_item_lost {
+    my($class, $e, $copy_id) = @_;
+
+    my $copy = $e->retrieve_asset_copy([
+        $copy_id, 
+        {flesh => 1, flesh_fields => {'acp' => ['call_number']}}])
+            or return $e->die_event;
+
+    my $owning_lib = 
+        ($copy->call_number->id == OILS_PRECAT_CALL_NUMBER) ? 
+            $copy->circ_lib : $copy->call_number->owning_lib;
+
+    my $circ = $e->search_action_circulation(
+        {checkin_time => undef, target_copy => $copy->id} )->[0]
+            or return $e->die_event;
+
+    $e->allowed('SET_CIRC_LOST', $circ->circ_lib) or return $e->die_event;
+
+    return $e->die_event(OpenILS::Event->new('COPY_MARKED_LOST'))
+	    if $copy->status == OILS_COPY_STATUS_LOST;
+
+    # ---------------------------------------------------------------------
+    # fetch the related org settings
+    my $proc_fee = $U->ou_ancestor_setting_value(
+        $owning_lib, OILS_SETTING_LOST_PROCESSING_FEE, $e) || 0;
+    my $void_overdue = $U->ou_ancestor_setting_value(
+        $owning_lib, OILS_SETTING_VOID_OVERDUE_ON_LOST, $e) || 0;
+
+    # ---------------------------------------------------------------------
+    # move the copy into LOST status
+    $copy->status(OILS_COPY_STATUS_LOST);
+    $copy->editor($e->requestor->id);
+    $copy->edit_date('now');
+    $e->update_asset_copy($copy) or return $e->die_event;
+
+    my $price = $U->get_copy_price($e, $copy, $copy->call_number);
+
+    if( $price > 0 ) {
+        my $evt = OpenILS::Application::Circ::CircCommon->create_bill(
+            $e, $price, 3, 'Lost Materials', $circ->id);
+        return $evt if $evt;
+    }
+
+    # ---------------------------------------------------------------------
+    # if there is a processing fee, charge that too
+    if( $proc_fee > 0 ) {
+        my $evt = OpenILS::Application::Circ::CircCommon->create_bill(
+            $e, $proc_fee, 4, 'Lost Materials Processing Fee', $circ->id);
+        return $evt if $evt;
+    }
+
+    # ---------------------------------------------------------------------
+    # mark the circ as lost and stop the fines
+    $circ->stop_fines(OILS_STOP_FINES_LOST);
+    $circ->stop_fines_time('now') unless $circ->stop_fines_time;
+    $e->update_action_circulation($circ) or return $e->die_event;
+
+    # ---------------------------------------------------------------------
+    # void all overdue fines on this circ if configured
+    if( $void_overdue ) {
+        my $evt = OpenILS::Application::Circ::CircCommon->void_overdues($e, $circ);
+        return $evt if $evt;
+    }
+
+    my $evt = OpenILS::Application::Circ::CircCommon->reopen_xact($e, $circ->id);
+    return $evt if $evt;
+
+    my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+    $ses->request('open-ils.trigger.event.autocreate', 'lost', $circ, $circ->circ_lib);
+
+    return undef;
+}
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/AuthCommon.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/AuthCommon.pm
new file mode 100644
index 0000000000..a8ef1f0bcb
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/AuthCommon.pm
@@ -0,0 +1,67 @@
+package OpenILS::Application::Cat::AuthCommon;
+use strict; use warnings;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenSRF::Utils::Logger qw($logger);
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Const qw/:const/;
+use OpenSRF::AppSession;
+use OpenILS::Event;
+my $U = 'OpenILS::Application::AppUtils';
+my $MARC_NAMESPACE = 'http://www.loc.gov/MARC21/slim';
+
+
+# ---------------------------------------------------------------------------
+# Shared authority mangling code.  Do not publish methods from here.
+# ---------------------------------------------------------------------------
+
+# generate a MARC XML document from a MARC XML string
+sub marc_xml_to_doc {
+	my $xml = shift;
+	my $marc_doc = XML::LibXML->new->parse_string($xml);
+	$marc_doc->documentElement->setNamespace($MARC_NAMESPACE, 'marc', 1);
+	$marc_doc->documentElement->setNamespace($MARC_NAMESPACE);
+	return $marc_doc;
+}
+
+
+sub import_authority_record {
+    my($class, $e, $marc_xml, $source) = @_;
+    
+    my $marc_doc = marc_xml_to_doc($marc_xml);
+    my $rec = Fieldmapper::authority::record_entry->new;
+	$rec->creator($e->requestor->id);
+	$rec->editor($e->requestor->id);
+	$rec->create_date('now');
+	$rec->edit_date('now');
+	$rec->marc($U->entityize($marc_doc->documentElement->toString));
+
+    $rec = $e->create_authority_record_entry($rec) or return $e->die_event;
+
+    # we don't care about the result, just fire off the request
+    #my $ses = OpenSRF::AppSession->create('open-ils.ingest');
+    #$ses->request('open-ils.ingest.full.authority.record', $recid);
+
+	return $rec;
+}
+
+
+sub overlay_authority_record {
+    my($class, $e, $rec_id, $marc_xml, $source) = @_;
+    
+    my $marc_doc = marc_xml_to_doc($marc_xml);
+    my $rec = $e->retrieve_authority_record_entry($rec_id) or return $e->die_event;
+	$rec->editor($e->requestor->id);
+	$rec->edit_date('now');
+	$rec->marc($U->entityize($marc_doc->documentElement->toString));
+
+    $rec = $e->update_authority_record_entry($rec) or return $e->die_event;
+
+    # we don't care about the result, just fire off the request
+    #my $ses = OpenSRF::AppSession->create('open-ils.ingest');
+    #$ses->request('open-ils.ingest.full.authority.record', $recid);
+
+	return $rec;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/Authority.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/Authority.pm
new file mode 100644
index 0000000000..1995edf887
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/Authority.pm
@@ -0,0 +1,229 @@
+package OpenILS::Application::Cat::Authority;
+use strict; use warnings;
+use base qw/OpenILS::Application/;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Application::Cat::AuthCommon;
+use OpenSRF::Utils::Logger qw($logger);
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Const qw/:const/;
+use OpenILS::Event;
+my $U = 'OpenILS::Application::AppUtils';
+my $MARC_NAMESPACE = 'http://www.loc.gov/MARC21/slim';
+
+
+# generate a MARC XML document from a MARC XML string
+sub marc_xml_to_doc {
+	my $xml = shift;
+	my $marc_doc = XML::LibXML->new->parse_string($xml);
+	$marc_doc->documentElement->setNamespace($MARC_NAMESPACE, 'marc', 1);
+	$marc_doc->documentElement->setNamespace($MARC_NAMESPACE);
+	return $marc_doc;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> 'import_authority_record',
+	api_name	=> 'open-ils.cat.authority.record.import',
+);
+
+sub import_authority_record {
+    my($self, $conn, $auth, $marc_xml, $source) = @_;
+	my $e = new_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('CREATE_AUTHORITY_RECORD');
+    my $rec = OpenILS::Application::Cat::AuthCommon->import_authority_record($marc_xml, $source);
+    $e->commit unless $U->event_code($rec);
+    return $rec;
+}
+
+__PACKAGE__->register_method(
+    method => 'create_authority_record_from_bib_field',
+    api_name => 'open-ils.cat.authority.record.create_from_bib',
+    signature => {
+        desc => q/Create an authority record entry from a field in a bibliographic record/,
+        params => q/
+            @param field A hash representing the field to control, consisting of: { tag: string, ind1: string, ind2: string, subfields: [ [code, value] ... ] }
+            @param identifier A MARC control number identifier
+            @param authtoken A valid authentication token
+            @returns The new record object 
+ /}
+);
+
+__PACKAGE__->register_method(
+    method => 'create_authority_record_from_bib_field',
+    api_name => 'open-ils.cat.authority.record.create_from_bib.readonly',
+    signature => {
+        desc => q/Creates MARCXML for an authority record entry from a field in a bibliographic record/,
+        params => q/
+            @param field A hash representing the field to control, consisting of: { tag: string, ind1: string, ind2: string, subfields: [ [code, value] ... ] }
+            @param identifier A MARC control number identifier
+            @returns The MARCXML for the authority record
+ /}
+);
+
+sub create_authority_record_from_bib_field {
+    my($self, $conn, $field, $cni, $auth) = @_;
+
+    # Control number identifier should have been passed in
+    if (!$cni) {
+        $cni = 'UNSET';
+    }
+
+    # Change the first character of the incoming bib field tag to a '1'
+    # for use in our authority record; close enough for now?
+    my $tag = $field->{'tag'};
+    $tag =~ s/^./1/;
+
+    my $ind1 = $field->{ind1} || ' ';
+    my $ind2 = $field->{ind2} || ' ';
+
+    my $control = qq{};
+    foreach my $sf (@{$field->{subfields}}) {
+        my $code = $sf->[0];
+        my $val = $U->entityize($sf->[1]);
+        $control .= qq{$val};
+    }
+    $control .= '';
+
+    # ARN, or "authority record number", used to need to be unique across the database.
+    # Of course, we have no idea what's in the database, and if the
+    # cat.maintain_control_numbers flag is set to "TRUE" then the 001 will
+    # be reset to the record ID anyway.
+    my $arn = 'AUTOGEN-' . time();
+
+    # Placeholder MARCXML; 
+    #   001/003 can be be properly filled in via database triggers
+    #   005 will be filled in automatically at creation time
+    #   008 needs to be set by a cataloguer (could be some OU settings, I suppose)
+    #   040 should come from OU settings / OU shortname
+    #   
+    my $marc_xml = <     nz  a22     o  4500
+$arn
+      ||||||||||||||||||||||||||||||||||
+$cni$cni
+$control
+
+MARCXML
+
+    if ($self->api_name =~ m/readonly$/) {
+        return $marc_xml;
+    } else {
+        my $e = new_editor(authtoken=>$auth, xact=>1);
+        return $e->die_event unless $e->checkauth;
+        return $e->die_event unless $e->allowed('CREATE_AUTHORITY_RECORD');
+        my $rec = OpenILS::Application::Cat::AuthCommon->import_authority_record($e, $marc_xml);
+        $e->commit unless $U->event_code($rec);
+        return $rec;
+    }
+}
+
+__PACKAGE__->register_method(
+	method	=> 'overlay_authority_record',
+	api_name	=> 'open-ils.cat.authority.record.overlay',
+);
+
+sub overlay_authority_record {
+    my($self, $conn, $auth, $rec_id, $marc_xml, $source) = @_;
+	my $e = new_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('UPDATE_AUTHORITY_RECORD');
+    my $rec = OpenILS::Application::Cat::AuthCommon->overlay_authority_record($rec_id, $marc_xml, $source);
+    $e->commit unless $U->event_code($rec);
+    return $rec;
+
+}
+
+__PACKAGE__->register_method(
+	method	=> 'retrieve_authority_record',
+	api_name	=> 'open-ils.cat.authority.record.retrieve',
+    signature => {
+        desc => q/Retrieve an authority record entry/,
+        params => [
+            {desc => q/hash of options.  Options include "clear_marc" which clears
+                the MARC xml from the record before it is returned/}
+        ]
+    }
+);
+sub retrieve_authority_record {
+    my($self, $conn, $auth, $rec_id, $options) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->die_event unless $e->checkauth;
+    my $rec = $e->retrieve_authority_record($rec_id) or return $e->event;
+    $rec->clear_marc if $$options{clear_marc};
+    return $rec;
+}
+
+__PACKAGE__->register_method(
+	method	=> 'batch_retrieve_authority_record',
+	api_name	=> 'open-ils.cat.authority.record.batch.retrieve',
+    stream => 1,
+    signature => {
+        desc => q/Retrieve a set of authority record entry objects/,
+        params => [
+            {desc => q/hash of options.  Options include "clear_marc" which clears
+                the MARC xml from the record before it is returned/}
+        ]
+    }
+);
+sub batch_retrieve_authority_record {
+    my($self, $conn, $auth, $rec_id_list, $options) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->die_event unless $e->checkauth;
+    for my $rec_id (@$rec_id_list) {
+        my $rec = $e->retrieve_authority_record($rec_id) or return $e->event;
+        $rec->clear_marc if $$options{clear_marc};
+        $conn->respond($rec);
+    }
+    return undef;
+}
+
+__PACKAGE__->register_method(
+    method    => 'count_linked_bibs',
+    api_name  => 'open-ils.cat.authority.records.count_linked_bibs',
+    signature => q/
+        Counts the number of bib records linked to each authority record in the input list
+        @param records Array of authority records to return counts
+        @return A list of hashes containing the authority record ID ("id") and linked bib count ("bibs")
+    /
+);
+
+sub count_linked_bibs {
+    my( $self, $conn, $records ) = @_;
+
+    my $editor = new_editor();
+
+    my $link_count;
+    my @clean_records;
+    for my $auth ( @$records ) {
+        # Protection against SQL injection? Might be overkill.
+        my $intauth = int($auth);
+        if ($intauth) {
+            push(@clean_records, $intauth);
+        }
+    }
+    return $link_count if !@clean_records;
+    
+    $link_count = $editor->json_query({
+        "select" => {
+            "abl" => [
+                {
+                    "column" => "authority"
+                },
+                {
+                    "alias" => "bibs",
+                    "transform" => "count",
+                    "column" => "bib",
+                    "aggregate" => 1
+                }
+            ]
+        },
+        "from" => "abl",
+        "where" => { "authority" => \@clean_records }
+    });
+
+    return $link_count;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/BibCommon.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/BibCommon.pm
new file mode 100644
index 0000000000..4d928a86a3
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/BibCommon.pm
@@ -0,0 +1,377 @@
+package OpenILS::Application::Cat::BibCommon;
+use strict; use warnings;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenSRF::Utils::Logger qw($logger);
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Const qw/:const/;
+use OpenSRF::AppSession;
+use OpenILS::Event;
+my $U = 'OpenILS::Application::AppUtils';
+my $MARC_NAMESPACE = 'http://www.loc.gov/MARC21/slim';
+
+
+# ---------------------------------------------------------------------------
+# Shared bib mangling code.  Do not publish methods from here.
+# ---------------------------------------------------------------------------
+
+my $__bib_sources;
+sub bib_source_from_name {
+	my $name = shift;
+	$logger->debug("searching for bib source: $name");
+
+	fetch_bib_sources();
+
+	my ($s) = grep { lc($_->source) eq lc($name) } @$__bib_sources;
+
+	return $s->id if $s;
+	return undef;
+}
+
+sub fetch_bib_sources {
+	$__bib_sources = new_editor()->retrieve_all_config_bib_source()
+		unless $__bib_sources;
+	return $__bib_sources;
+}
+
+
+sub biblio_record_replace_marc  {
+	my($class, $e, $recid, $newxml, $source, $fixtcn, $override) = @_;
+
+	my $rec = $e->retrieve_biblio_record_entry($recid)
+		or return $e->die_event;
+
+    # See if there is a different record in the database that has our TCN value
+    # If we're not updating the TCN, all we care about it the marcdoc
+    # XXX should .update even bother with the tcn_info if it's not going to replace it?
+    # there is the potential for returning a TCN_EXISTS event, even though no replacement happens
+
+	my( $tcn, $tsource, $marcdoc, $evt);
+
+    if($fixtcn or $override) {
+
+	    ($tcn, $tsource, $marcdoc, $evt) = 
+		    _find_tcn_info($e, $newxml, $override, $recid);
+
+	    return $evt if $evt;
+
+		$rec->tcn_value($tcn) if ($tcn);
+		$rec->tcn_source($tsource);
+
+    } else {
+
+        $marcdoc = __make_marc_doc($newxml);
+    }
+
+
+	$rec->source(bib_source_from_name($source)) if $source;
+	$rec->editor($e->requestor->id);
+	$rec->edit_date('now');
+	$rec->marc( $U->entityize( $marcdoc->documentElement->toString ) );
+	$e->update_biblio_record_entry($rec) or return $e->die_event;
+
+	return $rec;
+}
+
+sub biblio_record_xml_import {
+	my($class, $e, $xml, $source, $auto_tcn, $override) = @_;
+
+	my( $evt, $tcn, $tcn_source, $marcdoc );
+
+    my $use_id = $e->retrieve_config_global_flag('cat.bib.use_id_for_tcn');
+    $use_id = ($use_id and $U->is_true($use_id->enabled));
+
+	if( $auto_tcn or $use_id ) {
+		# auto_tcn forces a blank TCN value so the DB will have to generate one for us
+		$marcdoc = __make_marc_doc($xml);
+	} else {
+		( $tcn, $tcn_source, $marcdoc, $evt ) = _find_tcn_info($e, $xml, $override);
+		return $evt if $evt;
+	}
+
+	# Silence warnings when _find_tcn_info() fails
+	$tcn ||= '';
+	$tcn_source ||= '';
+	$logger->info("user ".$e->requestor->id.
+		" creating new biblio entry with tcn=$tcn and tcn_source $tcn_source");
+
+	my $record = Fieldmapper::biblio::record_entry->new;
+
+	$record->source(bib_source_from_name($source)) if $source;
+	$record->tcn_source($tcn_source);
+	$record->tcn_value($tcn) if ($tcn);
+	$record->creator($e->requestor->id);
+	$record->editor($e->requestor->id);
+	$record->create_date('now');
+	$record->edit_date('now');
+	$record->marc($U->entityize($marcdoc->documentElement->toString));
+
+    $record = $e->create_biblio_record_entry($record) or return $e->die_event;
+
+    if($use_id) {
+        my $existing = $e->search_biblio_record_entry(
+            {   
+                tcn_value => $record->id,
+                deleted => 'f'
+            }, { 
+                idlist => 1 
+            }
+        );
+
+        if(@$existing) {
+            # leave the auto-generated tcn_value in place
+            $logger->warn("Collision using internal ID as tcn_value for record " . $record->id);
+        } else {
+            $record->tcn_value($record->id);
+            $e->update_biblio_record_entry($record) or return $e->die_event;
+        }
+    }
+
+	$logger->info("marc create/import created new record ".$record->id);
+	return $record;
+}
+
+sub __make_marc_doc {
+	my $xml = shift;
+	my $marcxml = XML::LibXML->new->parse_string($xml);
+	$marcxml->documentElement->setNamespace($MARC_NAMESPACE, "marc", 1 );
+	$marcxml->documentElement->setNamespace($MARC_NAMESPACE);
+	__remove_empty_marc_nodes($marcxml);
+	return $marcxml;
+}
+
+# remove empty control fields, subfields, and variable data fields, which
+# can creep in via less-than-correct imported MARC records or issues
+# with templates
+sub __remove_empty_marc_nodes {
+	my $marcxml = shift;
+
+	__remove_if_childless($_) foreach $marcxml->documentElement->getElementsByTagNameNS($MARC_NAMESPACE, 'controlfield');
+	__remove_if_childless($_) foreach $marcxml->documentElement->getElementsByTagNameNS($MARC_NAMESPACE, 'subfield');
+	__remove_if_childless($_) foreach $marcxml->documentElement->getElementsByTagNameNS($MARC_NAMESPACE, 'datafield');
+}
+
+sub __remove_if_childless {
+	my $node = shift;
+	my @children = $node->childNodes();
+	my $has_nonblank_children = 0;
+	# can do this more concisely by requiring XML::LibXML >= 1.70 and using nonBlankChildNodes()
+	foreach my $node ($node->childNodes()) {
+		if ($node->nodeType != XML::LibXML::XML_TEXT_NODE || $node->nodeValue !~ /^\s*$/) {
+			$has_nonblank_children = 1;
+			last;
+		}
+	}
+	$node->parentNode->removeChild($node) unless $has_nonblank_children;
+}
+
+sub _find_tcn_info { 
+	my $editor		= shift;
+	my $xml			= shift;
+	my $override	= shift;
+	my $existing_rec	= shift || 0;
+
+	# parse the XML
+	my $marcxml = __make_marc_doc($xml);
+
+	my $xpath = '//marc:controlfield[@tag="001"]';
+	my $tcn = $marcxml->documentElement->findvalue($xpath);
+	$logger->info("biblio import located 001 (tcn) value of $tcn");
+
+	$xpath = '//marc:controlfield[@tag="003"]';
+	my $tcn_source = $marcxml->documentElement->findvalue($xpath) || "System Local";
+
+	if(my $rec = _tcn_exists($editor, $tcn, $tcn_source, $existing_rec) ) {
+
+		my $origtcn = $tcn;
+		$tcn = find_free_tcn( $marcxml, $editor, $existing_rec );
+
+		# if we're overriding, try to find a different TCN to use
+		if( $override ) {
+
+         # XXX Create ALLOW_ALT_TCN permission check support 
+
+			$logger->info("tcn value $tcn already exists, attempting to override");
+
+			if(!$tcn) {
+				return ( 
+					undef, 
+					undef, 
+					undef,
+					OpenILS::Event->new(
+						'OPEN_TCN_NOT_FOUND', 
+							payload => $marcxml->toString())
+					);
+			}
+
+		} else {
+
+			$logger->warn("tcn value $origtcn already exists in import/create");
+
+			# otherwise, return event
+			return ( 
+				undef, 
+				undef, 
+				undef,
+				OpenILS::Event->new( 
+					'TCN_EXISTS', payload => { 
+						dup_record	=> $rec, 
+						tcn			=> $origtcn,
+						new_tcn		=> $tcn
+						}
+					)
+				);
+		}
+	}
+
+	return ($tcn, $tcn_source, $marcxml);
+}
+
+sub find_free_tcn {
+
+	my $marcxml = shift;
+	my $editor = shift;
+	my $existing_rec = shift;
+
+	my $xpath = '//marc:datafield[@tag="901"]/marc:subfield[@code="a"]';
+	my ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
+
+    if (!$tcn) {
+	    $xpath = '//marc:datafield[@tag="039"]/marc:subfield[@code="a"]';
+	    ($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
+    }
+
+	$xpath = '//marc:datafield[@tag="901"]/marc:subfield[@code="b"]';
+	my ($tcn_source) = $marcxml->documentElement->findvalue($xpath);
+    if (!$tcn_source) {
+	    $xpath = '//marc:datafield[@tag="039"]/marc:subfield[@code="b"]';
+    	$tcn_source = $marcxml->documentElement->findvalue($xpath) || "System Local";
+    }
+
+	if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {
+		$tcn = undef;
+	}
+
+
+	if(!$tcn) {
+		$xpath = '//marc:datafield[@tag="020"]/marc:subfield[@code="a"]';
+		($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
+		$tcn_source = "ISBN";
+		if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
+	}
+
+	if(!$tcn) { 
+		$xpath = '//marc:datafield[@tag="022"]/marc:subfield[@code="a"]';
+		($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
+		$tcn_source = "ISSN";
+		if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
+	}
+
+	if(!$tcn) {
+		$xpath = '//marc:datafield[@tag="010"]';
+		($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
+		$tcn_source = "LCCN";
+		if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
+	}
+
+	if(!$tcn) {
+		$xpath = '//marc:datafield[@tag="035"]/marc:subfield[@code="a"]';
+		($tcn) = $marcxml->documentElement->findvalue($xpath) =~ /(\w+)\s*$/o;
+		$tcn_source = "System Legacy";
+		if(_tcn_exists($editor, $tcn, $tcn_source, $existing_rec)) {$tcn = undef;}
+
+		if($tcn) {
+			$marcxml->documentElement->removeChild(
+				$marcxml->documentElement->findnodes( '//marc:datafield[@tag="035"]' )
+			);
+		}
+	}
+
+	return undef unless $tcn;
+	return $tcn;
+}
+
+
+
+sub _tcn_exists {
+	my $editor = shift;
+	my $tcn = shift;
+	my $source = shift;
+	my $existing_rec = shift || 0;
+
+	if(!$tcn) {return 0;}
+
+	$logger->debug("tcn_exists search for tcn $tcn and source $source and id $existing_rec");
+
+	# XXX why does the source matter?
+#	my $req = $session->request(      
+#		{ tcn_value => $tcn, tcn_source => $source, deleted => 'f' } );
+
+    my $recs = $editor->search_biblio_record_entry(
+        {tcn_value => $tcn, deleted => 'f', id => {'!=' => $existing_rec}}, {idlist =>1});
+
+	if(@$recs) {
+		$logger->debug("_tcn_exists is true for tcn : $tcn ($source)");
+		return $recs->[0];
+	}
+
+	$logger->debug("_tcn_exists is false for tcn : $tcn ($source)");
+	return 0;
+}
+
+
+sub delete_rec {
+   my($class, $editor, $rec_id ) = @_;
+
+   my $rec = $editor->retrieve_biblio_record_entry($rec_id)
+      or return $editor->event;
+
+   return undef if $U->is_true($rec->deleted);
+   
+   $rec->deleted('t');
+   $rec->active('f');
+   $rec->editor( $editor->requestor->id );
+   $rec->edit_date('now');
+
+   # Set the leader/05 to indicate that the record has been deleted
+   my $marc = $rec->marc();
+   $marc =~ s{(.{5}).}{$1d};
+   $rec->marc($marc);
+
+   $editor->update_biblio_record_entry($rec) or return $editor->event;
+
+   return undef;
+}
+
+
+# ---------------------------------------------------------------------------
+# returns true if the given title (id) has no un-deleted volumes or 
+# copies attached.  If a context volume is defined, a record
+# is considered empty only if the context volume is the only
+# remaining volume on the record.  
+# ---------------------------------------------------------------------------
+sub title_is_empty {
+	my($class, $editor, $rid, $vol_id) = @_;
+
+	return 0 if $rid == OILS_PRECAT_RECORD;
+
+	my $cnlist = $editor->search_asset_call_number(
+		{ record => $rid, deleted => 'f' }, { idlist => 1 } );
+
+	return 1 unless @$cnlist; # no attached volumes
+    return 0 if @$cnlist > 1; # multiple attached volumes
+    return 0 unless $$cnlist[0] == $vol_id; # attached volume is not the context vol.
+
+    # see if the sole remaining context volume has any attached copies
+	for my $cn (@$cnlist) {
+		my $copylist = $editor->search_asset_copy(
+			[
+				{ call_number => $cn, deleted => 'f' }, 
+				{ limit => 1 },
+			], { idlist => 1 });
+		return 0 if @$copylist; # false if we find any copies
+	}
+
+	return 1;
+}
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/Merge.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/Merge.pm
new file mode 100644
index 0000000000..b354df6aac
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/Merge.pm
@@ -0,0 +1,260 @@
+use strict; use warnings;
+package OpenILS::Application::Cat::Merge;
+use base qw/OpenILS::Application/;
+use OpenSRF::Application;
+use OpenILS::Application::AppUtils;
+use OpenSRF::EX qw(:try);
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Event;
+use OpenSRF::Utils::Logger qw($logger);
+use Data::Dumper;
+my $U = "OpenILS::Application::AppUtils";
+
+my $storage;
+
+
+# removes items from an array and returns the removed items
+# example : my @d = rgrep(sub { $_ =~ /o/ }, \@a);
+# there's surely a smarter way to do this
+sub rgrep {
+   my( $sub, $arr ) = @_;
+   my @del;
+   for( my $i = 0; $i < @$arr; $i++ ) {
+      my $a = $$arr[$i];
+      local $_ = $a;
+      if($sub->()) {
+         splice(@$arr, $i--, 1);
+         push( @del, $a );
+      }
+   }
+   return @del;
+}
+
+
+
+# takes a master record and a list of 
+# sub-records to merge into the master record
+sub merge_records {
+	my( $editor, $master, $records ) = @_;
+
+    # bib records are global objects, so no org context required.
+    return (undef, $editor->die_event) 
+        unless $editor->allowed('MERGE_BIB_RECORDS');
+
+	my $vol;
+	my $evt;
+
+	my %r = map { $_ => 1 } ($master, @$records); # unique the ids
+	my @recs = keys %r;
+
+	my $reqr = $editor->requestor;
+	$logger->activity("merge: user ".$reqr->id." merging bib records: @recs with master = $master");
+
+	# -----------------------------------------------------------
+	# collect all of the volumes, merge any with duplicate 
+	# labels, then move all of the volumes to the master record
+	# -----------------------------------------------------------
+	my @volumes;
+	for (@recs) {
+		my $vs = $editor->search_asset_call_number({record => $_, deleted=>'f'});
+		push( @volumes, @$vs );
+	}
+
+	$logger->info("merge: merge recovered ".scalar(@volumes)." total volumes");
+
+	my @trimmed;
+	# de-duplicate any volumes with the same label and owning_lib
+
+	my %seen_vols;
+
+	for my $v (@volumes) {
+		my $l = $v->label;
+		my $o = $v->owning_lib;
+
+		if($seen_vols{$v->id}) {
+			$logger->debug("merge: skipping ".$v->id." since it's already been merged");
+			next;
+		}
+
+		$seen_vols{$v->id} = 1;
+
+		$logger->debug("merge: [".$v->id."] looking for dupes with label $l and owning_lib $o");
+
+		my @dups;
+		for my $vv (@volumes) {
+			if( $vv->label eq $v->label and $vv->owning_lib == $v->owning_lib ) {
+				$logger->debug("merge: pushing dupe volume ".$vv->id) if @dups;
+				push( @dups, $vv );
+				$seen_vols{$vv->id} = 1;
+			} 
+		}
+
+		if( @dups == 1 ) {
+			$logger->debug("merge: pushing unique volume into trimmed volume set: ".$v->id);
+			push( @trimmed, @dups );
+
+		} else {
+			my($vol, $e) = merge_volumes($editor, \@dups);
+			return $e if $e;
+			$logger->debug("merge: pushing vol-merged volume into trimmed volume set: ".$vol->id);
+			push(@trimmed, $vol);
+		}
+	}
+
+	my $s = 'merge: trimmed volume set contains the following vols: ';
+	$s .= 'id = '.$_->id .' : record = '.$_->record.' | ' for @trimmed;
+	$logger->debug($s);
+
+	# make all the volumes point to the master record
+	my $stat;
+	for $vol (@trimmed) {
+		if( $vol->record ne $master ) {
+
+			$logger->debug("merge: moving volume ".
+				$vol->id." from record ".$vol->record. " to $master");
+
+			$vol->editor( $editor->requestor->id );
+			$vol->edit_date('now');
+			$vol->record( $master );
+			$editor->update_asset_call_number($vol)
+				or return $editor->die_event;
+		}
+	}
+
+	# cycle through and delete the non-master records
+	for my $rec (@recs) {
+
+		my $record = $editor->retrieve_biblio_record_entry($rec)
+            or return $editor->die_event;
+
+		$logger->debug("merge: seeing if record $rec needs to be deleted or un-deleted");
+
+		if( $rec == $master ) {
+			# make sure the master record is not deleted
+			if( $U->is_true($record->deleted) ) {
+				$logger->info("merge: master record is marked as deleted...un-deleting.");
+				$record->deleted('f');
+				$record->editor($reqr->id);
+				$record->edit_date('now');
+				$editor->update_biblio_record_entry($record)
+					or return $editor->die_event;
+			}
+
+		} else {
+			$logger->info("merge: deleting record $rec");
+			$record->deleted('t');
+			$record->editor($reqr->id);
+			$record->edit_date('now');
+			$editor->update_biblio_record_entry($record)
+				or return $editor->die_event;
+		}
+	}
+
+	return undef;
+}
+
+
+
+# takes a list of volume objects, picks the volume with most
+# copies and moves all copies attached to the other volumes
+# into said volume.  all other volumes are deleted
+sub merge_volumes {
+	my( $editor, $volumes, $master ) = @_;
+	my %copies;
+	my $evt;
+
+	return ($$volumes[0]) if !$master and @$volumes == 1;
+
+	return ($$volumes[0]) if 
+		$master and @$volumes == 1 
+		and $master->id == $$volumes[0]->id;
+
+	$logger->debug("merge: fetching copies for volume list of size ".scalar(@$volumes));
+
+	# collect all of the copies attached to the selected volumes
+	for( @$volumes ) {
+		$copies{$_->id} = $editor->search_asset_copy({call_number=>$_->id, deleted=>'f'});
+		$logger->debug("merge: found ".scalar(@{$copies{$_->id}})." copies for volume ".$_->id);
+	}
+	
+	my $bigcn;
+	if( $master ) {
+
+		# the caller has chosen the master record
+		$bigcn = $master->id;
+		push( @$volumes, $master );
+
+	} else {
+
+		# find the CN with the most copies and make it the master CN
+		my $big = 0;
+		for my $cn (keys %copies) {
+			my $count = scalar(@{$copies{$cn}});
+			if( $count > $big ) {
+				$big = $count;
+				$bigcn = $cn;
+			}
+		}
+	}
+
+	$bigcn = $$volumes[0]->id unless $bigcn;
+
+	$logger->info("merge: merge using volume $bigcn as the master");
+
+	# now move all of the copies to the new volume
+	for my $cn (keys %copies) {
+		next if $cn == $bigcn;
+		for my $copy (@{$copies{$cn}}) {
+			$logger->debug("merge: setting call_number to $bigcn for copy ".$copy->id);
+			$copy->call_number($bigcn);
+			$copy->editor($editor->requestor->id);
+			$copy->edit_date('now');
+			$editor->update_asset_copy($copy) or return (undef, $editor->die_event);
+		}
+	}
+
+	for( @$volumes ) {
+		next if $_->id == $bigcn;
+		$logger->debug("merge: marking call_number as deleted: ".$_->id);
+		$_->deleted('t');
+		$_->editor($editor->requestor->id);
+		$_->edit_date('now');
+		$editor->update_asset_call_number($_) or return (undef, $editor->die_event);
+        merge_volume_holds($editor, $bigcn, $_->id);
+	}
+
+	my ($mvol) = grep { $_->id == $bigcn } @$volumes;
+	$logger->debug("merge: returning master volume ".$mvol->id);
+	return ($mvol);
+}
+
+sub merge_volume_holds {
+    my($e, $master_id, $vol_id) = @_;
+
+    my $holds = $e->search_action_hold_request(
+        {   cancel_time => undef, 
+            fulfillment_time => undef,
+            hold_type => 'V',
+            target => $vol_id
+        }
+    );
+
+    for my $hold (@$holds) {
+
+        $logger->info("Changing hold ".$hold->id.
+            " target from ".$hold->target." to $master_id in volume merge");
+
+        $hold->target($master_id);
+        unless($e->update_action_hold_request($hold)) {
+            my $evt = $e->event;
+            $logger->error("Error updating hold ". $evt->textcode .":". $evt->desc .":". $evt->stacktrace); 
+        }
+    }
+
+    return undef;
+}
+
+
+1;
+
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ.pm
new file mode 100644
index 0000000000..52e76bc900
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ.pm
@@ -0,0 +1,1862 @@
+package OpenILS::Application::Circ;
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+use OpenILS::Application::Circ::Circulate;
+use OpenILS::Application::Circ::Survey;
+use OpenILS::Application::Circ::StatCat;
+use OpenILS::Application::Circ::Holds;
+use OpenILS::Application::Circ::HoldNotify;
+use OpenILS::Application::Circ::CreditCard;
+use OpenILS::Application::Circ::Money;
+use OpenILS::Application::Circ::NonCat;
+use OpenILS::Application::Circ::CopyLocations;
+use OpenILS::Application::Circ::CircCommon;
+
+use DateTime;
+use DateTime::Format::ISO8601;
+
+use OpenILS::Application::AppUtils;
+
+use OpenSRF::Utils qw/:datetime/;
+use OpenSRF::AppSession;
+use OpenILS::Utils::ModsParser;
+use OpenILS::Event;
+use OpenSRF::EX qw(:try);
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::Editor;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Const qw/:const/;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Application::Cat::AssetCommon;
+
+my $apputils = "OpenILS::Application::AppUtils";
+my $U = $apputils;
+
+my $holdcode    = "OpenILS::Application::Circ::Holds";
+
+# ------------------------------------------------------------------------
+# Top level Circ package;
+# ------------------------------------------------------------------------
+
+sub initialize {
+	my $self = shift;
+	OpenILS::Application::Circ::Circulate->initialize();
+}
+
+
+__PACKAGE__->register_method(
+	method => 'retrieve_circ',
+	authoritative	=> 1,
+	api_name	=> 'open-ils.circ.retrieve',
+	signature => q/
+		Retrieve a circ object by id
+		@param authtoken Login session key
+		@pararm circid The id of the circ object
+	/
+);
+sub retrieve_circ {
+	my( $s, $c, $a, $i ) = @_;
+	my $e = new_editor(authtoken => $a);
+	return $e->event unless $e->checkauth;
+	my $circ = $e->retrieve_action_circulation($i) or return $e->event;
+	if( $e->requestor->id ne $circ->usr ) {
+		return $e->event unless $e->allowed('VIEW_CIRCULATIONS');
+	}
+	return $circ;
+}
+
+
+__PACKAGE__->register_method(
+	method => 'fetch_circ_mods',
+	api_name => 'open-ils.circ.circ_modifier.retrieve.all');
+sub fetch_circ_mods {
+    my($self, $conn, $args) = @_;
+    my $mods = new_editor()->retrieve_all_config_circ_modifier;
+    return [ map {$_->code} @$mods ] unless $$args{full};
+    return $mods;
+}
+
+__PACKAGE__->register_method(
+	method => 'fetch_bill_types',
+	api_name => 'open-ils.circ.billing_type.retrieve.all');
+sub fetch_bill_types {
+	my $conf = OpenSRF::Utils::SettingsClient->new;
+	return $conf->config_value(
+		'apps', 'open-ils.circ', 'app_settings', 'billing_types', 'type' );
+}
+
+
+__PACKAGE__->register_method(
+    method => 'ranged_billing_types',
+    api_name => 'open-ils.circ.billing_type.ranged.retrieve.all');
+
+sub ranged_billing_types {
+    my($self, $conn, $auth, $org_id, $depth) = @_;
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('VIEW_BILLING_TYPE', $org_id);
+    return $e->search_config_billing_type(
+        {owner => $U->get_org_full_path($org_id, $depth)});
+}
+
+
+
+# ------------------------------------------------------------------------
+# Returns an array of {circ, record} hashes checked out by the user.
+# ------------------------------------------------------------------------
+__PACKAGE__->register_method(
+	method	=> "checkouts_by_user",
+	api_name	=> "open-ils.circ.actor.user.checked_out",
+    stream => 1,
+	NOTES		=> <<"	NOTES");
+	Returns a list of open circulations as a pile of objects.  Each object
+	contains the relevant copy, circ, and record
+	NOTES
+
+sub checkouts_by_user {
+	my($self, $client, $auth, $user_id) = @_;
+
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+
+	my $circ_ids = $e->search_action_circulation(
+        {   usr => $user_id,
+            checkin_time => undef,
+            '-or' => [
+                {stop_fines => undef},
+                {stop_fines => ['MAXFINES','LONGOVERDUE']}
+            ]
+        },
+        {idlist => 1}
+    );
+
+    for my $id (@$circ_ids) {
+        my $circ = $e->retrieve_action_circulation([
+            $id,
+            {   flesh => 3,
+                flesh_fields => {
+                    circ => ['target_copy'],
+                    acp => ['call_number'],
+                    acn => ['record']
+                }
+            }
+        ]);
+
+        # un-flesh for consistency
+        my $c = $circ->target_copy;
+        $circ->target_copy($c->id);
+
+        my $cn = $c->call_number;
+        $c->call_number($cn->id);
+
+        my $t = $cn->record;
+        $cn->record($t->id);
+
+        $client->respond(
+            {   circ => $circ,
+                copy => $c,
+                record => $U->record_to_mvr($t)
+            }
+        );
+    }
+
+    return undef;
+}
+
+
+
+__PACKAGE__->register_method(
+	method	=> "checkouts_by_user_slim",
+	api_name	=> "open-ils.circ.actor.user.checked_out.slim",
+	NOTES		=> <<"	NOTES");
+	Returns a list of open circulation objects
+	NOTES
+
+# DEPRECAT ME?? XXX
+sub checkouts_by_user_slim {
+	my( $self, $client, $user_session, $user_id ) = @_;
+
+	my( $requestor, $target, $copy, $record, $evt );
+
+	( $requestor, $target, $evt ) = 
+		$apputils->checkses_requestor( $user_session, $user_id, 'VIEW_CIRCULATIONS');
+	return $evt if $evt;
+
+	$logger->debug( 'User ' . $requestor->id . 
+		" retrieving checked out items for user " . $target->id );
+
+	# XXX Make the call correct..
+	return $apputils->simplereq(
+		'open-ils.cstore',
+		"open-ils.cstore.direct.action.open_circulation.search.atomic", 
+		{ usr => $target->id, checkin_time => undef } );
+#		{ usr => $target->id } );
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "checkouts_by_user_opac",
+	api_name	=> "open-ils.circ.actor.user.checked_out.opac",);
+
+# XXX Deprecate Me
+sub checkouts_by_user_opac {
+	my( $self, $client, $auth, $user_id ) = @_;
+
+	my $e = OpenILS::Utils::Editor->new( authtoken => $auth );
+	return $e->event unless $e->checkauth;
+	$user_id ||= $e->requestor->id;
+	return $e->event unless 
+		my $patron = $e->retrieve_actor_user($user_id);
+
+	my $data;
+	my $search = {usr => $user_id, stop_fines => undef};
+
+	if( $user_id ne $e->requestor->id ) {
+		$data = $e->search_action_circulation(
+			$search, {checkperm=>1, permorg=>$patron->home_ou})
+			or return $e->event;
+
+	} else {
+		$data = $e->search_action_circulation($search);
+	}
+
+	return $data;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "title_from_transaction",
+	api_name	=> "open-ils.circ.circ_transaction.find_title",
+	NOTES		=> <<"	NOTES");
+	Returns a mods object for the title that is linked to from the 
+	copy from the hold that created the given transaction
+	NOTES
+
+sub title_from_transaction {
+	my( $self, $client, $login_session, $transactionid ) = @_;
+
+	my( $user, $circ, $title, $evt );
+
+	( $user, $evt ) = $apputils->checkses( $login_session );
+	return $evt if $evt;
+
+	( $circ, $evt ) = $apputils->fetch_circulation($transactionid);
+	return $evt if $evt;
+	
+	($title, $evt) = $apputils->fetch_record_by_copy($circ->target_copy);
+	return $evt if $evt;
+
+	return $apputils->record_to_mvr($title);
+}
+
+__PACKAGE__->register_method(
+	method	=> "staff_age_to_lost",
+	api_name	=> "open-ils.circ.circulation.age_to_lost",
+    stream => 1,
+	signature	=> q/
+        This fires a circ.staff_age_to_lost Action-Trigger event against all
+        overdue circulations in scope of the specified context library and
+        user profile, which effectively marks the associated items as Lost.
+        This is likely to be done at the end of a semester in an academic
+        library, etc.
+		@param auth
+		@param args : circ_lib, user_profile
+	/
+);
+
+sub staff_age_to_lost {
+    my( $self, $conn, $auth, $args ) = @_;
+
+    my $orgs = $U->get_org_descendants($args->{'circ_lib'});
+    my $profiles = $U->fetch_permission_group_descendants($args->{'user_profile'});
+
+    my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+
+    my $method = 'open-ils.trigger.passive.event.autocreate.batch';
+    my $hook = 'circ.staff_age_to_lost';
+    my $context_org = 'circ_lib';
+    my $opt_granularity = undef;
+    my $filter = { 
+        "checkin_time" => undef,
+        "due_date" => { "<" => "now" }, 
+        "-or" => [ 
+            { "stop_fines"  => ["MAXFINES", "LONGOVERDUE"] }, # FIXME: CLAIMSRETURNED also?
+            { "stop_fines"  => undef }
+        ],
+        "-and" => [
+            {"-exists" => {
+                "select" => {"au" => ["id"]},
+                "from"   => "au",
+                "where"  => {
+                    "profile" => $profiles,
+                    "id" => { "=" => {"+circ" => "usr"} }
+                }
+            }},
+            {"-exists" => {
+                "select" => {"aou" => ["id"]},
+                "from"   => "aou",
+                "where"  => {
+                    "-and" => [
+                        {"id" => { "=" => {"+circ" => "circ_lib"} }},
+                        {"id" => $orgs}
+                    ]
+                }
+            }}
+        ]
+    };
+    my $req_timeout = 10800;
+    my $chunk_size = 100;
+    my $progress = 1;
+
+    my $req = $ses->request($method, $hook, $context_org, $filter, $opt_granularity);
+    my @event_ids; my @chunked_ids;
+    while (my $resp = $req->recv(timeout => $req_timeout)) {
+        push(@event_ids, $resp->content);
+        push(@chunked_ids, $resp->content);
+        if (scalar(@chunked_ids) > $chunk_size) {
+            $conn->respond({'progress'=>$progress++}); # 'event_ids'=>@chunked_ids
+            @chunked_ids = ();
+        }
+    }
+    if (scalar(@chunked_ids) > 0) {
+        $conn->respond({'progress'=>$progress++}); # 'event_ids'=>@chunked_ids
+    }
+
+    if(@event_ids) {
+        $logger->info("staff_age_to_lost: created ".scalar(@event_ids)." events for circ.staff_age_to_lost");
+        $conn->respond_complete({'total_progress'=>$progress-1,'created'=>scalar(@event_ids)});
+    } elsif($req->complete) {
+        $logger->info("staff_age_to_lost: no events to create for circ.staff_age_to_lost");
+        $conn->respond_complete({'total_progress'=>$progress-1,'created'=>0});
+    } else {
+        $logger->warn("staff_age_to_lost: timeout occurred during event creation for circ.staff_age_to_lost");
+        $conn->respond_complete({'total_progress'=>$progress-1,'error'=>'timeout'});
+    }
+
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "new_set_circ_lost",
+	api_name	=> "open-ils.circ.circulation.set_lost",
+	signature	=> q/
+        Sets the copy and related open circulation to lost
+		@param auth
+		@param args : barcode
+	/
+);
+
+
+# ---------------------------------------------------------------------
+# Sets a circulation to lost.  updates copy status to lost
+# applies copy and/or prcoessing fees depending on org settings
+# ---------------------------------------------------------------------
+sub new_set_circ_lost {
+    my( $self, $conn, $auth, $args ) = @_;
+
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+
+    my $copy = $e->search_asset_copy({barcode=>$$args{barcode}, deleted=>'f'})->[0]
+        or return $e->die_event;
+
+    my $evt = OpenILS::Application::Cat::AssetCommon->set_item_lost($e, $copy->id);
+    return $evt if $evt;
+
+    $e->commit;
+    return 1;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "set_circ_claims_returned",
+	api_name	=> "open-ils.circ.circulation.set_claims_returned",
+	signature => {
+        desc => q/Sets the circ for a given item as claims returned
+                If a backdate is provided, overdue fines will be voided
+                back to the backdate/,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Arguments, including "barcode" and optional "backdate"', type => 'object'}
+        ],
+        return => {desc => q/1 on success, failure event on error, and 
+            PATRON_EXCEEDS_CLAIMS_RETURN_COUNT if the patron exceeds the 
+            configured claims return maximum/}
+    }
+);
+
+__PACKAGE__->register_method(
+	method	=> "set_circ_claims_returned",
+	api_name	=> "open-ils.circ.circulation.set_claims_returned.override",
+	signature => {
+        desc => q/This adds support for overrideing the configured max 
+                claims returned amount. 
+                @see open-ils.circ.circulation.set_claims_returned./,
+    }
+);
+
+sub set_circ_claims_returned {
+    my( $self, $conn, $auth, $args ) = @_;
+
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+
+    my $barcode = $$args{barcode};
+    my $backdate = $$args{backdate};
+
+    my $copy = $e->search_asset_copy({barcode=>$barcode, deleted=>'f'})->[0] 
+        or return $e->die_event;
+
+    my $circ = $e->search_action_circulation(
+        {checkin_time => undef, target_copy => $copy->id})->[0]
+            or return $e->die_event;
+
+    $backdate = $circ->due_date if $$args{use_due_date};
+
+    $logger->info("marking circ for item $barcode as claims returned".
+        (($backdate) ? " with backdate $backdate" : ''));
+
+    my $patron = $e->retrieve_actor_user($circ->usr);
+    my $max_count = $U->ou_ancestor_setting_value(
+        $circ->circ_lib, 'circ.max_patron_claim_return_count', $e);
+
+    # If the patron has too instances of many claims returned, 
+    # require an override to continue.  A configured max of 
+    # 0 means all attempts require an override
+    if(defined $max_count and $patron->claims_returned_count >= $max_count) {
+
+        if($self->api_name =~ /override/) {
+
+            # see if we're allowed to override
+            return $e->die_event unless 
+                $e->allowed('SET_CIRC_CLAIMS_RETURNED.override', $circ->circ_lib);
+
+        } else {
+
+            # exit early and return the max claims return event
+            $e->rollback;
+            return OpenILS::Event->new(
+                'PATRON_EXCEEDS_CLAIMS_RETURN_COUNT', 
+                payload => {
+                    patron_count => $patron->claims_returned_count,
+                    max_count => $max_count
+                }
+            );
+        }
+    }
+
+    $e->allowed('SET_CIRC_CLAIMS_RETURNED', $circ->circ_lib) 
+        or return $e->die_event;
+
+    $circ->stop_fines(OILS_STOP_FINES_CLAIMSRETURNED);
+	$circ->stop_fines_time('now') unless $circ->stop_fines_time;
+
+    if( $backdate ) {
+        $backdate = cleanse_ISO8601($backdate);
+
+        my $original_date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($circ->due_date));
+        my $new_date = DateTime::Format::ISO8601->new->parse_datetime($backdate);
+        $backdate = $new_date->ymd . 'T' . $original_date->strftime('%T%z');
+
+        # clean it up once again; need a : in the timezone offset. E.g. -06:00 not -0600
+        $backdate = cleanse_ISO8601($backdate);
+
+        # make it look like the circ stopped at the cliams returned time
+        $circ->stop_fines_time($backdate);
+        my $evt = OpenILS::Application::Circ::CircCommon->void_overdues($e, $circ, $backdate);
+        return $evt if $evt;
+    }
+
+    $e->update_action_circulation($circ) or return $e->die_event;
+
+    # see if there is a configured post-claims-return copy status
+    if(my $stat = $U->ou_ancestor_setting_value($circ->circ_lib, 'circ.claim_return.copy_status')) {
+	    $copy->status($stat);
+	    $copy->edit_date('now');
+	    $copy->editor($e->requestor->id);
+	    $e->update_asset_copy($copy) or return $e->die_event;
+    }
+
+    $e->commit;
+    return 1;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "post_checkin_backdate_circ",
+	api_name	=> "open-ils.circ.post_checkin_backdate",
+	signature => {
+        desc => q/Back-date an already checked in circulation/,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Circ ID', type => 'number'},
+            {desc => 'ISO8601 backdate', type => 'string'},
+        ],
+        return => {desc => q/1 on success, failure event on error/}
+    }
+);
+
+__PACKAGE__->register_method(
+	method	=> "post_checkin_backdate_circ",
+	api_name	=> "open-ils.circ.post_checkin_backdate.batch",
+    stream => 1,
+	signature => {
+        desc => q/@see open-ils.circ.post_checkin_backdate.  Batch mode/,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'List of Circ ID', type => 'array'},
+            {desc => 'ISO8601 backdate', type => 'string'},
+        ],
+        return => {desc => q/Set of: 1 on success, failure event on error/}
+    }
+);
+
+
+sub post_checkin_backdate_circ {
+    my( $self, $conn, $auth, $circ_id, $backdate ) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    if($self->api_name =~ /batch/) {
+        foreach my $c (@$circ_id) {
+            $conn->respond(post_checkin_backdate_circ_impl($e, $c, $backdate));
+        }
+    } else {
+        $conn->respond_complete(post_checkin_backdate_circ_impl($e, $circ_id, $backdate));
+    }
+
+    $e->disconnect;
+    return undef;
+}
+
+
+sub post_checkin_backdate_circ_impl {
+    my($e, $circ_id, $backdate) = @_;
+
+    $e->xact_begin;
+
+    my $circ = $e->retrieve_action_circulation($circ_id)
+        or return $e->die_event;
+
+    # anyone with checkin perms can backdate (more restrictive?)
+    return $e->die_event unless $e->allowed('COPY_CHECKIN', $circ->circ_lib);
+
+    # don't allow back-dating an open circulation
+    return OpenILS::Event->new('BAD_PARAMS') unless 
+        $backdate and $circ->checkin_time;
+
+    # update the checkin and stop_fines times to reflect the new backdate
+    $circ->stop_fines_time(cleanse_ISO8601($backdate));
+    $circ->checkin_time(cleanse_ISO8601($backdate));
+    $e->update_action_circulation($circ) or return $e->die_event;
+
+    # now void the overdues "erased" by the back-dating
+    my $evt = OpenILS::Application::Circ::CircCommon->void_overdues($e, $circ, $backdate);
+    return $evt if $evt;
+
+    # If the circ was closed before and the balance owned !=0, re-open the transaction
+    $evt = OpenILS::Application::Circ::CircCommon->reopen_xact($e, $circ->id);
+    return $evt if $evt;
+
+    $e->xact_commit;
+    return 1;
+}
+
+
+
+__PACKAGE__->register_method (
+	method		=> 'set_circ_due_date',
+	api_name		=> 'open-ils.circ.circulation.due_date.update',
+	signature	=> q/
+		Updates the due_date on the given circ
+		@param authtoken
+		@param circid The id of the circ to update
+		@param date The timestamp of the new due date
+	/
+);
+
+sub set_circ_due_date {
+	my( $self, $conn, $auth, $circ_id, $date ) = @_;
+
+    my $e = new_editor(xact=>1, authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+    my $circ = $e->retrieve_action_circulation($circ_id)
+        or return $e->die_event;
+
+    return $e->die_event unless $e->allowed('CIRC_OVERRIDE_DUE_DATE', $circ->circ_lib);
+	$date = cleanse_ISO8601($date);
+
+    if (!(interval_to_seconds($circ->duration) % 86400)) { # duration is divisible by days
+        my $original_date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($circ->due_date));
+        my $new_date = DateTime::Format::ISO8601->new->parse_datetime($date);
+        $date = cleanse_ISO8601( $new_date->ymd . 'T' . $original_date->strftime('%T%z') );
+    }
+
+	$circ->due_date($date);
+    $e->update_action_circulation($circ) or return $e->die_event;
+    $e->commit;
+
+    return $circ;
+}
+
+
+__PACKAGE__->register_method(
+	method		=> "create_in_house_use",
+	api_name		=> 'open-ils.circ.in_house_use.create',
+	signature	=>	q/
+		Creates an in-house use action.
+		@param $authtoken The login session key
+		@param params A hash of params including
+			'location' The org unit id where the in-house use occurs
+			'copyid' The copy in question
+			'count' The number of in-house uses to apply to this copy
+		@return An array of id's representing the id's of the newly created
+		in-house use objects or an event on an error
+	/);
+
+__PACKAGE__->register_method(
+	method		=> "create_in_house_use",
+	api_name		=> 'open-ils.circ.non_cat_in_house_use.create',
+);
+
+
+sub create_in_house_use {
+	my( $self, $client, $auth, $params ) = @_;
+
+	my( $evt, $copy );
+	my $org			= $params->{location};
+	my $copyid		= $params->{copyid};
+	my $count		= $params->{count} || 1;
+	my $nc_type		= $params->{non_cat_type};
+	my $use_time	= $params->{use_time} || 'now';
+
+	my $e = new_editor(xact=>1,authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('CREATE_IN_HOUSE_USE');
+
+	my $non_cat = 1 if $self->api_name =~ /non_cat/;
+
+	unless( $non_cat ) {
+		if( $copyid ) {
+			$copy = $e->retrieve_asset_copy($copyid) or return $e->event;
+		} else {
+			$copy = $e->search_asset_copy({barcode=>$params->{barcode}, deleted => 'f'})->[0]
+				or return $e->event;
+			$copyid = $copy->id;
+		}
+	}
+
+	if( $use_time ne 'now' ) {
+		$use_time = cleanse_ISO8601($use_time);
+		$logger->debug("in_house_use setting use time to $use_time");
+	}
+
+	my @ids;
+	for(1..$count) {
+
+		my $ihu;
+		my $method;
+		my $cmeth;
+
+		if($non_cat) {
+			$ihu = Fieldmapper::action::non_cat_in_house_use->new;
+			$ihu->item_type($nc_type);
+			$method = 'open-ils.storage.direct.action.non_cat_in_house_use.create';
+			$cmeth = "create_action_non_cat_in_house_use";
+
+		} else {
+			$ihu = Fieldmapper::action::in_house_use->new;
+			$ihu->item($copyid);
+			$method = 'open-ils.storage.direct.action.in_house_use.create';
+			$cmeth = "create_action_in_house_use";
+		}
+
+		$ihu->staff($e->requestor->id);
+		$ihu->org_unit($org);
+		$ihu->use_time($use_time);
+
+		$ihu = $e->$cmeth($ihu) or return $e->event;
+		push( @ids, $ihu->id );
+	}
+
+	$e->commit;
+	return \@ids;
+}
+
+
+
+
+
+__PACKAGE__->register_method(
+	method	=> "view_circs",
+	api_name	=> "open-ils.circ.copy_checkout_history.retrieve",
+	notes		=> q/
+		Retrieves the last X circs for a given copy
+		@param authtoken The login session key
+		@param copyid The copy to check
+		@param count How far to go back in the item history
+		@return An array of circ ids
+	/);
+
+# ----------------------------------------------------------------------
+# Returns $count most recent circs.  If count exceeds the configured 
+# max, use the configured max instead
+# ----------------------------------------------------------------------
+sub view_circs {
+	my( $self, $client, $authtoken, $copyid, $count ) = @_; 
+
+    my $e = new_editor(authtoken => $authtoken);
+    return $e->event unless $e->checkauth;
+    
+    my $copy = $e->retrieve_asset_copy([
+        $copyid,
+        {   flesh => 1,
+            flesh_fields => {acp => ['call_number']}
+        }
+    ]) or return $e->event;
+
+    return $e->event unless $e->allowed(
+        'VIEW_COPY_CHECKOUT_HISTORY', 
+        ($copy->call_number == OILS_PRECAT_CALL_NUMBER) ? 
+            $copy->circ_lib : $copy->call_number->owning_lib);
+        
+    my $max_history = $U->ou_ancestor_setting_value(
+        $e->requestor->ws_ou, 'circ.item_checkout_history.max', $e);
+
+    if(defined $max_history) {
+        $count = $max_history unless defined $count and $count < $max_history;
+    } else {
+        $count = 4 unless defined $count;
+    }
+
+    return $e->search_action_circulation([
+        {target_copy => $copyid}, 
+        {limit => $count, order_by => { circ => "xact_start DESC" }} 
+    ]);
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "circ_count",
+	api_name	=> "open-ils.circ.circulation.count",
+	notes		=> q/
+		Returns the number of times the item has circulated
+		@param copyid The copy to check
+	/);
+
+sub circ_count {
+	my( $self, $client, $copyid, $range ) = @_; 
+	my $e = OpenILS::Utils::Editor->new;
+	return $e->request('open-ils.storage.asset.copy.circ_count', $copyid, $range);
+}
+
+
+
+__PACKAGE__->register_method(
+	method		=> 'fetch_notes',
+	authoritative	=> 1,
+	api_name		=> 'open-ils.circ.copy_note.retrieve.all',
+	signature	=> q/
+		Returns an array of copy note objects.  
+		@param args A named hash of parameters including:
+			authtoken	: Required if viewing non-public notes
+			itemid		: The id of the item whose notes we want to retrieve
+			pub			: True if all the caller wants are public notes
+		@return An array of note objects
+	/);
+
+__PACKAGE__->register_method(
+	method		=> 'fetch_notes',
+	api_name		=> 'open-ils.circ.call_number_note.retrieve.all',
+	signature	=> q/@see open-ils.circ.copy_note.retrieve.all/);
+
+__PACKAGE__->register_method(
+	method		=> 'fetch_notes',
+	api_name		=> 'open-ils.circ.title_note.retrieve.all',
+	signature	=> q/@see open-ils.circ.copy_note.retrieve.all/);
+
+
+# NOTE: VIEW_COPY/VOLUME/TITLE_NOTES perms should always be global
+sub fetch_notes {
+	my( $self, $connection, $args ) = @_;
+
+	my $id = $$args{itemid};
+	my $authtoken = $$args{authtoken};
+	my( $r, $evt);
+
+	if( $self->api_name =~ /copy/ ) {
+		if( $$args{pub} ) {
+			return $U->cstorereq(
+				'open-ils.cstore.direct.asset.copy_note.search.atomic',
+				{ owning_copy => $id, pub => 't' } );
+		} else {
+			( $r, $evt ) = $U->checksesperm($authtoken, 'VIEW_COPY_NOTES');
+			return $evt if $evt;
+			return $U->cstorereq(
+				'open-ils.cstore.direct.asset.copy_note.search.atomic', {owning_copy => $id} );
+		}
+
+	} elsif( $self->api_name =~ /call_number/ ) {
+		if( $$args{pub} ) {
+			return $U->cstorereq(
+				'open-ils.cstore.direct.asset.call_number_note.search.atomic',
+				{ call_number => $id, pub => 't' } );
+		} else {
+			( $r, $evt ) = $U->checksesperm($authtoken, 'VIEW_VOLUME_NOTES');
+			return $evt if $evt;
+			return $U->cstorereq(
+				'open-ils.cstore.direct.asset.call_number_note.search.atomic', { call_number => $id } );
+		}
+
+	} elsif( $self->api_name =~ /title/ ) {
+		if( $$args{pub} ) {
+			return $U->cstorereq(
+				'open-ils.cstore.direct.bilbio.record_note.search.atomic',
+				{ record => $id, pub => 't' } );
+		} else {
+			( $r, $evt ) = $U->checksesperm($authtoken, 'VIEW_TITLE_NOTES');
+			return $evt if $evt;
+			return $U->cstorereq(
+				'open-ils.cstore.direct.biblio.record_note.search.atomic', { record => $id } );
+		}
+	}
+
+	return undef;
+}
+
+__PACKAGE__->register_method(
+	method	=> 'has_notes',
+	api_name	=> 'open-ils.circ.copy.has_notes');
+__PACKAGE__->register_method(
+	method	=> 'has_notes',
+	api_name	=> 'open-ils.circ.call_number.has_notes');
+__PACKAGE__->register_method(
+	method	=> 'has_notes',
+	api_name	=> 'open-ils.circ.title.has_notes');
+
+
+sub has_notes {
+	my( $self, $conn, $authtoken, $id ) = @_;
+	my $editor = OpenILS::Utils::Editor->new(authtoken => $authtoken);
+	return $editor->event unless $editor->checkauth;
+
+	my $n = $editor->search_asset_copy_note(
+		{owning_copy=>$id}, {idlist=>1}) if $self->api_name =~ /copy/;
+
+	$n = $editor->search_asset_call_number_note(
+		{call_number=>$id}, {idlist=>1}) if $self->api_name =~ /call_number/;
+
+	$n = $editor->search_biblio_record_note(
+		{record=>$id}, {idlist=>1}) if $self->api_name =~ /title/;
+
+	return scalar @$n;
+}
+
+
+
+__PACKAGE__->register_method(
+	method		=> 'create_copy_note',
+	api_name		=> 'open-ils.circ.copy_note.create',
+	signature	=> q/
+		Creates a new copy note
+		@param authtoken The login session key
+		@param note	The note object to create
+		@return The id of the new note object
+	/);
+
+sub create_copy_note {
+	my( $self, $connection, $authtoken, $note ) = @_;
+
+	my $e = new_editor(xact=>1, authtoken=>$authtoken);
+	return $e->event unless $e->checkauth;
+	my $copy = $e->retrieve_asset_copy(
+		[
+			$note->owning_copy,
+			{	flesh => 1,
+				flesh_fields => { 'acp' => ['call_number'] }
+			}
+		]
+	);
+
+	return $e->event unless 
+		$e->allowed('CREATE_COPY_NOTE', $copy->call_number->owning_lib);
+
+	$note->create_date('now');
+	$note->creator($e->requestor->id);
+	$note->pub( ($U->is_true($note->pub)) ? 't' : 'f' );
+	$note->clear_id;
+
+	$e->create_asset_copy_note($note) or return $e->event;
+	$e->commit;
+	return $note->id;
+}
+
+
+__PACKAGE__->register_method(
+	method		=> 'delete_copy_note',
+	api_name		=>	'open-ils.circ.copy_note.delete',
+	signature	=> q/
+		Deletes an existing copy note
+		@param authtoken The login session key
+		@param noteid The id of the note to delete
+		@return 1 on success - Event otherwise.
+		/);
+sub delete_copy_note {
+	my( $self, $conn, $authtoken, $noteid ) = @_;
+
+	my $e = new_editor(xact=>1, authtoken=>$authtoken);
+	return $e->die_event unless $e->checkauth;
+
+	my $note = $e->retrieve_asset_copy_note([
+		$noteid,
+		{ flesh => 2,
+			flesh_fields => {
+				'acpn' => [ 'owning_copy' ],
+				'acp' => [ 'call_number' ],
+			}
+		}
+	]) or return $e->die_event;
+
+	if( $note->creator ne $e->requestor->id ) {
+		return $e->die_event unless 
+			$e->allowed('DELETE_COPY_NOTE', $note->owning_copy->call_number->owning_lib);
+	}
+
+	$e->delete_asset_copy_note($note) or return $e->die_event;
+	$e->commit;
+	return 1;
+}
+
+
+__PACKAGE__->register_method(
+	method => 'age_hold_rules',
+	api_name	=>  'open-ils.circ.config.rules.age_hold_protect.retrieve.all',
+);
+
+sub age_hold_rules {
+	my( $self, $conn ) = @_;
+	return new_editor()->retrieve_all_config_rules_age_hold_protect();
+}
+
+
+
+__PACKAGE__->register_method(
+	method => 'copy_details_barcode',
+    authoritative => 1,
+	api_name => 'open-ils.circ.copy_details.retrieve.barcode');
+sub copy_details_barcode {
+	my( $self, $conn, $auth, $barcode ) = @_;
+    my $e = new_editor();
+    my $cid = $e->search_asset_copy({barcode=>$barcode, deleted=>'f'}, {idlist=>1})->[0];
+    return $e->event unless $cid;
+	return copy_details( $self, $conn, $auth, $cid );
+}
+
+
+__PACKAGE__->register_method(
+	method => 'copy_details',
+	api_name => 'open-ils.circ.copy_details.retrieve');
+
+sub copy_details {
+	my( $self, $conn, $auth, $copy_id ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+
+	my $flesh = { flesh => 1 };
+
+	my $copy = $e->retrieve_asset_copy(
+		[
+			$copy_id,
+			{
+				flesh => 2,
+				flesh_fields => {
+					acp => ['call_number'],
+					acn => ['record']
+				}
+			}
+		]) or return $e->event;
+
+
+	# De-flesh the copy for backwards compatibility
+	my $mvr;
+	my $vol = $copy->call_number;
+	if( ref $vol ) {
+		$copy->call_number($vol->id);
+		my $record = $vol->record;
+		if( ref $record ) {
+			$vol->record($record->id);
+			$mvr = $U->record_to_mvr($record);
+		}
+	}
+
+
+	my $hold = $e->search_action_hold_request(
+		{ 
+			current_copy		=> $copy_id, 
+			capture_time		=> { "!=" => undef },
+			fulfillment_time	=> undef,
+			cancel_time			=> undef,
+		}
+	)->[0];
+
+	OpenILS::Application::Circ::Holds::flesh_hold_transits([$hold]) if $hold;
+
+	my $transit = $e->search_action_transit_copy(
+		{ target_copy => $copy_id, dest_recv_time => undef } )->[0];
+
+	# find the latest circ, open or closed
+	my $circ = $e->search_action_circulation(
+		[
+			{ target_copy => $copy_id },
+			{ 
+                flesh => 1,
+                flesh_fields => {
+                    circ => [
+                        'workstation',
+                        'checkin_workstation', 
+                        'duration_rule', 
+                        'max_fine_rule', 
+                        'recurring_fine_rule'
+                    ]
+                },
+                order_by => { circ => 'xact_start desc' }, 
+                limit => 1 
+            }
+		]
+	)->[0];
+
+
+	return {
+		copy		=> $copy,
+		hold		=> $hold,
+		transit	=> $transit,
+		circ		=> $circ,
+		volume	=> $vol,
+		mvr		=> $mvr,
+	};
+}
+
+
+
+
+__PACKAGE__->register_method(
+	method => 'mark_item',
+	api_name => 'open-ils.circ.mark_item_damaged',
+	signature	=> q/
+		Changes the status of a copy to "damaged". Requires MARK_ITEM_DAMAGED permission.
+		@param authtoken The login session key
+		@param copy_id The ID of the copy to mark as damaged
+		@return 1 on success - Event otherwise.
+		/
+);
+__PACKAGE__->register_method(
+	method => 'mark_item',
+	api_name => 'open-ils.circ.mark_item_missing',
+	signature	=> q/
+		Changes the status of a copy to "missing". Requires MARK_ITEM_MISSING permission.
+		@param authtoken The login session key
+		@param copy_id The ID of the copy to mark as missing 
+		@return 1 on success - Event otherwise.
+		/
+);
+__PACKAGE__->register_method(
+	method => 'mark_item',
+	api_name => 'open-ils.circ.mark_item_bindery',
+	signature	=> q/
+		Changes the status of a copy to "bindery". Requires MARK_ITEM_BINDERY permission.
+		@param authtoken The login session key
+		@param copy_id The ID of the copy to mark as bindery
+		@return 1 on success - Event otherwise.
+		/
+);
+__PACKAGE__->register_method(
+	method => 'mark_item',
+	api_name => 'open-ils.circ.mark_item_on_order',
+	signature	=> q/
+		Changes the status of a copy to "on order". Requires MARK_ITEM_ON_ORDER permission.
+		@param authtoken The login session key
+		@param copy_id The ID of the copy to mark as on order 
+		@return 1 on success - Event otherwise.
+		/
+);
+__PACKAGE__->register_method(
+	method => 'mark_item',
+	api_name => 'open-ils.circ.mark_item_ill',
+	signature	=> q/
+		Changes the status of a copy to "inter-library loan". Requires MARK_ITEM_ILL permission.
+		@param authtoken The login session key
+		@param copy_id The ID of the copy to mark as inter-library loan
+		@return 1 on success - Event otherwise.
+		/
+);
+__PACKAGE__->register_method(
+	method => 'mark_item',
+	api_name => 'open-ils.circ.mark_item_cataloging',
+	signature	=> q/
+		Changes the status of a copy to "cataloging". Requires MARK_ITEM_CATALOGING permission.
+		@param authtoken The login session key
+		@param copy_id The ID of the copy to mark as cataloging 
+		@return 1 on success - Event otherwise.
+		/
+);
+__PACKAGE__->register_method(
+	method => 'mark_item',
+	api_name => 'open-ils.circ.mark_item_reserves',
+	signature	=> q/
+		Changes the status of a copy to "reserves". Requires MARK_ITEM_RESERVES permission.
+		@param authtoken The login session key
+		@param copy_id The ID of the copy to mark as reserves
+		@return 1 on success - Event otherwise.
+		/
+);
+__PACKAGE__->register_method(
+	method => 'mark_item',
+	api_name => 'open-ils.circ.mark_item_discard',
+	signature	=> q/
+		Changes the status of a copy to "discard". Requires MARK_ITEM_DISCARD permission.
+		@param authtoken The login session key
+		@param copy_id The ID of the copy to mark as discard
+		@return 1 on success - Event otherwise.
+		/
+);
+
+sub mark_item {
+	my( $self, $conn, $auth, $copy_id, $args ) = @_;
+	my $e = new_editor(authtoken=>$auth, xact =>1);
+	return $e->die_event unless $e->checkauth;
+    $args ||= {};
+
+    my $copy = $e->retrieve_asset_copy([
+        $copy_id,
+        {flesh => 1, flesh_fields => {'acp' => ['call_number']}}])
+            or return $e->die_event;
+
+    my $owning_lib = 
+        ($copy->call_number->id == OILS_PRECAT_CALL_NUMBER) ? 
+            $copy->circ_lib : $copy->call_number->owning_lib;
+
+    return $e->die_event unless $e->allowed('UPDATE_COPY', $owning_lib);
+
+
+	my $perm = 'MARK_ITEM_MISSING';
+	my $stat = OILS_COPY_STATUS_MISSING;
+
+	if( $self->api_name =~ /damaged/ ) {
+		$perm = 'MARK_ITEM_DAMAGED';
+		$stat = OILS_COPY_STATUS_DAMAGED;
+        my $evt = handle_mark_damaged($e, $copy, $owning_lib, $args);
+        return $evt if $evt;
+
+        my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+        $ses->request('open-ils.trigger.event.autocreate', 'damaged', $copy, $owning_lib);
+
+	} elsif ( $self->api_name =~ /bindery/ ) {
+		$perm = 'MARK_ITEM_BINDERY';
+		$stat = OILS_COPY_STATUS_BINDERY;
+	} elsif ( $self->api_name =~ /on_order/ ) {
+		$perm = 'MARK_ITEM_ON_ORDER';
+		$stat = OILS_COPY_STATUS_ON_ORDER;
+	} elsif ( $self->api_name =~ /ill/ ) {
+		$perm = 'MARK_ITEM_ILL';
+		$stat = OILS_COPY_STATUS_ILL;
+	} elsif ( $self->api_name =~ /cataloging/ ) {
+		$perm = 'MARK_ITEM_CATALOGING';
+		$stat = OILS_COPY_STATUS_CATALOGING;
+	} elsif ( $self->api_name =~ /reserves/ ) {
+		$perm = 'MARK_ITEM_RESERVES';
+		$stat = OILS_COPY_STATUS_RESERVES;
+	} elsif ( $self->api_name =~ /discard/ ) {
+		$perm = 'MARK_ITEM_DISCARD';
+		$stat = OILS_COPY_STATUS_DISCARD;
+	}
+
+
+	$copy->status($stat);
+	$copy->edit_date('now');
+	$copy->editor($e->requestor->id);
+
+	$e->update_asset_copy($copy) or return $e->die_event;
+
+	my $holds = $e->search_action_hold_request(
+		{ 
+			current_copy => $copy->id,
+			fulfillment_time => undef,
+			cancel_time => undef,
+		}
+	);
+
+	$e->commit;
+
+	$logger->debug("resetting holds that target the marked copy");
+	OpenILS::Application::Circ::Holds->_reset_hold($e->requestor, $_) for @$holds;
+
+	return 1;
+}
+
+sub handle_mark_damaged {
+    my($e, $copy, $owning_lib, $args) = @_;
+
+    my $apply = $args->{apply_fines} || '';
+    return undef if $apply eq 'noapply';
+
+    my $new_amount = $args->{override_amount};
+    my $new_btype = $args->{override_btype};
+    my $new_note = $args->{override_note};
+
+    # grab the last circulation
+    my $circ = $e->search_action_circulation([
+        {   target_copy => $copy->id}, 
+        {   limit => 1, 
+            order_by => {circ => "xact_start DESC"},
+            flesh => 2,
+            flesh_fields => {circ => ['target_copy', 'usr'], au => ['card']}
+        }
+    ])->[0];
+
+    return undef unless $circ;
+
+    my $charge_price = $U->ou_ancestor_setting_value(
+        $owning_lib, 'circ.charge_on_damaged', $e);
+
+    my $proc_fee = $U->ou_ancestor_setting_value(
+        $owning_lib, 'circ.damaged_item_processing_fee', $e) || 0;
+
+    my $void_overdue = $U->ou_ancestor_setting_value(
+        $owning_lib, 'circ.damaged.void_ovedue', $e) || 0;
+
+    return undef unless $charge_price or $proc_fee;
+
+    my $copy_price = ($charge_price) ? $U->get_copy_price($e, $copy) : 0;
+    my $total = $copy_price + $proc_fee;
+
+    if($apply) {
+        
+        if($new_amount and $new_btype) {
+
+            # Allow staff to override the amount to charge for a damaged item
+            # Consider the case where the item is only partially damaged
+            # This value is meant to take the place of the item price and
+            # optional processing fee.
+
+            my $evt = OpenILS::Application::Circ::CircCommon->create_bill(
+                $e, $new_amount, $new_btype, 'Damaged Item Override', $circ->id, $new_note);
+            return $evt if $evt;
+
+        } else {
+
+            if($charge_price and $copy_price) {
+                my $evt = OpenILS::Application::Circ::CircCommon->create_bill(
+                    $e, $copy_price, 7, 'Damaged Item', $circ->id);
+                return $evt if $evt;
+            }
+
+            if($proc_fee) {
+                my $evt = OpenILS::Application::Circ::CircCommon->create_bill(
+                    $e, $proc_fee, 8, 'Damaged Item Processing Fee', $circ->id);
+                return $evt if $evt;
+            }
+        }
+
+        # the assumption is that you would not void the overdues unless you 
+        # were also charging for the item and/or applying a processing fee
+        if($void_overdue) {
+            my $evt = OpenILS::Application::Circ::CircCommon->void_overdues($e, $circ);
+            return $evt if $evt;
+        }
+
+        my $evt = OpenILS::Application::Circ::CircCommon->reopen_xact($e, $circ->id);
+        return $evt if $evt;
+
+        my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+        $ses->request('open-ils.trigger.event.autocreate', 'checkout.damaged', $circ, $circ->circ_lib);
+
+        return undef;
+
+    } else {
+        return OpenILS::Event->new('DAMAGE_CHARGE', 
+            payload => {
+                circ => $circ,
+                charge => $total
+            }
+        );
+    }
+}
+
+
+
+# ----------------------------------------------------------------------
+__PACKAGE__->register_method(
+    method => 'mark_item_missing_pieces',
+    api_name => 'open-ils.circ.mark_item_missing_pieces',
+    signature	=> q/
+        Changes the status of a copy to "damaged" or to a custom status based on the 
+        circ.missing_pieces.copy_status org unit setting. Requires MARK_ITEM_MISSING_PIECES
+        permission.
+        @param authtoken The login session key
+        @param copy_id The ID of the copy to mark as damaged
+        @return Success event with circ and copy objects in the payload, or error Event otherwise.
+        /
+);
+
+sub mark_item_missing_pieces {
+	my( $self, $conn, $auth, $copy_id, $args ) = @_;
+    ### FIXME: We're starting a transaction here, but we're doing a lot of things outside of the transaction
+	my $e = new_editor(authtoken=>$auth, xact =>1);
+	return $e->die_event unless $e->checkauth;
+    $args ||= {};
+
+    my $copy = $e->retrieve_asset_copy([
+        $copy_id,
+        {flesh => 1, flesh_fields => {'acp' => ['call_number']}}])
+            or return $e->die_event;
+
+    my $owning_lib = 
+        ($copy->call_number->id == OILS_PRECAT_CALL_NUMBER) ? 
+            $copy->circ_lib : $copy->call_number->owning_lib;
+
+    return $e->die_event unless $e->allowed('MARK_ITEM_MISSING_PIECES', $owning_lib);
+
+    #### grab the last circulation
+    my $circ = $e->search_action_circulation([
+        {   target_copy => $copy->id}, 
+        {   limit => 1, 
+            order_by => {circ => "xact_start DESC"}
+        }
+    ])->[0];
+
+    if ($circ) {
+        if (! $circ->checkin_time) { # if circ active, attempt renew
+            my ($res) = $self->method_lookup('open-ils.circ.renew')->run($e->authtoken,{'copy_id'=>$circ->target_copy});
+            if (ref $res ne 'ARRAY') { $res = [ $res ]; }
+            if ( $res->[0]->{textcode} eq 'SUCCESS' ) {
+                $circ = $res->[0]->{payload}{'circ'};
+                $circ->target_copy( $copy->id );
+                $logger->info('open-ils.circ.mark_item_missing_pieces: successful renewal');
+            } else {
+                $logger->info('open-ils.circ.mark_item_missing_pieces: non-successful renewal');
+            }
+        } else {
+
+            my $co_params = {
+                'copy_id'=>$circ->target_copy,
+                'patron_id'=>$circ->usr,
+                'skip_deposit_fee'=>1,
+                'skip_rental_fee'=>1
+            };
+
+            if ($U->ou_ancestor_setting_value($e->requestor->ws_ou, 'circ.block_renews_for_holds')) {
+
+                my ($hold, undef, $retarget) = $holdcode->find_nearest_permitted_hold(
+                    $e, $copy, $e->requestor, 1 );
+
+                if ($hold) { # needed for hold? then due now
+
+                    $logger->info('open-ils.circ.mark_item_missing_pieces: item needed for hold, shortening due date');
+                    my $due_date = DateTime->now(time_zone => 'local');
+                    $co_params->{'due_date'} = cleanse_ISO8601( $due_date->strftime('%FT%T%z') );
+                } else {
+                    $logger->info('open-ils.circ.mark_item_missing_pieces: item not needed for hold');
+                }
+            }
+
+            my ($res) = $self->method_lookup('open-ils.circ.checkout.full.override')->run($e->authtoken,$co_params);
+            if (ref $res ne 'ARRAY') { $res = [ $res ]; }
+            if ( $res->[0]->{textcode} eq 'SUCCESS' ) {
+                $logger->info('open-ils.circ.mark_item_missing_pieces: successful checkout');
+                $circ = $res->[0]->{payload}{'circ'};
+            } else {
+                $logger->info('open-ils.circ.mark_item_missing_pieces: non-successful checkout');
+                $e->rollback;
+                return $res;
+            }
+        }
+    } else {
+        $logger->info('open-ils.circ.mark_item_missing_pieces: no previous checkout');
+        $e->rollback;
+        return OpenILS::Event->new('ACTION_CIRCULATION_NOT_FOUND',{'copy'=>$copy});
+    }
+
+    ### Update the item status
+
+    my $custom_stat = $U->ou_ancestor_setting_value(
+        $owning_lib, 'circ.missing_pieces.copy_status', $e);
+    my $stat = $custom_stat || OILS_COPY_STATUS_DAMAGED;
+
+    my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+    $ses->request('open-ils.trigger.event.autocreate', 'missing_pieces', $copy, $owning_lib);
+
+	$copy->status($stat);
+	$copy->edit_date('now');
+	$copy->editor($e->requestor->id);
+
+	$e->update_asset_copy($copy) or return $e->die_event;
+
+	my $holds = $e->search_action_hold_request(
+		{ 
+			current_copy => $copy->id,
+			fulfillment_time => undef,
+			cancel_time => undef,
+		}
+	);
+
+    $logger->debug("resetting holds that target the marked copy");
+    OpenILS::Application::Circ::Holds->_reset_hold($e->requestor, $_) for @$holds;
+
+	if ($e->commit) {
+
+        my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+        $ses->request('open-ils.trigger.event.autocreate', 'circ.missing_pieces', $circ, $circ->circ_lib);
+
+        return OpenILS::Event->new('SUCCESS',
+            payload => {
+                circ => $circ,
+                copy => $copy,
+                slip => $U->fire_object_event(undef, 'circ.format.missing_pieces.slip.print', $circ, $circ->circ_lib),
+                letter => $U->fire_object_event(undef, 'circ.format.missing_pieces.letter.print', $circ, $circ->circ_lib)
+            }
+        ); 
+
+    } else {
+        return $e->die_event;
+    }
+}
+
+
+
+
+
+# ----------------------------------------------------------------------
+__PACKAGE__->register_method(
+	method => 'magic_fetch',
+	api_name => 'open-ils.agent.fetch'
+);
+
+my @FETCH_ALLOWED = qw/ aou aout acp acn bre /;
+
+sub magic_fetch {
+	my( $self, $conn, $auth, $args ) = @_;
+	my $e = new_editor( authtoken => $auth );
+	return $e->event unless $e->checkauth;
+
+	my $hint = $$args{hint};
+	my $id	= $$args{id};
+
+	# Is the call allowed to fetch this type of object?
+	return undef unless grep { $_ eq $hint } @FETCH_ALLOWED;
+
+	# Find the class the implements the given hint
+	my ($class) = grep { 
+		$Fieldmapper::fieldmap->{$_}{hint} eq $hint } Fieldmapper->classes;
+
+	$class =~ s/Fieldmapper:://og;
+	$class =~ s/::/_/og;
+	my $method = "retrieve_$class";
+
+	my $obj = $e->$method($id) or return $e->event;
+	return $obj;
+}
+# ----------------------------------------------------------------------
+
+
+__PACKAGE__->register_method(
+	method	=> "fleshed_circ_retrieve",
+    authoritative => 1,
+	api_name	=> "open-ils.circ.fleshed.retrieve",);
+
+sub fleshed_circ_retrieve {
+	my( $self, $client, $id ) = @_;
+	my $e = new_editor();
+	my $circ = $e->retrieve_action_circulation(
+		[
+			$id,
+			{ 
+				flesh				=> 4,
+				flesh_fields	=> { 
+					circ => [ qw/ target_copy / ],
+					acp => [ qw/ location status stat_cat_entry_copy_maps notes age_protect call_number / ],
+					ascecm => [ qw/ stat_cat stat_cat_entry / ],
+					acn => [ qw/ record / ],
+				}
+			}
+		]
+	) or return $e->event;
+	
+	my $copy = $circ->target_copy;
+	my $vol = $copy->call_number;
+	my $rec = $circ->target_copy->call_number->record;
+
+	$vol->record($rec->id);
+	$copy->call_number($vol->id);
+	$circ->target_copy($copy->id);
+
+	my $mvr;
+
+	if( $rec->id == OILS_PRECAT_RECORD ) {
+		$rec = undef;
+		$vol = undef;
+	} else { 
+		$mvr = $U->record_to_mvr($rec);
+		$rec->marc(''); # drop the bulky marc data
+	}
+
+	return {
+		circ => $circ,
+		copy => $copy,
+		volume => $vol,
+		record => $rec,
+		mvr => $mvr,
+	};
+}
+
+
+
+__PACKAGE__->register_method(
+	method	=> "test_batch_circ_events",
+	api_name	=> "open-ils.circ.trigger_event_by_def_and_barcode.fire"
+);
+
+#  method for testing the behavior of a given event definition
+sub test_batch_circ_events {
+    my($self, $conn, $auth, $event_def, $barcode) = @_;
+
+    my $e = new_editor(authtoken => $auth);
+	return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('VIEW_CIRCULATIONS');
+
+    my $copy = $e->search_asset_copy({barcode => $barcode, deleted => 'f'})->[0]
+        or return $e->event;
+
+    my $circ = $e->search_action_circulation(
+        {target_copy => $copy->id, checkin_time => undef})->[0]
+        or return $e->event;
+        
+    return undef unless $circ;
+
+    return $U->fire_object_event($event_def, undef, $circ, $e->requestor->ws_ou)
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "fire_circ_events", 
+	api_name	=> "open-ils.circ.fire_circ_trigger_events",
+    signature => q/
+        General event def runner for circ objects.  If no event def ID
+        is provided, the hook will be used to find the best event_def
+        match based on the context org unit
+    /
+);
+
+__PACKAGE__->register_method(
+	method	=> "fire_circ_events", 
+	api_name	=> "open-ils.circ.fire_hold_trigger_events",
+    signature => q/
+        General event def runner for hold objects.  If no event def ID
+        is provided, the hook will be used to find the best event_def
+        match based on the context org unit
+    /
+);
+
+__PACKAGE__->register_method(
+	method	=> "fire_circ_events", 
+	api_name	=> "open-ils.circ.fire_user_trigger_events",
+    signature => q/
+        General event def runner for user objects.  If no event def ID
+        is provided, the hook will be used to find the best event_def
+        match based on the context org unit
+    /
+);
+
+
+sub fire_circ_events {
+    my($self, $conn, $auth, $org_id, $event_def, $hook, $granularity, $target_ids, $user_data) = @_;
+
+    my $e = new_editor(authtoken => $auth, xact => 1);
+	return $e->event unless $e->checkauth;
+
+    my $targets;
+
+    if($self->api_name =~ /hold/) {
+        return $e->event unless $e->allowed('VIEW_HOLD', $org_id);
+        $targets = $e->batch_retrieve_action_hold_request($target_ids);
+    } elsif($self->api_name =~ /user/) {
+        return $e->event unless $e->allowed('VIEW_USER', $org_id);
+        $targets = $e->batch_retrieve_actor_user($target_ids);
+    } else {
+        return $e->event unless $e->allowed('VIEW_CIRCULATIONS', $org_id);
+        $targets = $e->batch_retrieve_action_circulation($target_ids);
+    }
+    $e->rollback; # FIXME using transaction because of pgpool/slony setups, but not
+                  # simply making this method authoritative because of weirdness
+                  # with transaction handling in A/T code that causes rollback
+                  # failure down the line if handling many targets
+
+    return undef unless @$targets;
+    return $U->fire_object_event($event_def, $hook, $targets, $org_id, $granularity, $user_data);
+}
+
+__PACKAGE__->register_method(
+	method	=> "user_payments_list",
+	api_name	=> "open-ils.circ.user_payments.filtered.batch",
+    stream => 1,
+	signature => {
+        desc => q/Returns a fleshed, date-limited set of all payments a user
+                has made.  By default, ordered by payment date.  Optionally
+                ordered by other columns in the top-level "mp" object/,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'User ID', type => 'number'},
+            {desc => 'Order by column(s), optional.  Array of "mp" class columns', type => 'array'}
+        ],
+        return => {desc => q/List of "mp" objects, fleshed with the billable transaction 
+            and the related fully-realized payment object (e.g money.cash_payment)/}
+    }
+);
+
+sub user_payments_list {
+    my($self, $conn, $auth, $user_id, $start_date, $end_date, $order_by) = @_;
+
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+    return $e->event unless $e->allowed('VIEW_CIRCULATIONS', $user->home_ou);
+
+    $order_by ||= ['payment_ts'];
+
+    # all payments by user, between start_date and end_date
+    my $payments = $e->json_query({
+        select => {mp => ['id']}, 
+        from => {
+            mp => {
+                mbt => {
+                    fkey => 'xact', field => 'id'}
+            }
+        }, 
+        where => {
+            '+mbt' => {usr => $user_id}, 
+            '+mp' => {payment_ts => {between => [$start_date, $end_date]}}
+        },
+        order_by => {mp => $order_by}
+    });
+
+    for my $payment_id (@$payments) {
+        my $payment = $e->retrieve_money_payment([
+            $payment_id->{id}, 
+            {   
+                flesh => 2,
+                flesh_fields => {
+                    mp => [
+                        'xact',
+                        'cash_payment',
+                        'credit_card_payment',
+                        'credit_payment',
+                        'check_payment',
+                        'work_payment',
+                        'forgive_payment',
+                        'goods_payment'
+                    ],
+                    mbt => [
+                        'circulation', 
+                        'grocery',
+                        'reservation'
+                    ]
+                }
+            }
+        ]);
+        $conn->respond($payment);
+    }
+
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_circ_chain",
+	api_name	=> "open-ils.circ.renewal_chain.retrieve_by_circ",
+    stream => 1,
+	signature => {
+        desc => q/Given a circulation, this returns all circulation objects
+                that are part of the same chain of renewals./,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Circ ID', type => 'number'},
+        ],
+        return => {desc => q/List of circ objects, orderd by oldest circ first/}
+    }
+);
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_circ_chain",
+	api_name	=> "open-ils.circ.renewal_chain.retrieve_by_circ.summary",
+	signature => {
+        desc => q/Given a circulation, this returns a summary of the circulation objects
+                that are part of the same chain of renewals./,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Circ ID', type => 'number'},
+        ],
+        return => {desc => q/Circulation Chain Summary/}
+    }
+);
+
+sub retrieve_circ_chain {
+    my($self, $conn, $auth, $circ_id) = @_;
+
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('VIEW_CIRCULATIONS');
+
+    if($self->api_name =~ /summary/) {
+        return $U->create_circ_chain_summary($e, $circ_id);
+
+    } else {
+
+        my $chain = $e->json_query({from => ['action.circ_chain', $circ_id]});
+
+        for my $circ_info (@$chain) {
+            my $circ = Fieldmapper::action::circulation->new;
+            $circ->$_($circ_info->{$_}) for keys %$circ_info;
+            $conn->respond($circ);
+        }
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_prev_circ_chain",
+	api_name	=> "open-ils.circ.prev_renewal_chain.retrieve_by_circ",
+    stream => 1,
+	signature => {
+        desc => q/Given a circulation, this returns all circulation objects
+                that are part of the previous chain of renewals./,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Circ ID', type => 'number'},
+        ],
+        return => {desc => q/List of circ objects, orderd by oldest circ first/}
+    }
+);
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_prev_circ_chain",
+	api_name	=> "open-ils.circ.prev_renewal_chain.retrieve_by_circ.summary",
+	signature => {
+        desc => q/Given a circulation, this returns a summary of the circulation objects
+                that are part of the previous chain of renewals./,
+        params => [
+            {desc => 'Authentication token', type => 'string'},
+            {desc => 'Circ ID', type => 'number'},
+        ],
+        return => {desc => q/Object containing Circulation Chain Summary and User Id/}
+    }
+);
+
+sub retrieve_prev_circ_chain {
+    my($self, $conn, $auth, $circ_id) = @_;
+
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('VIEW_CIRCULATIONS');
+
+    if($self->api_name =~ /summary/) {
+        my $first_circ = $e->json_query({from => ['action.circ_chain', $circ_id]})->[0];
+        my $target_copy = $$first_circ{'target_copy'};
+        my $usr = $$first_circ{'usr'};
+        my $last_circ_from_prev_chain = $e->json_query({
+            'select' => { 'circ' => ['id','usr'] },
+            'from' => 'circ', 
+            'where' => {
+                target_copy => $target_copy,
+                xact_start => { '<' => $$first_circ{'xact_start'} }
+            },
+            'order_by' => [{ 'class'=>'circ', 'field'=>'xact_start', 'direction'=>'desc' }],
+            'limit' => 1
+        })->[0];
+        return undef unless $last_circ_from_prev_chain;
+        return undef unless $$last_circ_from_prev_chain{'id'};
+        my $sum = $e->json_query({from => ['action.summarize_circ_chain', $$last_circ_from_prev_chain{'id'}]})->[0];
+        return undef unless $sum;
+        my $obj = Fieldmapper::action::circ_chain_summary->new;
+        $obj->$_($sum->{$_}) for keys %$sum;
+        return { 'summary' => $obj, 'usr' => $$last_circ_from_prev_chain{'usr'} };
+
+    } else {
+
+        my $first_circ = $e->json_query({from => ['action.circ_chain', $circ_id]})->[0];
+        my $target_copy = $$first_circ{'target_copy'};
+        my $last_circ_from_prev_chain = $e->json_query({
+            'select' => { 'circ' => ['id'] },
+            'from' => 'circ', 
+            'where' => {
+                target_copy => $target_copy,
+                xact_start => { '<' => $$first_circ{'xact_start'} }
+            },
+            'order_by' => [{ 'class'=>'circ', 'field'=>'xact_start', 'direction'=>'desc' }],
+            'limit' => 1
+        })->[0];
+        return undef unless $last_circ_from_prev_chain;
+        return undef unless $$last_circ_from_prev_chain{'id'};
+        my $chain = $e->json_query({from => ['action.circ_chain', $$last_circ_from_prev_chain{'id'}]});
+
+        for my $circ_info (@$chain) {
+            my $circ = Fieldmapper::action::circulation->new;
+            $circ->$_($circ_info->{$_}) for keys %$circ_info;
+            $conn->respond($circ);
+        }
+    }
+
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "get_copy_due_date",
+	api_name	=> "open-ils.circ.copy.due_date.retrieve",
+	signature => {
+        desc => q/
+            Given a copy ID, returns the due date for the copy if it's 
+            currently circulating.  Otherwise, returns null.  Note, this is a public 
+            method requiring no authentication.  Only the due date is exposed.
+            /,
+        params => [
+            {desc => 'Copy ID', type => 'number'}
+        ],
+        return => {desc => q/
+            Due date (ISO date stamp) if the copy is circulating, null otherwise.
+        /}
+    }
+);
+
+sub get_copy_due_date {
+    my($self, $conn, $copy_id) = @_;
+    my $e = new_editor();
+
+    my $circ = $e->json_query({
+        select => {circ => ['due_date']},
+        from => 'circ',
+        where => {
+            target_copy => $copy_id,
+            checkin_time => undef,
+            '-or' => [
+                {stop_fines => ["MAXFINES","LONGOVERDUE"]},
+                {stop_fines => undef}
+            ],
+        },
+        limit => 1
+    })->[0] or return undef;
+
+    return $circ->{due_date};
+}
+
+
+
+
+
+# {"select":{"acp":["id"],"circ":[{"aggregate":true,"transform":"count","alias":"count","column":"id"}]},"from":{"acp":{"circ":{"field":"target_copy","fkey":"id","type":"left"},"acn"{"field":"id","fkey":"call_number"}}},"where":{"+acn":{"record":200057}}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/CircCommon.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/CircCommon.pm
new file mode 100644
index 0000000000..1319201554
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/CircCommon.pm
@@ -0,0 +1,109 @@
+package OpenILS::Application::Circ::CircCommon;
+use strict; use warnings;
+use DateTime;
+use DateTime::Format::ISO8601;
+use OpenILS::Application::AppUtils;
+use OpenSRF::Utils qw/:datetime/;
+use OpenILS::Event;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Const qw/:const/;
+
+my $U = "OpenILS::Application::AppUtils";
+
+# -----------------------------------------------------------------
+# Do not publish methods here.  This code is shared across apps.
+# -----------------------------------------------------------------
+
+
+# -----------------------------------------------------------------
+# Voids overdue fines on the given circ.  if a backdate is 
+# provided, then we only void back to the backdate
+# -----------------------------------------------------------------
+sub void_overdues {
+    my($class, $e, $circ, $backdate, $note) = @_;
+
+    my $bill_search = { 
+        xact => $circ->id, 
+        btype => 1 
+    };
+
+    if( $backdate ) {
+        # ------------------------------------------------------------------
+        # Fines for overdue materials are assessed up to, but not including,
+        # one fine interval after the fines are applicable.  Here, we add
+        # one fine interval to the backdate to ensure that we are not 
+        # voiding fines that were applicable before the backdate.
+        # ------------------------------------------------------------------
+
+        # if there is a raw time component (e.g. from postgres), 
+        # turn it into an interval that interval_to_seconds can parse
+        my $duration = $circ->fine_interval;
+        $duration =~ s/(\d{2}):(\d{2}):(\d{2})/$1 h $2 m $3 s/o;
+        my $interval = OpenSRF::Utils->interval_to_seconds($duration);
+
+        my $date = DateTime::Format::ISO8601->parse_datetime($backdate);
+        $backdate = $U->epoch2ISO8601($date->epoch + $interval);
+        $logger->info("applying backdate $backdate in overdue voiding");
+        $$bill_search{billing_ts} = {'>=' => $backdate};
+    }
+
+    my $bills = $e->search_money_billing($bill_search);
+    
+    for my $bill (@$bills) {
+        next if $U->is_true($bill->voided);
+        $logger->info("voiding overdue bill ".$bill->id);
+        $bill->voided('t');
+        $bill->void_time('now');
+        $bill->voider($e->requestor->id);
+        my $n = ($bill->note) ? sprintf("%s\n", $bill->note) : "";
+        $bill->note(sprintf("$n%s", ($note) ? $note : "System: VOIDED FOR BACKDATE"));
+        $e->update_money_billing($bill) or return $e->die_event;
+    }
+
+	return undef;
+}
+
+
+sub reopen_xact {
+    my($class, $e, $xactid) = @_;
+
+    # -----------------------------------------------------------------
+    # make sure the transaction is not closed
+    my $xact = $e->retrieve_money_billable_transaction($xactid)
+        or return $e->die_event;
+
+    if( $xact->xact_finish ) {
+        my ($mbts) = $U->fetch_mbts($xactid, $e);
+        if( $mbts->balance_owed != 0 ) {
+            $logger->info("* re-opening xact $xactid, orig xact_finish is ".$xact->xact_finish);
+            $xact->clear_xact_finish;
+            $e->update_money_billable_transaction($xact)
+                or return $e->die_event;
+        } 
+    }
+
+    return undef;
+}
+
+
+sub create_bill {
+	my($class, $e, $amount, $btype, $type, $xactid, $note) = @_;
+
+	$logger->info("The system is charging $amount [$type] on xact $xactid");
+    $note ||= 'SYSTEM GENERATED';
+
+    # -----------------------------------------------------------------
+    # now create the billing
+	my $bill = Fieldmapper::money::billing->new;
+	$bill->xact($xactid);
+	$bill->amount($amount);
+	$bill->billing_type($type); 
+	$bill->btype($btype); 
+	$bill->note($note);
+    $e->create_money_billing($bill) or return $e->die_event;
+
+	return undef;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Circulate.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Circulate.pm
new file mode 100644
index 0000000000..c000676b45
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Circulate.pm
@@ -0,0 +1,3433 @@
+package OpenILS::Application::Circ::Circulate;
+use strict; use warnings;
+use base 'OpenILS::Application';
+use OpenSRF::EX qw(:try);
+use OpenSRF::AppSession;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Const qw/:const/;
+use OpenILS::Application::AppUtils;
+use DateTime;
+my $U = "OpenILS::Application::AppUtils";
+
+my %scripts;
+my $script_libs;
+my $legacy_script_support = 0;
+my $booking_status;
+
+sub determine_booking_status {
+    unless (defined $booking_status) {
+        my $ses = create OpenSRF::AppSession("router");
+        $booking_status = grep {$_ eq "open-ils.booking"} @{
+            $ses->request("opensrf.router.info.class.list")->gather(1)
+        };
+        $ses->disconnect;
+        $logger->info("booking status: " . ($booking_status ? "on" : "off"));
+    }
+
+    return $booking_status;
+}
+
+
+my $MK_ENV_FLESH = { 
+    flesh => 2, 
+    flesh_fields => {acp => ['call_number'], acn => ['record']} 
+};
+
+sub initialize {
+
+    my $self = shift;
+    my $conf = OpenSRF::Utils::SettingsClient->new;
+    my @pfx2 = ( "apps", "open-ils.circ","app_settings" );
+
+    $legacy_script_support = $conf->config_value(@pfx2, 'legacy_script_support');
+    $legacy_script_support = ($legacy_script_support and $legacy_script_support =~ /true/i);
+
+    my $lb  = $conf->config_value(  @pfx2, 'script_path' );
+    $lb = [ $lb ] unless ref($lb);
+    $script_libs = $lb;
+
+    return unless $legacy_script_support;
+
+    my @pfx = ( @pfx2, "scripts" );
+    my $p   = $conf->config_value(  @pfx, 'circ_permit_patron' );
+    my $c   = $conf->config_value(  @pfx, 'circ_permit_copy' );
+    my $d   = $conf->config_value(  @pfx, 'circ_duration' );
+    my $f   = $conf->config_value(  @pfx, 'circ_recurring_fines' );
+    my $m   = $conf->config_value(  @pfx, 'circ_max_fines' );
+    my $pr  = $conf->config_value(  @pfx, 'circ_permit_renew' );
+
+    $logger->error( "Missing circ script(s)" ) 
+        unless( $p and $c and $d and $f and $m and $pr );
+
+    $scripts{circ_permit_patron}   = $p;
+    $scripts{circ_permit_copy}     = $c;
+    $scripts{circ_duration}        = $d;
+    $scripts{circ_recurring_fines} = $f;
+    $scripts{circ_max_fines}       = $m;
+    $scripts{circ_permit_renew}    = $pr;
+
+    $logger->debug(
+        "circulator: Loaded rules scripts for circ: " .
+        "circ permit patron = $p, ".
+        "circ permit copy = $c, ".
+        "circ duration = $d, ".
+        "circ recurring fines = $f, " .
+        "circ max fines = $m, ".
+        "circ renew permit = $pr.  ".
+        "lib paths = @$lb. ".
+        "legacy script support = ". ($legacy_script_support) ? 'yes' : 'no'
+        );
+}
+
+__PACKAGE__->register_method(
+    method  => "run_method",
+    api_name    => "open-ils.circ.checkout.permit",
+    notes       => q/
+        Determines if the given checkout can occur
+        @param authtoken The login session key
+        @param params A trailing hash of named params including 
+            barcode : The copy barcode, 
+            patron : The patron the checkout is occurring for, 
+            renew : true or false - whether or not this is a renewal
+        @return The event that occurred during the permit check.  
+    /);
+
+
+__PACKAGE__->register_method (
+    method      => 'run_method',
+    api_name        => 'open-ils.circ.checkout.permit.override',
+    signature   => q/@see open-ils.circ.checkout.permit/,
+);
+
+
+__PACKAGE__->register_method(
+    method  => "run_method",
+    api_name    => "open-ils.circ.checkout",
+    notes => q/
+        Checks out an item
+        @param authtoken The login session key
+        @param params A named hash of params including:
+            copy            The copy object
+            barcode     If no copy is provided, the copy is retrieved via barcode
+            copyid      If no copy or barcode is provide, the copy id will be use
+            patron      The patron's id
+            noncat      True if this is a circulation for a non-cataloted item
+            noncat_type The non-cataloged type id
+            noncat_circ_lib The location for the noncat circ.  
+            precat      The item has yet to be cataloged
+            dummy_title The temporary title of the pre-cataloded item
+            dummy_author The temporary authr of the pre-cataloded item
+                Default is the home org of the staff member
+        @return The SUCCESS event on success, any other event depending on the error
+    /);
+
+__PACKAGE__->register_method(
+    method  => "run_method",
+    api_name    => "open-ils.circ.checkin",
+    argc        => 2,
+    signature   => q/
+        Generic super-method for handling all copies
+        @param authtoken The login session key
+        @param params Hash of named parameters including:
+            barcode - The copy barcode
+            force   - If true, copies in bad statuses will be checked in and give good statuses
+            noop    - don't capture holds or put items into transit
+            void_overdues - void all overdues for the circulation (aka amnesty)
+            ...
+    /
+);
+
+__PACKAGE__->register_method(
+    method    => "run_method",
+    api_name  => "open-ils.circ.checkin.override",
+    signature => q/@see open-ils.circ.checkin/
+);
+
+__PACKAGE__->register_method(
+    method    => "run_method",
+    api_name  => "open-ils.circ.renew.override",
+    signature => q/@see open-ils.circ.renew/,
+);
+
+
+__PACKAGE__->register_method(
+    method  => "run_method",
+    api_name    => "open-ils.circ.renew",
+    notes       => <<"    NOTES");
+    PARAMS( authtoken, circ => circ_id );
+    open-ils.circ.renew(login_session, circ_object);
+    Renews the provided circulation.  login_session is the requestor of the
+    renewal and if the logged in user is not the same as circ->usr, then
+    the logged in user must have RENEW_CIRC permissions.
+    NOTES
+
+__PACKAGE__->register_method(
+    method   => "run_method",
+    api_name => "open-ils.circ.checkout.full"
+);
+__PACKAGE__->register_method(
+    method   => "run_method",
+    api_name => "open-ils.circ.checkout.full.override"
+);
+__PACKAGE__->register_method(
+    method   => "run_method",
+    api_name => "open-ils.circ.reservation.pickup"
+);
+__PACKAGE__->register_method(
+    method   => "run_method",
+    api_name => "open-ils.circ.reservation.return"
+);
+__PACKAGE__->register_method(
+    method   => "run_method",
+    api_name => "open-ils.circ.checkout.inspect",
+    desc     => q/Returns the circ matrix test result and, on success, the rule set and matrix test object/
+);
+
+
+sub run_method {
+    my( $self, $conn, $auth, $args ) = @_;
+    translate_legacy_args($args);
+    my $api = $self->api_name;
+
+    my $circulator = 
+        OpenILS::Application::Circ::Circulator->new($auth, %$args);
+
+    return circ_events($circulator) if $circulator->bail_out;
+
+    $circulator->use_booking(determine_booking_status());
+
+    # --------------------------------------------------------------------------
+    # First, check for a booking transit, as the barcode may not be a copy
+    # barcode, but a resource barcode, and nothing else in here will work
+    # --------------------------------------------------------------------------
+
+    if ($circulator->use_booking && (my $bc = $circulator->copy_barcode) && $api !~ /checkout|inspect/) { # do we have a barcode?
+        my $resources = $circulator->editor->search_booking_resource( { barcode => $bc } ); # any resources by this barcode?
+        if (@$resources) { # yes!
+
+            my $res_id_list = [ map { $_->id } @$resources ];
+            my $transit = $circulator->editor->search_action_reservation_transit_copy(
+                [
+                    { target_copy => $res_id_list, dest => $circulator->circ_lib, dest_recv_time => undef },
+                    { order_by => { artc => 'source_send_time' }, limit => 1 }
+                ]
+            )->[0]; # Any transit for this barcode?
+
+            if ($transit) { # yes! unwrap it.
+
+                my $reservation = $circulator->editor->retrieve_booking_reservation( $transit->reservation );
+                my $res_type    = $circulator->editor->retrieve_booking_resource_type( $reservation->target_resource_type );
+
+                my $success_event = new OpenILS::Event(
+                    "SUCCESS", "payload" => {"reservation" => $reservation}
+                );
+                if ($U->is_true($res_type->catalog_item)) { # is there a copy to be had here?
+                    if (my $copy = $circulator->editor->search_asset_copy([
+                        { barcode => $bc, deleted => 'f' }, $MK_ENV_FLESH
+                    ])->[0]) { # got a copy
+                        $copy->status( $transit->copy_status );
+                        $copy->editor($circulator->editor->requestor->id);
+                        $copy->edit_date('now');
+                        $circulator->editor->update_asset_copy($copy);
+                        $success_event->{"payload"}->{"record"} =
+                            $U->record_to_mvr($copy->call_number->record);
+                        $copy->call_number($copy->call_number->id);
+                        $success_event->{"payload"}->{"copy"} = $copy;
+                    }
+                }
+
+                $transit->dest_recv_time('now');
+                $circulator->editor->update_action_reservation_transit_copy( $transit );
+
+                $circulator->editor->commit;
+                # Formerly this branch just stopped here. Argh!
+                $conn->respond_complete($success_event);
+                return;
+            }
+        }
+    }
+            
+    
+
+    # --------------------------------------------------------------------------
+    # Go ahead and load the script runner to make sure we have all 
+    # of the objects we need
+    # --------------------------------------------------------------------------
+
+    if ($circulator->use_booking) {
+        $circulator->is_res_checkin($circulator->is_checkin(1))
+            if $api =~ /reservation.return/ or (
+                $api =~ /checkin/ and $circulator->seems_like_reservation()
+            );
+
+        $circulator->is_res_checkout(1) if $api =~ /reservation.pickup/;
+    }
+
+    $circulator->is_renewal(1) if $api =~ /renew/;
+    $circulator->is_checkin(1) if $api =~ /checkin/;
+
+    $circulator->mk_env();
+    $circulator->noop(1) if $circulator->claims_never_checked_out;
+
+    if($legacy_script_support and not $circulator->is_checkin) {
+        $circulator->mk_script_runner();
+        $circulator->legacy_script_support(1);
+        $circulator->circ_permit_patron($scripts{circ_permit_patron});
+        $circulator->circ_permit_copy($scripts{circ_permit_copy});      
+        $circulator->circ_duration($scripts{circ_duration});             
+        $circulator->circ_permit_renew($scripts{circ_permit_renew});
+    }
+    return circ_events($circulator) if $circulator->bail_out;
+
+    
+    $circulator->override(1) if $api =~ /override/o;
+
+    if( $api =~ /checkout\.permit/ ) {
+        $circulator->do_permit();
+
+    } elsif( $api =~ /checkout.full/ ) {
+
+        # requesting a precat checkout implies that any required
+        # overrides have been performed.  Go ahead and re-override.
+        $circulator->skip_permit_key(1);
+        $circulator->override(1) if $circulator->request_precat;
+        $circulator->do_permit();
+        $circulator->is_checkout(1);
+        unless( $circulator->bail_out ) {
+            $circulator->events([]);
+            $circulator->do_checkout();
+        }
+
+    } elsif( $circulator->is_res_checkout ) {
+        $circulator->do_reservation_pickup();
+
+    } elsif( $api =~ /inspect/ ) {
+        my $data = $circulator->do_inspect();
+        $circulator->editor->rollback;
+        return $data;
+
+    } elsif( $api =~ /checkout/ ) {
+        $circulator->is_checkout(1);
+        $circulator->do_checkout();
+
+    } elsif( $circulator->is_res_checkin ) {
+        $circulator->do_reservation_return();
+        $circulator->do_checkin() if ($circulator->copy());
+    } elsif( $api =~ /checkin/ ) {
+        $circulator->do_checkin();
+
+    } elsif( $api =~ /renew/ ) {
+        $circulator->is_renewal(1);
+        $circulator->do_renew();
+    }
+
+    if( $circulator->bail_out ) {
+
+        my @ee;
+        # make sure no success event accidentally slip in
+        $circulator->events(
+            [ grep { $_->{textcode} ne 'SUCCESS' } @{$circulator->events} ]);
+
+        # Log the events
+        my @e = @{$circulator->events};
+        push( @ee, $_->{textcode} ) for @e;
+        $logger->info("circulator: bailing out with events: " . (join ", ", @ee));
+
+        $circulator->editor->rollback;
+
+    } else {
+        $circulator->editor->commit;
+    }
+
+    $circulator->script_runner->cleanup if $circulator->script_runner;
+    
+    $conn->respond_complete(circ_events($circulator));
+
+    unless($circulator->bail_out) {
+        $circulator->do_hold_notify($circulator->notify_hold)
+            if $circulator->notify_hold;
+        $circulator->retarget_holds if $circulator->retarget;
+        $circulator->append_reading_list;
+        $circulator->make_trigger_events;
+    }
+}
+
+sub circ_events {
+    my $circ = shift;
+    my @e = @{$circ->events};
+    # if we have multiple events, SUCCESS should not be one of them;
+    @e = grep { $_->{textcode} ne 'SUCCESS' } @e if @e > 1;
+    return (@e == 1) ? $e[0] : \@e;
+}
+
+
+sub translate_legacy_args {
+    my $args = shift;
+
+    if( $$args{barcode} ) {
+        $$args{copy_barcode} = $$args{barcode};
+        delete $$args{barcode};
+    }
+
+    if( $$args{copyid} ) {
+        $$args{copy_id} = $$args{copyid};
+        delete $$args{copyid};
+    }
+
+    if( $$args{patronid} ) {
+        $$args{patron_id} = $$args{patronid};
+        delete $$args{patronid};
+    }
+
+    if( $$args{patron} and !ref($$args{patron}) ) {
+        $$args{patron_id} = $$args{patron};
+        delete $$args{patron};
+    }
+
+
+    if( $$args{noncat} ) {
+        $$args{is_noncat} = $$args{noncat};
+        delete $$args{noncat};
+    }
+
+    if( $$args{precat} ) {
+        $$args{is_precat} = $$args{request_precat} = $$args{precat};
+        delete $$args{precat};
+    }
+}
+
+
+
+# --------------------------------------------------------------------------
+# This package actually manages all of the circulation logic
+# --------------------------------------------------------------------------
+package OpenILS::Application::Circ::Circulator;
+use strict; use warnings;
+use vars q/$AUTOLOAD/;
+use DateTime;
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::Cache;
+use Digest::MD5 qw(md5_hex);
+use DateTime::Format::ISO8601;
+use OpenILS::Utils::PermitHold;
+use OpenSRF::Utils qw/:datetime/;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Application::Circ::Holds;
+use OpenILS::Application::Circ::Transit;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenILS::Application::Circ::ScriptBuilder;
+use OpenILS::Const qw/:const/;
+use OpenILS::Utils::Penalty;
+use OpenILS::Application::Circ::CircCommon;
+use Time::Local;
+
+my $holdcode    = "OpenILS::Application::Circ::Holds";
+my $transcode   = "OpenILS::Application::Circ::Transit";
+my %user_groups;
+
+sub DESTROY { }
+
+
+# --------------------------------------------------------------------------
+# Add a pile of automagic getter/setter methods
+# --------------------------------------------------------------------------
+my @AUTOLOAD_FIELDS = qw/
+    notify_hold
+    remote_hold
+    backdate
+    reservation
+    copy
+    copy_id
+    copy_barcode
+    patron
+    patron_id
+    patron_barcode
+    script_runner
+    volume
+    title
+    is_renewal
+    is_checkout
+    is_res_checkout
+    is_precat
+    is_noncat
+    request_precat
+    is_checkin
+    is_res_checkin
+    noncat_type
+    editor
+    events
+    cache_handle
+    override
+    circ_permit_patron
+    circ_permit_copy
+    circ_duration
+    circ_recurring_fines
+    circ_max_fines
+    circ_permit_renew
+    circ
+    transit
+    hold
+    permit_key
+    noncat_circ_lib
+    noncat_count
+    checkout_time
+    dummy_title
+    dummy_author
+    dummy_isbn
+    circ_modifier
+    circ_lib
+    barcode
+    duration_level
+    recurring_fines_level
+    duration_rule
+    recurring_fines_rule
+    max_fine_rule
+    renewal_remaining
+    hard_due_date
+    due_date
+    fulfilled_holds
+    transit
+    checkin_changed
+    force
+    permit_override
+    pending_checkouts
+    cancelled_hold_transit
+    opac_renewal
+    phone_renewal
+    desk_renewal
+    sip_renewal
+    retarget
+    matrix_test_result
+    circ_matrix_matchpoint
+    circ_test_success
+    legacy_script_support
+    is_deposit
+    is_rental
+    deposit_billing
+    rental_billing
+    capture
+    noop
+    void_overdues
+    parent_circ
+    return_patron
+    claims_never_checked_out
+    skip_permit_key
+    skip_deposit_fee
+    skip_rental_fee
+    use_booking
+/;
+
+
+sub AUTOLOAD {
+    my $self = shift;
+    my $type = ref($self) or die "$self is not an object";
+    my $data = shift;
+    my $name = $AUTOLOAD;
+    $name =~ s/.*://o;   
+
+    unless (grep { $_ eq $name } @AUTOLOAD_FIELDS) {
+        $logger->error("circulator: $type: invalid autoload field: $name");
+        die "$type: invalid autoload field: $name\n" 
+    }
+
+    {
+        no strict 'refs';
+        *{"${type}::${name}"} = sub {
+            my $s = shift;
+            my $v = shift;
+            $s->{$name} = $v if defined $v;
+            return $s->{$name};
+        }
+    }
+    return $self->$name($data);
+}
+
+
+sub new {
+    my( $class, $auth, %args ) = @_;
+    $class = ref($class) || $class;
+    my $self = bless( {}, $class );
+
+    $self->events([]);
+    $self->editor(new_editor(xact => 1, authtoken => $auth));
+
+    unless( $self->editor->checkauth ) {
+        $self->bail_on_events($self->editor->event);
+        return $self;
+    }
+
+    $self->cache_handle(OpenSRF::Utils::Cache->new('global'));
+
+    $self->$_($args{$_}) for keys %args;
+
+    $self->circ_lib(
+        ($self->circ_lib) ? $self->circ_lib : $self->editor->requestor->ws_ou);
+
+    # if this is a renewal, default to desk_renewal
+    $self->desk_renewal(1) unless 
+        $self->opac_renewal or $self->phone_renewal or $self->sip_renewal;
+
+    $self->capture('') unless $self->capture;
+
+    unless(%user_groups) {
+        my $gps = $self->editor->retrieve_all_permission_grp_tree;
+        %user_groups = map { $_->id => $_ } @$gps;
+    }
+
+    return $self;
+}
+
+
+# --------------------------------------------------------------------------
+# True if we should discontinue processing
+# --------------------------------------------------------------------------
+sub bail_out {
+    my( $self, $bool ) = @_;
+    if( defined $bool ) {
+        $logger->info("circulator: BAILING OUT") if $bool;
+        $self->{bail_out} = $bool;
+    }
+    return $self->{bail_out};
+}
+
+
+sub push_events {
+    my( $self, @evts ) = @_;
+    for my $e (@evts) {
+        next unless $e;
+        $e->{payload} = $self->copy if 
+              ($e->{textcode} eq 'COPY_NOT_AVAILABLE');
+
+        $logger->info("circulator: pushing event ".$e->{textcode});
+        push( @{$self->events}, $e ) unless
+            grep { $_->{textcode} eq $e->{textcode} } @{$self->events};
+    }
+}
+
+sub mk_permit_key {
+    my $self = shift;
+    return '' if $self->skip_permit_key;
+    my $key = md5_hex( time() . rand() . "$$" );
+    $self->cache_handle->put_cache( "oils_permit_key_$key", 1, 300 );
+    return $self->permit_key($key);
+}
+
+sub check_permit_key {
+    my $self = shift;
+    return 1 if $self->skip_permit_key;
+    my $key = $self->permit_key;
+    return 0 unless $key;
+    my $k = "oils_permit_key_$key";
+    my $one = $self->cache_handle->get_cache($k);
+    $self->cache_handle->delete_cache($k);
+    return ($one) ? 1 : 0;
+}
+
+sub seems_like_reservation {
+    my $self = shift;
+
+    # Some words about the following method:
+    # 1) It requires the VIEW_USER permission, but that's not an
+    # issue, right, since all staff should have that?
+    # 2) It returns only one reservation at a time, even if an item can be
+    # and is currently overbooked.  Hmmm....
+    my $booking_ses = create OpenSRF::AppSession("open-ils.booking");
+    my $result = $booking_ses->request(
+        "open-ils.booking.reservations.by_returnable_resource_barcode",
+        $self->editor->authtoken,
+        $self->copy_barcode
+    )->gather(1);
+    $booking_ses->disconnect;
+
+    return $self->bail_on_events($result) if defined $U->event_code($result);
+
+    if (@$result > 0) {
+        $self->reservation(shift @$result);
+        return 1;
+    } else {
+        return 0;
+    }
+
+}
+
+# save_trimmed_copy() used just to be a block in mk_env(), but was separated for re-use
+sub save_trimmed_copy {
+    my ($self, $copy) = @_;
+
+    $self->copy($copy);
+    $self->volume($copy->call_number);
+    $self->title($self->volume->record);
+    $self->copy->call_number($self->volume->id);
+    $self->volume->record($self->title->id);
+    $self->is_precat(1) if $self->volume->id == OILS_PRECAT_CALL_NUMBER;
+    if($self->copy->deposit_amount and $self->copy->deposit_amount > 0) {
+        $self->is_deposit(1) if $U->is_true($self->copy->deposit);
+        $self->is_rental(1) unless $U->is_true($self->copy->deposit);
+    }
+}
+
+sub mk_env {
+    my $self = shift;
+    my $e = $self->editor;
+
+    # --------------------------------------------------------------------------
+    # Grab the fleshed copy
+    # --------------------------------------------------------------------------
+    unless($self->is_noncat) {
+        my $copy;
+	    if($self->copy_id) {
+		    $copy = $e->retrieve_asset_copy(
+			    [$self->copy_id, $MK_ENV_FLESH ]) or return $e->event;
+    
+	    } elsif( $self->copy_barcode ) {
+    
+		    $copy = $e->search_asset_copy(
+			    [{barcode => $self->copy_barcode, deleted => 'f'}, $MK_ENV_FLESH ])->[0];
+	    } elsif( $self->reservation ) {
+            my $res = $e->json_query(
+                {
+                    "select" => {"acp" => ["id"]},
+                    "from" => {
+                        "acp" => {
+                            "brsrc" => {
+                                "fkey" => "barcode",
+                                "field" => "barcode",
+                                "join" => {
+                                    "bresv" => {
+                                        "fkey" => "id",
+                                        "field" => "current_resource"
+                                    }
+                                }
+                            }
+                        }
+                    },
+                    "where" => {
+                        "+bresv" => {
+                            "id" => (ref $self->reservation) ?
+                                $self->reservation->id : $self->reservation
+                        }
+                    }
+                }
+            );
+            if (ref $res eq "ARRAY" and scalar @$res) {
+                $logger->info("circulator: mapped reservation " .
+                    $self->reservation . " to copy " . $res->[0]->{"id"});
+                $copy = $e->retrieve_asset_copy([$res->[0]->{"id"}, $MK_ENV_FLESH]);
+            }
+        }
+    
+        if($copy) {
+            $self->save_trimmed_copy($copy);
+        } else {
+            # We can't renew if there is no copy
+            return $self->bail_on_events(OpenILS::Event->new('ASSET_COPY_NOT_FOUND'))
+                if $self->is_renewal;
+            $self->is_precat(1);
+        }
+    }
+
+    # --------------------------------------------------------------------------
+    # Grab the patron
+    # --------------------------------------------------------------------------
+    my $patron;
+	my $flesh = {
+		flesh => 1,
+		flesh_fields => {au => [ qw/ card / ]}
+	};
+
+	if( $self->patron_id ) {
+		$patron = $e->retrieve_actor_user([$self->patron_id, $flesh])
+			or return $self->bail_on_events(OpenILS::Event->new('ACTOR_USER_NOT_FOUND'));
+
+	} elsif( $self->patron_barcode ) {
+
+		# note: throwing ACTOR_USER_NOT_FOUND instead of ACTOR_CARD_NOT_FOUND is intentional
+		my $card = $e->search_actor_card({barcode => $self->patron_barcode})->[0] 
+			or return $self->bail_on_events(OpenILS::Event->new('ACTOR_USER_NOT_FOUND'));
+
+		$patron = $e->search_actor_user([{card => $card->id}, $flesh])->[0]
+			or return $self->bail_on_events(OpenILS::Event->new('ACTOR_USER_NOT_FOUND'));
+
+    } else {
+        if( my $copy = $self->copy ) {
+
+            $flesh->{flesh} = 2;
+            $flesh->{flesh_fields}->{circ} = ['usr'];
+
+            my $circ = $e->search_action_circulation([
+                {target_copy => $copy->id, checkin_time => undef}, $flesh
+            ])->[0];
+
+            if($circ) {
+                $patron = $circ->usr;
+                $circ->usr($patron->id); # de-flesh for consistency
+                $self->circ($circ); 
+            }
+        }
+    }
+
+    return $self->bail_on_events(OpenILS::Event->new('ACTOR_USER_NOT_FOUND'))
+        unless $self->patron($patron) or $self->is_checkin;
+
+    unless($self->is_checkin) {
+
+        # Check for inactivity and patron reg. expiration
+
+        $self->bail_on_events(OpenILS::Event->new('PATRON_INACTIVE'))
+			unless $U->is_true($patron->active);
+	
+		$self->bail_on_events(OpenILS::Event->new('PATRON_CARD_INACTIVE'))
+			unless $U->is_true($patron->card->active);
+	
+		my $expire = DateTime::Format::ISO8601->new->parse_datetime(
+			cleanse_ISO8601($patron->expire_date));
+	
+		$self->bail_on_events(OpenILS::Event->new('PATRON_ACCOUNT_EXPIRED'))
+			if( CORE::time > $expire->epoch ) ;
+    }
+}
+
+# --------------------------------------------------------------------------
+# This builds the script runner environment and fetches most of the
+# objects we need
+# --------------------------------------------------------------------------
+sub mk_script_runner {
+    my $self = shift;
+    my $args = {};
+
+
+    my @fields = 
+        qw/copy copy_barcode copy_id patron 
+            patron_id patron_barcode volume title editor/;
+
+    # Translate our objects into the ScriptBuilder args hash
+    $$args{$_} = $self->$_() for @fields;
+
+    $args->{ignore_user_status} = 1 if $self->is_checkin;
+    $$args{fetch_patron_by_circ_copy} = 1;
+    $$args{fetch_patron_circ_info} = 1 unless $self->is_checkin;
+
+    if( my $pco = $self->pending_checkouts ) {
+        $logger->info("circulator: we were given a pending checkouts number of $pco");
+        $$args{patronItemsOut} = $pco;
+    }
+
+    # This fetches most of the objects we need
+    $self->script_runner(
+        OpenILS::Application::Circ::ScriptBuilder->build($args));
+
+    # Now we translate the ScriptBuilder objects back into self
+    $self->$_($$args{$_}) for @fields;
+
+    my @evts = @{$args->{_events}} if $args->{_events};
+
+    $logger->debug("circulator: script builder returned events: @evts") if @evts;
+
+
+    if(@evts) {
+        # Anything besides ASSET_COPY_NOT_FOUND will stop processing
+        if(!$self->is_noncat and 
+            @evts == 1 and 
+            $evts[0]->{textcode} eq 'ASSET_COPY_NOT_FOUND') {
+                $self->is_precat(1);
+
+        } else {
+            my @e = grep { $_->{textcode} ne 'ASSET_COPY_NOT_FOUND' } @evts;
+            return $self->bail_on_events(@e);
+        }
+    }
+
+    if($self->copy) {
+        $self->is_precat(1) if $self->copy->call_number == OILS_PRECAT_CALL_NUMBER;
+        if($self->copy->deposit_amount and $self->copy->deposit_amount > 0) {
+            $self->is_deposit(1) if $U->is_true($self->copy->deposit);
+            $self->is_rental(1) unless $U->is_true($self->copy->deposit);
+        }
+    }
+
+    # We can't renew if there is no copy
+    return $self->bail_on_events(@evts) if 
+        $self->is_renewal and !$self->copy;
+
+    # Set some circ-specific flags in the script environment
+    my $evt = "environment";
+    $self->script_runner->insert("$evt.isRenewal", ($self->is_renewal) ? 1 : undef);
+
+    if( $self->is_noncat ) {
+      $self->script_runner->insert("$evt.isNonCat", 1);
+      $self->script_runner->insert("$evt.nonCatType", $self->noncat_type);
+    }
+
+    if( $self->is_precat ) {
+        $self->script_runner->insert("environment.isPrecat", 1, 1);
+    }
+
+    $self->script_runner->add_path( $_ ) for @$script_libs;
+
+    return 1;
+}
+
+# --------------------------------------------------------------------------
+# Does the circ permit work
+# --------------------------------------------------------------------------
+sub do_permit {
+    my $self = shift;
+
+    $self->log_me("do_permit()");
+
+    unless( $self->editor->requestor->id == $self->patron->id ) {
+        return $self->bail_on_events($self->editor->event)
+            unless( $self->editor->allowed('VIEW_PERMIT_CHECKOUT') );
+    }
+
+    $self->check_captured_holds();
+    $self->do_copy_checks();
+    return if $self->bail_out;
+    $self->run_patron_permit_scripts();
+    $self->run_copy_permit_scripts() 
+        unless $self->is_precat or $self->is_noncat;
+    $self->check_item_deposit_events();
+    $self->override_events();
+    return if $self->bail_out;
+
+    if($self->is_precat and not $self->request_precat) {
+        $self->push_events(
+            OpenILS::Event->new(
+                'ITEM_NOT_CATALOGED', payload => $self->mk_permit_key));
+        return $self->bail_out(1) unless $self->is_renewal;
+    }
+
+    $self->push_events(
+        OpenILS::Event->new('SUCCESS', payload => $self->mk_permit_key));
+}
+
+sub check_item_deposit_events {
+    my $self = shift;
+    $self->push_events(OpenILS::Event->new('ITEM_DEPOSIT_REQUIRED', payload => $self->copy)) 
+        if $self->is_deposit and not $self->is_deposit_exempt;
+    $self->push_events(OpenILS::Event->new('ITEM_RENTAL_FEE_REQUIRED', payload => $self->copy)) 
+        if $self->is_rental and not $self->is_rental_exempt;
+}
+
+# returns true if the user is not required to pay deposits
+sub is_deposit_exempt {
+    my $self = shift;
+    my $pid = (ref $self->patron->profile) ?
+        $self->patron->profile->id : $self->patron->profile;
+    my $groups = $U->ou_ancestor_setting_value(
+        $self->circ_lib, 'circ.deposit.exempt_groups', $self->editor);
+    for my $grp (@$groups) {
+        return 1 if $self->is_group_descendant($grp, $pid);
+    }
+    return 0;
+}
+
+# returns true if the user is not required to pay rental fees
+sub is_rental_exempt {
+    my $self = shift;
+    my $pid = (ref $self->patron->profile) ?
+        $self->patron->profile->id : $self->patron->profile;
+    my $groups = $U->ou_ancestor_setting_value(
+        $self->circ_lib, 'circ.rental.exempt_groups', $self->editor);
+    for my $grp (@$groups) {
+        return 1 if $self->is_group_descendant($grp, $pid);
+    }
+    return 0;
+}
+
+sub is_group_descendant {
+    my($self, $p_id, $c_id) = @_;
+    return 0 unless defined $p_id and defined $c_id;
+    return 1 if $c_id == $p_id;
+    while(my $grp = $user_groups{$c_id}) {
+        $c_id = $grp->parent;
+        return 0 unless defined $c_id;
+        return 1 if $c_id == $p_id;
+    }
+    return 0;
+}
+
+sub check_captured_holds {
+   my $self    = shift;
+   my $copy    = $self->copy;
+   my $patron  = $self->patron;
+
+    return undef unless $copy;
+
+    my $s = $U->copy_status($copy->status)->id;
+    return unless $s == OILS_COPY_STATUS_ON_HOLDS_SHELF;
+    $logger->info("circulator: copy is on holds shelf, searching for the correct hold");
+
+    # Item is on the holds shelf, make sure it's going to the right person
+    my $holds   = $self->editor->search_action_hold_request(
+        [
+            { 
+                current_copy        => $copy->id , 
+                capture_time        => { '!=' => undef },
+                cancel_time         => undef, 
+                fulfillment_time    => undef 
+            },
+            { limit => 1 }
+        ]
+    );
+
+    if( $holds and $$holds[0] ) {
+        return undef if $$holds[0]->usr == $patron->id;
+    }
+
+    $logger->info("circulator: this copy is needed by a different patron to fulfill a hold");
+
+    $self->push_events(OpenILS::Event->new('ITEM_ON_HOLDS_SHELF'));
+}
+
+
+sub do_copy_checks {
+    my $self = shift;
+    my $copy = $self->copy;
+    return unless $copy;
+
+    my $stat = $U->copy_status($copy->status)->id;
+
+    # We cannot check out a copy if it is in-transit
+    if( $stat == OILS_COPY_STATUS_IN_TRANSIT ) {
+        return $self->bail_on_events(OpenILS::Event->new('COPY_IN_TRANSIT'));
+    }
+
+    $self->handle_claims_returned();
+    return if $self->bail_out;
+
+    # no claims returned circ was found, check if there is any open circ
+    unless( $self->is_renewal ) {
+
+        my $circs = $self->editor->search_action_circulation(
+            { target_copy => $copy->id, checkin_time => undef }
+        );
+
+        if(my $old_circ = $circs->[0]) { # an open circ was found
+
+            my $payload = {copy => $copy};
+
+            if($old_circ->usr == $self->patron->id) {
+                
+                $payload->{old_circ} = $old_circ;
+
+                # If there is an open circulation on the checkout item and an auto-renew 
+                # interval is defined, inform the caller that they should go 
+                # ahead and renew the item instead of warning about open circulations.
+    
+                my $auto_renew_intvl = $U->ou_ancestor_setting_value(        
+                    $self->circ_lib,
+                    'circ.checkout_auto_renew_age', 
+                    $self->editor
+                );
+
+                if($auto_renew_intvl) {
+                    my $intvl_seconds = OpenSRF::Utils->interval_to_seconds($auto_renew_intvl);
+                    my $checkout_time = DateTime::Format::ISO8601->new->parse_datetime( cleanse_ISO8601($old_circ->xact_start) );
+
+                    if(DateTime->now > $checkout_time->add(seconds => $intvl_seconds)) {
+                        $payload->{auto_renew} = 1;
+                    }
+                }
+            }
+
+            return $self->bail_on_events(
+                OpenILS::Event->new('OPEN_CIRCULATION_EXISTS', payload => $payload)
+            );
+        }
+    }
+}
+
+my $LEGACY_CIRC_EVENT_MAP = {
+    'no_item' => 'ITEM_NOT_CATALOGED',
+    'actor.usr.barred' => 'PATRON_BARRED',
+    'asset.copy.circulate' =>  'COPY_CIRC_NOT_ALLOWED',
+    'asset.copy.status' => 'COPY_NOT_AVAILABLE',
+    'asset.copy_location.circulate' => 'COPY_CIRC_NOT_ALLOWED',
+    'config.circ_matrix_test.circulate' => 'COPY_CIRC_NOT_ALLOWED',
+    'config.circ_matrix_test.max_items_out' =>  'PATRON_EXCEEDS_CHECKOUT_COUNT',
+    'config.circ_matrix_test.max_overdue' =>  'PATRON_EXCEEDS_OVERDUE_COUNT',
+    'config.circ_matrix_test.max_fines' => 'PATRON_EXCEEDS_FINES',
+    'config.circ_matrix_circ_mod_test' => 'PATRON_EXCEEDS_CHECKOUT_COUNT',
+};
+
+
+# ---------------------------------------------------------------------
+# This pushes any patron-related events into the list but does not
+# set bail_out for any events
+# ---------------------------------------------------------------------
+sub run_patron_permit_scripts {
+    my $self        = shift;
+    my $runner      = $self->script_runner;
+    my $patronid    = $self->patron->id;
+
+    my @allevents; 
+
+    if(!$self->legacy_script_support) {
+
+        my $results = $self->run_indb_circ_test;
+        unless($self->circ_test_success) {
+            # no_item result is OK during noncat checkout
+            unless(@$results == 1 && $results->[0]->{fail_part} eq 'no_item' and $self->is_noncat) {
+                push @allevents, $self->matrix_test_result_events;
+            }
+        }
+
+    } else {
+
+        # --------------------------------------------------------------------- 
+        # # Now run the patron permit script 
+        # ---------------------------------------------------------------------
+        $runner->load($self->circ_permit_patron);
+        my $result = $runner->run or 
+            throw OpenSRF::EX::ERROR ("Circ Permit Patron Script Died: $@");
+
+        my $patron_events = $result->{events};
+
+        OpenILS::Utils::Penalty->calculate_penalties($self->editor, $self->patron->id, $self->circ_lib);
+        my $mask = ($self->is_renewal) ? 'RENEW' : 'CIRC';
+        my $penalties = OpenILS::Utils::Penalty->retrieve_penalties($self->editor, $patronid, $self->circ_lib, $mask);
+        $penalties = $penalties->{fatal_penalties};
+
+        for my $pen (@$penalties) {
+            my $event = OpenILS::Event->new($pen->name);
+            $event->{desc} = $pen->label;
+            push(@allevents, $event);
+        }
+
+        push(@allevents, OpenILS::Event->new($_)) for (@$patron_events);
+    }
+
+    for (@allevents) {
+       $_->{payload} = $self->copy if 
+             ($_->{textcode} eq 'COPY_NOT_AVAILABLE');
+    }
+
+    $logger->info("circulator: permit_patron script returned events: @allevents") if @allevents;
+
+    $self->push_events(@allevents);
+}
+
+sub matrix_test_result_codes {
+    my $self = shift;
+    map { $_->{"fail_part"} } @{$self->matrix_test_result};
+}
+
+sub matrix_test_result_events {
+    my $self = shift;
+    map {
+        my $event = new OpenILS::Event(
+            $LEGACY_CIRC_EVENT_MAP->{$_->{"fail_part"}} || $_->{"fail_part"}
+        );
+        $event->{"payload"} = {"fail_part" => $_->{"fail_part"}};
+        $event;
+    } (@{$self->matrix_test_result});
+}
+
+sub run_indb_circ_test {
+    my $self = shift;
+    return $self->matrix_test_result if $self->matrix_test_result;
+
+    my $dbfunc = ($self->is_renewal) ? 
+        'action.item_user_renew_test' : 'action.item_user_circ_test';
+
+    if( $self->is_precat && $self->request_precat) {
+        $self->make_precat_copy;
+        return if $self->bail_out;
+    }
+
+    my $results = $self->editor->json_query(
+        {   from => [
+                $dbfunc,
+                $self->circ_lib,
+                ($self->is_noncat or ($self->is_precat and !$self->override and !$self->is_renewal)) ? undef : $self->copy->id, 
+                $self->patron->id,
+            ]
+        }
+    );
+
+    $self->circ_test_success($U->is_true($results->[0]->{success}));
+
+    if(my $mp = $results->[0]->{matchpoint}) {
+        $logger->info("circulator: circ policy test found matchpoint $mp");
+        $self->circ_matrix_matchpoint(
+            $self->editor->retrieve_config_circ_matrix_matchpoint([
+                $mp,
+                {   flesh => 1,
+                    flesh_fields => {ccmm => 
+                        ['duration_rule', 'recurring_fine_rule', 'max_fine_rule', 'hard_due_date']}
+                }
+            ])
+        );
+    }
+
+    return $self->matrix_test_result($results);
+}
+
+# ---------------------------------------------------------------------
+# given a use and copy, this will calculate the circulation policy
+# parameters.  Only works with in-db circ.
+# ---------------------------------------------------------------------
+sub do_inspect {
+    my $self = shift;
+
+    return OpenILS::Event->new('ASSET_COPY_NOT_FOUND') unless $self->copy;
+
+    $self->run_indb_circ_test;
+
+    my $results = {
+        circ_test_success => $self->circ_test_success,
+        failure_events => [],
+        failure_codes => [],
+        matchpoint => $self->circ_matrix_matchpoint
+    };
+
+    unless($self->circ_test_success) {
+        $results->{"failure_codes"} = [ $self->matrix_test_result_codes ];
+        $results->{"failure_events"} = [ $self->matrix_test_result_events ];
+    }
+
+    if($self->circ_matrix_matchpoint) {
+        my $duration_rule = $self->circ_matrix_matchpoint->duration_rule;
+        my $recurring_fine_rule = $self->circ_matrix_matchpoint->recurring_fine_rule;
+        my $max_fine_rule = $self->circ_matrix_matchpoint->max_fine_rule;
+        my $hard_due_date = $self->circ_matrix_matchpoint->hard_due_date;
+    
+        my $policy = $self->get_circ_policy(
+            $duration_rule, $recurring_fine_rule, $max_fine_rule, $hard_due_date);
+    
+        $$results{$_} = $$policy{$_} for keys %$policy;
+    }
+
+    return $results;
+}
+
+# ---------------------------------------------------------------------
+# Loads the circ policy info for duration, recurring fine, and max
+# fine based on the current copy
+# ---------------------------------------------------------------------
+sub get_circ_policy {
+    my($self, $duration_rule, $recurring_fine_rule, $max_fine_rule, $hard_due_date) = @_;
+
+    my $policy = {
+        duration_rule => $duration_rule->name,
+        recurring_fine_rule => $recurring_fine_rule->name,
+        max_fine_rule => $max_fine_rule->name,
+        max_fine => $self->get_max_fine_amount($max_fine_rule),
+        fine_interval => $recurring_fine_rule->recurrence_interval,
+        renewal_remaining => $duration_rule->max_renewals
+    };
+
+    if($hard_due_date) {
+        $policy->{duration_date_ceiling} = $hard_due_date->ceiling_date;
+        $policy->{duration_date_ceiling_force} = $hard_due_date->forceto;
+    }
+    else {
+        $policy->{duration_date_ceiling} = undef;
+        $policy->{duration_date_ceiling_force} = undef;
+    }
+
+    $policy->{duration} = $duration_rule->shrt
+        if $self->copy->loan_duration == OILS_CIRC_DURATION_SHORT;
+    $policy->{duration} = $duration_rule->normal
+        if $self->copy->loan_duration == OILS_CIRC_DURATION_NORMAL;
+    $policy->{duration} = $duration_rule->extended
+        if $self->copy->loan_duration == OILS_CIRC_DURATION_EXTENDED;
+
+    $policy->{recurring_fine} = $recurring_fine_rule->low
+        if $self->copy->fine_level == OILS_REC_FINE_LEVEL_LOW;
+    $policy->{recurring_fine} = $recurring_fine_rule->normal
+        if $self->copy->fine_level == OILS_REC_FINE_LEVEL_NORMAL;
+    $policy->{recurring_fine} = $recurring_fine_rule->high
+        if $self->copy->fine_level == OILS_REC_FINE_LEVEL_HIGH;
+
+    return $policy;
+}
+
+sub get_max_fine_amount {
+    my $self = shift;
+    my $max_fine_rule = shift;
+    my $max_amount = $max_fine_rule->amount;
+
+    # if is_percent is true then the max->amount is
+    # use as a percentage of the copy price
+    if ($U->is_true($max_fine_rule->is_percent)) {
+        my $price = $U->get_copy_price($self->editor, $self->copy, $self->volume);
+        $max_amount = $price * $max_fine_rule->amount / 100;
+    } elsif (
+        $U->ou_ancestor_setting_value(
+            $self->circ_lib,
+            'circ.max_fine.cap_at_price',
+            $self->editor
+        )
+    ) {
+        my $price = $U->get_copy_price($self->editor, $self->copy, $self->volume);
+        $max_amount = ( $price && $max_amount > $price ) ? $price : $max_amount;
+    }
+
+    return $max_amount;
+}
+
+
+
+sub run_copy_permit_scripts {
+    my $self = shift;
+    my $copy = $self->copy || return;
+    my $runner = $self->script_runner;
+
+    my @allevents;
+
+    if(!$self->legacy_script_support) {
+        my $results = $self->run_indb_circ_test;
+        push @allevents, $self->matrix_test_result_events
+            unless $self->circ_test_success;
+    } else {
+    
+       # ---------------------------------------------------------------------
+       # Capture all of the copy permit events
+       # ---------------------------------------------------------------------
+       $runner->load($self->circ_permit_copy);
+       my $result = $runner->run or 
+            throw OpenSRF::EX::ERROR ("Circ Permit Copy Script Died: $@");
+       my $copy_events = $result->{events};
+
+       # ---------------------------------------------------------------------
+       # Now collect all of the events together
+       # ---------------------------------------------------------------------
+       push( @allevents, OpenILS::Event->new($_)) for @$copy_events;
+    }
+
+    # See if this copy has an alert message
+    my $ae = $self->check_copy_alert();
+    push( @allevents, $ae ) if $ae;
+
+   # uniquify the events
+   my %hash = map { ($_->{ilsevent} => $_) } @allevents;
+   @allevents = values %hash;
+
+    $logger->info("circulator: permit_copy script returned events: @allevents") if @allevents;
+
+    $self->push_events(@allevents);
+}
+
+
+sub check_copy_alert {
+    my $self = shift;
+    return undef if $self->is_renewal;
+    return OpenILS::Event->new(
+        'COPY_ALERT_MESSAGE', payload => $self->copy->alert_message)
+        if $self->copy and $self->copy->alert_message;
+    return undef;
+}
+
+
+
+# --------------------------------------------------------------------------
+# If the call is overriding and has permissions to override every collected
+# event, the are cleared.  Any event that the caller does not have
+# permission to override, will be left in the event list and bail_out will
+# be set
+# XXX We need code in here to cancel any holds/transits on copies 
+# that are being force-checked out
+# --------------------------------------------------------------------------
+sub override_events {
+    my $self = shift;
+    my @events = @{$self->events};
+    return unless @events;
+
+    if(!$self->override) {
+        return $self->bail_out(1) 
+            if( @events > 1 or $events[0]->{textcode} ne 'SUCCESS' );
+    }   
+
+    $self->events([]);
+    
+   for my $e (@events) {
+      my $tc = $e->{textcode};
+      next if $tc eq 'SUCCESS';
+      my $ov = "$tc.override";
+      $logger->info("circulator: attempting to override event: $ov");
+
+        return $self->bail_on_events($self->editor->event)
+            unless( $self->editor->allowed($ov) );
+   }
+}
+    
+
+# --------------------------------------------------------------------------
+# If there is an open claimsreturn circ on the requested copy, close the 
+# circ if overriding, otherwise bail out
+# --------------------------------------------------------------------------
+sub handle_claims_returned {
+    my $self = shift;
+    my $copy = $self->copy;
+
+    my $CR = $self->editor->search_action_circulation(
+        {   
+            target_copy     => $copy->id,
+            stop_fines      => OILS_STOP_FINES_CLAIMSRETURNED,
+            checkin_time    => undef,
+        }
+    );
+
+    return unless ($CR = $CR->[0]); 
+
+    my $evt;
+
+    # - If the caller has set the override flag, we will check the item in
+    if($self->override) {
+
+        $CR->checkin_time('now');   
+        $CR->checkin_scan_time('now');   
+        $CR->checkin_lib($self->circ_lib);
+        $CR->checkin_workstation($self->editor->requestor->wsid);
+        $CR->checkin_staff($self->editor->requestor->id);
+
+        $evt = $self->editor->event 
+            unless $self->editor->update_action_circulation($CR);
+
+    } else {
+        $evt = OpenILS::Event->new('CIRC_CLAIMS_RETURNED');
+    }
+
+    $self->bail_on_events($evt) if $evt;
+    return;
+}
+
+
+# --------------------------------------------------------------------------
+# This performs the checkout
+# --------------------------------------------------------------------------
+sub do_checkout {
+    my $self = shift;
+
+    $self->log_me("do_checkout()");
+
+    # make sure perms are good if this isn't a renewal
+    unless( $self->is_renewal ) {
+        return $self->bail_on_events($self->editor->event)
+            unless( $self->editor->allowed('COPY_CHECKOUT') );
+    }
+
+    # verify the permit key
+    unless( $self->check_permit_key ) {
+        if( $self->permit_override ) {
+            return $self->bail_on_events($self->editor->event)
+                unless $self->editor->allowed('CIRC_PERMIT_OVERRIDE');
+        } else {
+            return $self->bail_on_events(OpenILS::Event->new('CIRC_PERMIT_BAD_KEY'))
+        }   
+    }
+
+    # if this is a non-cataloged circ, build the circ and finish
+    if( $self->is_noncat ) {
+        $self->checkout_noncat;
+        $self->push_events(
+            OpenILS::Event->new('SUCCESS', 
+            payload => { noncat_circ => $self->circ }));
+        return;
+    }
+
+    if( $self->is_precat ) {
+        $self->make_precat_copy;
+        return if $self->bail_out;
+
+    } elsif( $self->copy->call_number == OILS_PRECAT_CALL_NUMBER ) {
+        return $self->bail_on_events(OpenILS::Event->new('ITEM_NOT_CATALOGED'));
+    }
+
+    $self->do_copy_checks;
+    return if $self->bail_out;
+
+    $self->run_checkout_scripts();
+    return if $self->bail_out;
+
+    $self->build_checkout_circ_object();
+    return if $self->bail_out;
+
+    my $modify_to_start = $self->booking_adjusted_due_date();
+    return if $self->bail_out;
+
+    $self->apply_modified_due_date($modify_to_start);
+    return if $self->bail_out;
+
+    return $self->bail_on_events($self->editor->event)
+        unless $self->editor->create_action_circulation($self->circ);
+
+    # refresh the circ to force local time zone for now
+    $self->circ($self->editor->retrieve_action_circulation($self->circ->id));
+
+    $self->copy->status(OILS_COPY_STATUS_CHECKED_OUT);
+    $self->update_copy;
+    return if $self->bail_out;
+
+    $self->apply_deposit_fee();
+    return if $self->bail_out;
+
+    $self->handle_checkout_holds();
+    return if $self->bail_out;
+
+    # ------------------------------------------------------------------------------
+    # Update the patron penalty info in the DB.  Run it for permit-overrides 
+    # since the penalties are not updated during the permit phase
+    # ------------------------------------------------------------------------------
+    OpenILS::Utils::Penalty->calculate_penalties($self->editor, $self->patron->id, $self->circ_lib);
+
+    my $record = $U->record_to_mvr($self->title) unless $self->is_precat;
+    
+    my $pcirc;
+    if($self->is_renewal) {
+        # flesh the billing summary for the checked-in circ
+        $pcirc = $self->editor->retrieve_action_circulation([
+            $self->parent_circ,
+            {flesh => 2, flesh_fields => {circ => ['billable_transaction'], mbt => ['summary']}}
+        ]);
+    }
+
+    $self->push_events(
+        OpenILS::Event->new('SUCCESS',
+            payload  => {
+                copy             => $U->unflesh_copy($self->copy),
+                circ             => $self->circ,
+                record           => $record,
+                holds_fulfilled  => $self->fulfilled_holds,
+                deposit_billing  => $self->deposit_billing,
+                rental_billing   => $self->rental_billing,
+                parent_circ      => $pcirc,
+                patron           => ($self->return_patron) ? $self->patron : undef,
+                patron_money     => $self->editor->retrieve_money_user_summary($self->patron->id)
+            }
+        )
+    );
+}
+
+sub apply_deposit_fee {
+    my $self = shift;
+    my $copy = $self->copy;
+    return unless 
+        ($self->is_deposit and not $self->is_deposit_exempt) or 
+        ($self->is_rental and not $self->is_rental_exempt);
+
+    return if $self->is_deposit and $self->skip_deposit_fee;
+    return if $self->is_rental and $self->skip_rental_fee;
+
+	my $bill = Fieldmapper::money::billing->new;
+    my $amount = $copy->deposit_amount;
+    my $billing_type;
+    my $btype;
+
+    if($self->is_deposit) {
+        $billing_type = OILS_BILLING_TYPE_DEPOSIT;
+        $btype = 5;
+        $self->deposit_billing($bill);
+    } else {
+        $billing_type = OILS_BILLING_TYPE_RENTAL;
+        $btype = 6;
+        $self->rental_billing($bill);
+    }
+
+	$bill->xact($self->circ->id);
+	$bill->amount($amount);
+	$bill->note(OILS_BILLING_NOTE_SYSTEM);
+	$bill->billing_type($billing_type);
+	$bill->btype($btype);
+    $self->editor->create_money_billing($bill) or $self->bail_on_events($self->editor->event);
+
+	$logger->info("circulator: charged $amount on checkout with billing type $billing_type");
+}
+
+sub update_copy {
+    my $self = shift;
+    my $copy = $self->copy;
+
+    my $stat = $copy->status if ref $copy->status;
+    my $loc = $copy->location if ref $copy->location;
+    my $circ_lib = $copy->circ_lib if ref $copy->circ_lib;
+
+    $copy->status($stat->id) if $stat;
+    $copy->location($loc->id) if $loc;
+    $copy->circ_lib($circ_lib->id) if $circ_lib;
+    $copy->editor($self->editor->requestor->id);
+    $copy->edit_date('now');
+    $copy->age_protect($copy->age_protect->id) if ref $copy->age_protect;
+
+    return $self->bail_on_events($self->editor->event)
+        unless $self->editor->update_asset_copy($self->copy);
+
+    $copy->status($U->copy_status($copy->status));
+    $copy->location($loc) if $loc;
+    $copy->circ_lib($circ_lib) if $circ_lib;
+}
+
+sub update_reservation {
+    my $self = shift;
+    my $reservation = $self->reservation;
+
+    my $usr = $reservation->usr;
+    my $target_rt = $reservation->target_resource_type;
+    my $target_r = $reservation->target_resource;
+    my $current_r = $reservation->current_resource;
+
+    $reservation->usr($usr->id) if ref $usr;
+    $reservation->target_resource_type($target_rt->id) if ref $target_rt;
+    $reservation->target_resource($target_r->id) if ref $target_r;
+    $reservation->current_resource($current_r->id) if ref $current_r;
+
+    return $self->bail_on_events($self->editor->event)
+        unless $self->editor->update_booking_reservation($self->reservation);
+
+    my $evt;
+    ($reservation, $evt) = $U->fetch_booking_reservation($reservation->id);
+    $self->reservation($reservation);
+}
+
+
+sub bail_on_events {
+    my( $self, @evts ) = @_;
+    $self->push_events(@evts);
+    $self->bail_out(1);
+}
+
+
+# ------------------------------------------------------------------------------
+# When an item is checked out, see if we can fulfill a hold for this patron
+# ------------------------------------------------------------------------------
+sub handle_checkout_holds {
+   my $self    = shift;
+   my $copy    = $self->copy;
+   my $patron  = $self->patron;
+
+   my $e = $self->editor;
+   $self->fulfilled_holds([]);
+
+   # pre/non-cats can't fulfill a hold
+   return if $self->is_precat or $self->is_noncat;
+
+    my $hold = $e->search_action_hold_request({   
+        current_copy        => $copy->id , 
+        cancel_time         => undef, 
+        fulfillment_time    => undef,
+        '-or' => [
+            {expire_time => undef},
+            {expire_time => {'>' => 'now'}}
+        ]
+    })->[0];
+
+    if($hold and $hold->usr != $patron->id) {
+        # reset the hold since the copy is now checked out
+    
+        $logger->info("circulator: un-targeting hold ".$hold->id.
+            " because copy ".$copy->id." is getting checked out");
+
+        $hold->clear_prev_check_time; 
+        $hold->clear_current_copy;
+        $hold->clear_capture_time;
+
+        return $self->bail_on_event($e->event)
+            unless $e->update_action_hold_request($hold);
+
+        $hold = undef;
+    }
+
+    unless($hold) {
+        $hold = $self->find_related_user_hold($copy, $patron) or return;
+        $logger->info("circulator: found related hold to fulfill in checkout");
+    }
+
+    $logger->debug("circulator: checkout fulfilling hold " . $hold->id);
+
+    # if the hold was never officially captured, capture it.
+    $hold->current_copy($copy->id);
+    $hold->capture_time('now') unless $hold->capture_time;
+    $hold->fulfillment_time('now');
+    $hold->fulfillment_staff($e->requestor->id);
+    $hold->fulfillment_lib($self->circ_lib);
+
+    return $self->bail_on_events($e->event)
+        unless $e->update_action_hold_request($hold);
+
+    $holdcode->delete_hold_copy_maps($e, $hold->id);
+    return $self->fulfilled_holds([$hold->id]);
+}
+
+
+# ------------------------------------------------------------------------------
+# If the circ.checkout_fill_related_hold setting is turned on and no hold for
+# the patron directly targets the checked out item, see if there is another hold 
+# (with hold_type T or V) for the patron that could be fulfilled by the checked 
+# out item.  Fulfill the oldest hold and only fulfill 1 of them.
+# ------------------------------------------------------------------------------
+sub find_related_user_hold {
+    my($self, $copy, $patron) = @_;
+    my $e = $self->editor;
+
+    return undef if $self->volume->id == OILS_PRECAT_CALL_NUMBER; 
+
+    return undef unless $U->ou_ancestor_setting_value(        
+        $self->circ_lib, 'circ.checkout_fills_related_hold', $e);
+
+    # find the oldest unfulfilled hold that has not yet hit the holds shelf.
+    my $args = {
+        select => {ahr => ['id']}, 
+        from => {
+            ahr => {
+                acp => {
+                    field => 'id', 
+                    fkey => 'current_copy',
+                    type => 'left' # there may be no current_copy
+                }
+            }
+        }, 
+        where => {
+            '+ahr' => {
+                usr => $patron->id,
+                fulfillment_time => undef,
+                cancel_time => undef,
+               '-or' => [
+                    {expire_time => undef},
+                    {expire_time => {'>' => 'now'}}
+                ]
+            },
+            '-or' => [
+                {
+                    '+ahr' => { 
+                        hold_type => 'V',
+                        target => $self->volume->id
+                    }
+                },
+                { 
+                    '+ahr' => { 
+                        hold_type => 'T',
+                        target => $self->title->id
+                    }
+                },
+            ],
+            '+acp' => {
+                '-or' => [
+                    {id => undef}, # left-join copy may be nonexistent
+                    {status => {'!=' => OILS_COPY_STATUS_ON_HOLDS_SHELF}},
+                ]
+            }
+        },
+        order_by => {ahr => {request_time => {direction => 'asc'}}},
+        limit => 1
+    };
+
+    my $hold_info = $e->json_query($args)->[0];
+    return $e->retrieve_action_hold_request($hold_info->{id}) if $hold_info;
+    return undef;
+}
+
+
+sub run_checkout_scripts {
+    my $self = shift;
+    my $nobail = shift;
+
+    my $evt;
+    my $runner = $self->script_runner;
+
+    my $duration;
+    my $recurring;
+    my $max_fine;
+    my $hard_due_date;
+    my $duration_name;
+    my $recurring_name;
+    my $max_fine_name;
+    my $hard_due_date_name;
+
+    if(!$self->legacy_script_support) {
+        $self->run_indb_circ_test();
+        $duration = $self->circ_matrix_matchpoint->duration_rule;
+        $recurring = $self->circ_matrix_matchpoint->recurring_fine_rule;
+        $max_fine = $self->circ_matrix_matchpoint->max_fine_rule;
+        $hard_due_date = $self->circ_matrix_matchpoint->hard_due_date;
+
+    } else {
+
+       $runner->load($self->circ_duration);
+
+       my $result = $runner->run or 
+            throw OpenSRF::EX::ERROR ("Circ Duration Script Died: $@");
+
+       $duration_name   = $result->{durationRule};
+       $recurring_name  = $result->{recurringFinesRule};
+       $max_fine_name   = $result->{maxFine};
+       $hard_due_date_name  = $result->{hardDueDate};
+    }
+
+    $duration_name = $duration->name if $duration;
+    if( $duration_name ne OILS_UNLIMITED_CIRC_DURATION ) {
+
+        unless($duration) {
+            ($duration, $evt) = $U->fetch_circ_duration_by_name($duration_name);
+            return $self->bail_on_events($evt) if ($evt && !$nobail);
+        
+            ($recurring, $evt) = $U->fetch_recurring_fine_by_name($recurring_name);
+            return $self->bail_on_events($evt) if ($evt && !$nobail);
+        
+            ($max_fine, $evt) = $U->fetch_max_fine_by_name($max_fine_name);
+            return $self->bail_on_events($evt) if ($evt && !$nobail);
+
+            if($hard_due_date_name) {
+                ($hard_due_date, $evt) = $U->fetch_hard_due_date_by_name($hard_due_date_name);
+                return $self->bail_on_events($evt) if ($evt && !$nobail);
+            }
+        }
+
+    } else {
+
+        # The item circulates with an unlimited duration
+        $duration   = undef;
+        $recurring  = undef;
+        $max_fine   = undef;
+        $hard_due_date = undef;
+    }
+
+   $self->duration_rule($duration);
+   $self->recurring_fines_rule($recurring);
+   $self->max_fine_rule($max_fine);
+   $self->hard_due_date($hard_due_date);
+}
+
+
+sub build_checkout_circ_object {
+    my $self = shift;
+
+   my $circ       = Fieldmapper::action::circulation->new;
+   my $duration   = $self->duration_rule;
+   my $max        = $self->max_fine_rule;
+   my $recurring  = $self->recurring_fines_rule;
+   my $hard_due_date    = $self->hard_due_date;
+   my $copy       = $self->copy;
+   my $patron     = $self->patron;
+   my $duration_date_ceiling;
+   my $duration_date_ceiling_force;
+
+    if( $duration ) {
+
+        my $policy = $self->get_circ_policy($duration, $recurring, $max, $hard_due_date);
+        $duration_date_ceiling = $policy->{duration_date_ceiling};
+        $duration_date_ceiling_force = $policy->{duration_date_ceiling_force};
+
+        my $dname = $duration->name;
+        my $mname = $max->name;
+        my $rname = $recurring->name;
+        my $hdname = ''; 
+        if($hard_due_date) {
+            $hdname = $hard_due_date->name;
+        }
+
+        $logger->debug("circulator: building circulation ".
+            "with duration=$dname, maxfine=$mname, recurring=$rname, hard due date=$hdname");
+    
+        $circ->duration($policy->{duration});
+        $circ->recurring_fine($policy->{recurring_fine});
+        $circ->duration_rule($duration->name);
+        $circ->recurring_fine_rule($recurring->name);
+        $circ->max_fine_rule($max->name);
+        $circ->max_fine($policy->{max_fine});
+        $circ->fine_interval($recurring->recurrence_interval);
+        $circ->renewal_remaining($duration->max_renewals);
+
+    } else {
+
+        $logger->info("circulator: copy found with an unlimited circ duration");
+        $circ->duration_rule(OILS_UNLIMITED_CIRC_DURATION);
+        $circ->recurring_fine_rule(OILS_UNLIMITED_CIRC_DURATION);
+        $circ->max_fine_rule(OILS_UNLIMITED_CIRC_DURATION);
+        $circ->renewal_remaining(0);
+    }
+
+   $circ->target_copy( $copy->id );
+   $circ->usr( $patron->id );
+   $circ->circ_lib( $self->circ_lib );
+   $circ->workstation($self->editor->requestor->wsid) 
+    if defined $self->editor->requestor->wsid;
+
+    # renewals maintain a link to the parent circulation
+    $circ->parent_circ($self->parent_circ);
+
+   if( $self->is_renewal ) {
+      $circ->opac_renewal('t') if $self->opac_renewal;
+      $circ->phone_renewal('t') if $self->phone_renewal;
+      $circ->desk_renewal('t') if $self->desk_renewal;
+      $circ->renewal_remaining($self->renewal_remaining);
+      $circ->circ_staff($self->editor->requestor->id);
+   }
+
+
+    # if the user provided an overiding checkout time,
+    # (e.g. the checkout really happened several hours ago), then
+    # we apply that here.  Does this need a perm??
+    $circ->xact_start(cleanse_ISO8601($self->checkout_time))
+        if $self->checkout_time;
+
+    # if a patron is renewing, 'requestor' will be the patron
+    $circ->circ_staff($self->editor->requestor->id);
+    $circ->due_date( $self->create_due_date($circ->duration, $duration_date_ceiling, $duration_date_ceiling_force) ) if $circ->duration;
+
+    $self->circ($circ);
+}
+
+sub do_reservation_pickup {
+    my $self = shift;
+
+    $self->log_me("do_reservation_pickup()");
+
+    $self->reservation->pickup_time('now');
+
+    if (
+        $self->reservation->current_resource &&
+        $U->is_true($self->reservation->target_resource_type->catalog_item)
+    ) {
+        # We used to try to set $self->copy and $self->patron here,
+        # but that should already be done.
+
+        $self->run_checkout_scripts(1);
+
+        my $duration   = $self->duration_rule;
+        my $max        = $self->max_fine_rule;
+        my $recurring  = $self->recurring_fines_rule;
+
+        if ($duration && $max && $recurring) {
+            my $policy = $self->get_circ_policy($duration, $recurring, $max);
+
+            my $dname = $duration->name;
+            my $mname = $max->name;
+            my $rname = $recurring->name;
+
+            $logger->debug("circulator: updating reservation ".
+                "with duration=$dname, maxfine=$mname, recurring=$rname");
+
+            $self->reservation->fine_amount($policy->{recurring_fine});
+            $self->reservation->max_fine($policy->{max_fine});
+            $self->reservation->fine_interval($recurring->recurrence_interval);
+        }
+
+        $self->copy->status(OILS_COPY_STATUS_CHECKED_OUT);
+        $self->update_copy();
+
+    } else {
+        $self->reservation->fine_amount(
+            $self->reservation->target_resource_type->fine_amount
+        );
+        $self->reservation->max_fine(
+            $self->reservation->target_resource_type->max_fine
+        );
+        $self->reservation->fine_interval(
+            $self->reservation->target_resource_type->fine_interval
+        );
+    }
+
+    $self->update_reservation();
+}
+
+sub do_reservation_return {
+    my $self = shift;
+    my $request = shift;
+
+    $self->log_me("do_reservation_return()");
+
+    if (not ref $self->reservation) {
+        my ($reservation, $evt) =
+            $U->fetch_booking_reservation($self->reservation);
+        return $self->bail_on_events($evt) if $evt;
+        $self->reservation($reservation);
+    }
+
+    $self->generate_fines(1);
+    $self->reservation->return_time('now');
+    $self->update_reservation();
+    $self->reshelve_copy if $self->copy;
+
+    if ( $self->reservation->current_resource && $self->reservation->current_resource->catalog_item ) {
+        $self->copy( $self->reservation->current_resource->catalog_item );
+    }
+}
+
+sub booking_adjusted_due_date {
+    my $self = shift;
+    my $circ = $self->circ;
+    my $copy = $self->copy;
+
+    return undef unless $self->use_booking;
+
+    my $changed;
+
+    if( $self->due_date ) {
+
+        return $self->bail_on_events($self->editor->event)
+            unless $self->editor->allowed('CIRC_OVERRIDE_DUE_DATE', $self->circ_lib);
+
+       $circ->due_date(cleanse_ISO8601($self->due_date));
+
+    } else {
+
+        return unless $copy and $circ->due_date;
+    }
+
+    my $booking_items = $self->editor->search_booking_resource( { barcode => $copy->barcode } );
+    if (@$booking_items) {
+        my $booking_item = $booking_items->[0];
+        my $resource_type = $self->editor->retrieve_booking_resource_type( $booking_item->type );
+
+        my $stop_circ_setting = $U->ou_ancestor_setting_value( $self->circ_lib, 'circ.booking_reservation.stop_circ', $self->editor );
+        my $shorten_circ_setting = $resource_type->elbow_room ||
+            $U->ou_ancestor_setting_value( $self->circ_lib, 'circ.booking_reservation.default_elbow_room', $self->editor ) ||
+            '0 seconds';
+
+        my $booking_ses = OpenSRF::AppSession->create( 'open-ils.booking' );
+        my $bookings = $booking_ses->request(
+            'open-ils.booking.reservations.filtered_id_list', $self->editor->authtoken,
+            { resource => $booking_item->id, search_start => 'now', search_end => $circ->due_date, fields => { cancel_time => undef }}
+        )->gather(1);
+        $booking_ses->disconnect;
+        
+        my $dt_parser = DateTime::Format::ISO8601->new;
+        my $due_date = $dt_parser->parse_datetime( cleanse_ISO8601($circ->due_date) );
+
+        for my $bid (@$bookings) {
+
+            my $booking = $self->editor->retrieve_booking_reservation( $bid );
+
+            my $booking_start = $dt_parser->parse_datetime( cleanse_ISO8601($booking->start_time) );
+            my $booking_end = $dt_parser->parse_datetime( cleanse_ISO8601($booking->end_time) );
+
+            return $self->bail_on_events( OpenILS::Event->new('COPY_RESERVED') )
+                if ($booking_start < DateTime->now);
+
+
+            if ($U->is_true($stop_circ_setting)) {
+                $self->bail_on_events( OpenILS::Event->new('COPY_RESERVED') ); 
+            } else {
+                $due_date = $booking_start->subtract( seconds => interval_to_seconds($shorten_circ_setting) );
+                $self->bail_on_events( OpenILS::Event->new('COPY_RESERVED') ) if ($due_date < DateTime->now); 
+            }
+            
+            # We set the circ duration here only to affect the logic that will
+            # later (in a DB trigger) mangle the time part of the due date to
+            # 11:59pm. Having any circ duration that is not a whole number of
+            # days is enough to prevent the "correction."
+            my $new_circ_duration = $due_date->epoch - time;
+            $new_circ_duration++ if $new_circ_duration % 86400 == 0;
+            $circ->duration("$new_circ_duration seconds");
+
+            $circ->due_date(cleanse_ISO8601($due_date->strftime('%FT%T%z')));
+            $changed = 1;
+        }
+
+        return $self->bail_on_events($self->editor->event)
+            unless $self->editor->allowed('CIRC_OVERRIDE_DUE_DATE', $self->circ_lib);
+    }
+
+    return $changed;
+}
+
+sub apply_modified_due_date {
+    my $self = shift;
+    my $shift_earlier = shift;
+    my $circ = $self->circ;
+    my $copy = $self->copy;
+
+   if( $self->due_date ) {
+
+        return $self->bail_on_events($self->editor->event)
+            unless $self->editor->allowed('CIRC_OVERRIDE_DUE_DATE', $self->circ_lib);
+
+      $circ->due_date(cleanse_ISO8601($self->due_date));
+
+   } else {
+
+      # if the due_date lands on a day when the location is closed
+      return unless $copy and $circ->due_date;
+
+        #my $org = (ref $copy->circ_lib) ? $copy->circ_lib->id : $copy->circ_lib;
+
+        # due-date overlap should be determined by the location the item
+        # is checked out from, not the owning or circ lib of the item
+        my $org = $self->circ_lib;
+
+      $logger->info("circulator: circ searching for closed date overlap on lib $org".
+            " with an item due date of ".$circ->due_date );
+
+      my $dateinfo = $U->storagereq(
+         'open-ils.storage.actor.org_unit.closed_date.overlap', 
+            $org, $circ->due_date );
+
+      if($dateinfo) {
+         $logger->info("circulator: $dateinfo : circ due data / close date overlap found : due_date=".
+            $circ->due_date." start=". $dateinfo->{start}.", end=".$dateinfo->{end});
+
+            # XXX make the behavior more dynamic
+            # for now, we just push the due date to after the close date
+            if ($shift_earlier) {
+                $circ->due_date($dateinfo->{start});
+            } else {
+                $circ->due_date($dateinfo->{end});
+            }
+      }
+   }
+}
+
+
+
+sub create_due_date {
+    my( $self, $duration, $date_ceiling, $force_date ) = @_;
+
+    # if there is a raw time component (e.g. from postgres), 
+    # turn it into an interval that interval_to_seconds can parse
+    $duration =~ s/(\d{2}):(\d{2}):(\d{2})/$1 h $2 m $3 s/o;
+
+    # for now, use the server timezone.  TODO: use workstation org timezone
+    my $due_date = DateTime->now(time_zone => 'local');
+
+    # add the circ duration
+    $due_date->add(seconds => OpenSRF::Utils->interval_to_seconds($duration));
+
+    if($date_ceiling) {
+        my $cdate = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($date_ceiling));
+        if ($cdate > DateTime->now and ($cdate < $due_date or $U->is_true( $force_date ))) {
+            $logger->info("circulator: overriding due date with date ceiling: $date_ceiling");
+            $due_date = $cdate;
+        }
+    }
+
+    # return ISO8601 time with timezone
+    return $due_date->strftime('%FT%T%z');
+}
+
+
+
+sub make_precat_copy {
+    my $self = shift;
+    my $copy = $self->copy;
+
+   if($copy) {
+        $logger->debug("circulator: Pre-cat copy already exists in checkout: ID=" . $copy->id);
+
+        $copy->editor($self->editor->requestor->id);
+        $copy->edit_date('now');
+        $copy->dummy_title($self->dummy_title || $copy->dummy_title || '');
+        $copy->dummy_isbn($self->dummy_isbn || $copy->dummy_isbn || '');
+        $copy->dummy_author($self->dummy_author || $copy->dummy_author || '');
+        $copy->circ_modifier($self->circ_modifier || $copy->circ_modifier);
+        $self->update_copy();
+        return;
+   }
+
+    $logger->info("circulator: Creating a new precataloged ".
+        "copy in checkout with barcode " . $self->copy_barcode);
+
+    $copy = Fieldmapper::asset::copy->new;
+    $copy->circ_lib($self->circ_lib);
+    $copy->creator($self->editor->requestor->id);
+    $copy->editor($self->editor->requestor->id);
+    $copy->barcode($self->copy_barcode);
+    $copy->call_number(OILS_PRECAT_CALL_NUMBER); 
+    $copy->loan_duration(OILS_PRECAT_COPY_LOAN_DURATION);
+    $copy->fine_level(OILS_PRECAT_COPY_FINE_LEVEL);
+
+    $copy->dummy_title($self->dummy_title || "");
+    $copy->dummy_author($self->dummy_author || "");
+    $copy->dummy_isbn($self->dummy_isbn || "");
+    $copy->circ_modifier($self->circ_modifier);
+
+
+    # See if we need to override the circ_lib for the copy with a configured circ_lib
+    # Setting is shortname of the org unit
+    my $precat_circ_lib = $U->ou_ancestor_setting_value(
+        $self->circ_lib, 'circ.pre_cat_copy_circ_lib', $self->editor);
+
+    if($precat_circ_lib) {
+        my $org = $self->editor->search_actor_org_unit({shortname => $precat_circ_lib})->[0];
+
+        if(!$org) {
+            $self->bail_on_events($self->editor->event);
+            return;
+        }
+
+        $copy->circ_lib($org->id);
+    }
+
+
+    unless( $self->copy($self->editor->create_asset_copy($copy)) ) {
+        $self->bail_out(1);
+        $self->push_events($self->editor->event);
+        return;
+    }   
+
+    # this is a little bit of a hack, but we need to 
+    # get the copy into the script runner
+    $self->script_runner->insert("environment.copy", $copy, 1) if $self->script_runner;
+}
+
+
+sub checkout_noncat {
+    my $self = shift;
+
+    my $circ;
+    my $evt;
+
+   my $lib      = $self->noncat_circ_lib || $self->circ_lib;
+   my $count    = $self->noncat_count || 1;
+   my $cotime   = cleanse_ISO8601($self->checkout_time) || "";
+
+   $logger->info("circulator: circ creating $count noncat circs with checkout time $cotime");
+
+   for(1..$count) {
+
+      ( $circ, $evt ) = OpenILS::Application::Circ::NonCat::create_non_cat_circ(
+         $self->editor->requestor->id, 
+            $self->patron->id, 
+            $lib, 
+            $self->noncat_type, 
+            $cotime,
+            $self->editor );
+
+        if( $evt ) {
+            $self->push_events($evt);
+            $self->bail_out(1);
+            return; 
+        }
+        $self->circ($circ);
+   }
+}
+
+
+sub do_checkin {
+    my $self = shift;
+    $self->log_me("do_checkin()");
+
+    return $self->bail_on_events(
+        OpenILS::Event->new('ASSET_COPY_NOT_FOUND')) 
+        unless $self->copy;
+
+    # the renew code and mk_env should have already found our circulation object
+    unless( $self->circ ) {
+
+        my $circs = $self->editor->search_action_circulation(
+            { target_copy => $self->copy->id, checkin_time => undef });
+
+        $self->circ($$circs[0]);
+
+        # for now, just warn if there are multiple open circs on a copy
+        $logger->warn("circulator: we have ".scalar(@$circs).
+            " open circs for copy " .$self->copy->id."!!") if @$circs > 1;
+    }
+
+    # run the fine generator against this circ, if this circ is there
+    $self->generate_fines_start if $self->circ;
+
+
+    if( $self->checkin_check_holds_shelf() ) {
+        $self->bail_on_events(OpenILS::Event->new('NO_CHANGE'));
+        $self->hold($U->fetch_open_hold_by_copy($self->copy->id));
+        $self->checkin_flesh_events;
+        return;
+    }
+
+    unless( $self->is_renewal ) {
+        return $self->bail_on_events($self->editor->event)
+            unless $self->editor->allowed('COPY_CHECKIN');
+    }
+
+    $self->push_events($self->check_copy_alert());
+    $self->push_events($self->check_checkin_copy_status());
+
+    # if the circ is marked as 'claims returned', add the event to the list
+    $self->push_events(OpenILS::Event->new('CIRC_CLAIMS_RETURNED'))
+        if ($self->circ and $self->circ->stop_fines 
+                and $self->circ->stop_fines eq OILS_STOP_FINES_CLAIMSRETURNED);
+
+    $self->check_circ_deposit();
+
+    # handle the overridable events 
+    $self->override_events unless $self->is_renewal;
+    return if $self->bail_out;
+    
+    if( $self->copy ) {
+        $self->transit(
+            $self->editor->search_action_transit_copy(
+                { target_copy => $self->copy->id, dest_recv_time => undef }
+            )->[0]
+        ); 
+    }
+
+    if( $self->circ ) {
+        $self->checkin_handle_circ;
+        return if $self->bail_out;
+        $self->checkin_changed(1);
+
+    } elsif( $self->transit ) {
+        my $hold_transit = $self->process_received_transit;
+        $self->checkin_changed(1);
+
+        if( $self->bail_out ) { 
+            $self->checkin_flesh_events;
+            return;
+        }
+        
+        if( my $e = $self->check_checkin_copy_status() ) {
+            # If the original copy status is special, alert the caller
+            my $ev = $self->events;
+            $self->events([$e]);
+            $self->override_events;
+            return if $self->bail_out;
+            $self->events($ev);
+        }
+
+        if( $hold_transit or 
+                $U->copy_status($self->copy->status)->id 
+                    == OILS_COPY_STATUS_ON_HOLDS_SHELF ) {
+
+            my $hold;
+            if( $hold_transit ) {
+               $hold = $self->editor->retrieve_action_hold_request($hold_transit->hold);
+            } else {
+                   ($hold) = $U->fetch_open_hold_by_copy($self->copy->id);
+            }
+
+            $self->hold($hold);
+
+            if( $hold and $hold->cancel_time ) { # this transited hold was cancelled mid-transit
+
+                $logger->info("circulator: we received a transit on a cancelled hold " . $hold->id);
+                $self->reshelve_copy(1);
+                $self->cancelled_hold_transit(1);
+                $self->notify_hold(0); # don't notify for cancelled holds
+                return if $self->bail_out;
+
+            } else {
+
+                # hold transited to correct location
+                $self->checkin_flesh_events;
+                return;
+            }
+        } 
+
+    } elsif( $U->copy_status($self->copy->status)->id == OILS_COPY_STATUS_IN_TRANSIT ) {
+
+        $logger->warn("circulator: we have a copy ".$self->copy->barcode.
+            " that is in-transit, but there is no transit.. repairing");
+        $self->reshelve_copy(1);
+        return if $self->bail_out;
+    }
+
+    if( $self->is_renewal ) {
+        $self->push_events(OpenILS::Event->new('SUCCESS'));
+        return;
+    }
+
+   # ------------------------------------------------------------------------------
+   # Circulations and transits are now closed where necessary.  Now go on to see if
+   # this copy can fulfill a hold or needs to be routed to a different location
+   # ------------------------------------------------------------------------------
+
+    my $needed_for_something = 0; # formerly "needed_for_hold"
+
+    if(!$self->noop) { # /not/ a no-op checkin, capture for hold or put item into transit
+
+        if (!$self->remote_hold) {
+            if ($self->use_booking) {
+                my $potential_hold = $self->hold_capture_is_possible;
+                my $potential_reservation = $self->reservation_capture_is_possible;
+
+                if ($potential_hold and $potential_reservation) {
+                    $logger->info("circulator: item could fulfill either hold or reservation");
+                    $self->push_events(new OpenILS::Event(
+                        "HOLD_RESERVATION_CONFLICT",
+                        "hold" => $potential_hold,
+                        "reservation" => $potential_reservation
+                    ));
+                    return if $self->bail_out;
+                } elsif ($potential_hold) {
+                    $needed_for_something =
+                        $self->attempt_checkin_hold_capture;
+                } elsif ($potential_reservation) {
+                    $needed_for_something =
+                        $self->attempt_checkin_reservation_capture;
+                }
+            } else {
+                $needed_for_something = $self->attempt_checkin_hold_capture;
+            }
+        }
+        return if $self->bail_out;
+    
+        unless($needed_for_something) {
+            my $circ_lib = (ref $self->copy->circ_lib) ? 
+                    $self->copy->circ_lib->id : $self->copy->circ_lib;
+    
+            if( $self->remote_hold ) {
+                $circ_lib = $self->remote_hold->pickup_lib;
+                $logger->warn("circulator: Copy ".$self->copy->barcode.
+                    " is on a remote hold's shelf, sending to $circ_lib");
+            }
+    
+            $logger->debug("circulator: circlib=$circ_lib, workstation=".$self->circ_lib);
+    
+            if( $circ_lib == $self->circ_lib) {
+                # copy is where it needs to be, either for hold or reshelving
+    
+                $self->checkin_handle_precat();
+                return if $self->bail_out;
+    
+            } else {
+                # copy needs to transit "home", or stick here if it's a floating copy
+    
+                if ($U->is_true( $self->copy->floating ) && !$self->remote_hold) { # copy is floating, stick here
+                    $self->checkin_changed(1);
+                    $self->copy->circ_lib( $self->circ_lib );
+                    $self->update_copy;
+                } else {
+                    my $bc = $self->copy->barcode;
+                    $logger->info("circulator: copy $bc at the wrong location, sending to $circ_lib");
+                    $self->checkin_build_copy_transit($circ_lib);
+                    return if $self->bail_out;
+                    $self->push_events(OpenILS::Event->new('ROUTE_ITEM', org => $circ_lib));
+                }
+            }
+        }
+    } else { # no-op checkin
+        if ($U->is_true( $self->copy->floating )) { # XXX floating items still stick where they are even with no-op checkin?
+            $self->checkin_changed(1);
+            $self->copy->circ_lib( $self->circ_lib );
+            $self->update_copy;
+        }
+    }
+
+    if($self->claims_never_checked_out and 
+            $U->ou_ancestor_setting_value($self->circ->circ_lib, 'circ.claim_never_checked_out.mark_missing')) {
+
+        # the item was not supposed to be checked out to the user and should now be marked as missing
+        $self->copy->status(OILS_COPY_STATUS_MISSING);
+        $self->update_copy;
+
+    } else {
+        $self->reshelve_copy unless $needed_for_something;
+    }
+
+    return if $self->bail_out;
+
+    unless($self->checkin_changed) {
+
+        $self->push_events(OpenILS::Event->new('NO_CHANGE'));
+        my $stat = $U->copy_status($self->copy->status)->id;
+
+        $self->hold($U->fetch_open_hold_by_copy($self->copy->id))
+         if( $stat == OILS_COPY_STATUS_ON_HOLDS_SHELF );
+        $self->bail_out(1); # no need to commit anything
+
+    } else {
+
+        $self->push_events(OpenILS::Event->new('SUCCESS')) 
+            unless @{$self->events};
+    }
+
+    # gather any updates to the circ after fine generation, if there was a circ
+    $self->generate_fines_finish if ($self->circ);
+
+    OpenILS::Utils::Penalty->calculate_penalties(
+        $self->editor, $self->patron->id, $self->circ_lib) if $self->patron;
+
+    $self->checkin_flesh_events;
+    return;
+}
+
+# if a deposit was payed for this item, push the event
+sub check_circ_deposit {
+    my $self = shift;
+    return unless $self->circ;
+    my $deposit = $self->editor->search_money_billing(
+        {   btype => 5, 
+            xact => $self->circ->id, 
+            voided => 'f'
+        }, {idlist => 1})->[0];
+
+    $self->push_events(OpenILS::Event->new(
+        'ITEM_DEPOSIT_PAID', payload => $deposit)) if $deposit;
+}
+
+sub reshelve_copy {
+   my $self    = shift;
+   my $force   = $self->force || shift;
+   my $copy    = $self->copy;
+
+   my $stat = $U->copy_status($copy->status)->id;
+
+   if($force || (
+      $stat != OILS_COPY_STATUS_ON_HOLDS_SHELF and
+      $stat != OILS_COPY_STATUS_CATALOGING and
+      $stat != OILS_COPY_STATUS_IN_TRANSIT and
+      $stat != OILS_COPY_STATUS_RESHELVING  )) {
+
+        $copy->status( OILS_COPY_STATUS_RESHELVING );
+            $self->update_copy;
+            $self->checkin_changed(1);
+    }
+}
+
+
+# Returns true if the item is at the current location
+# because it was transited there for a hold and the 
+# hold has not been fulfilled
+sub checkin_check_holds_shelf {
+    my $self = shift;
+    return 0 unless $self->copy;
+
+    return 0 unless 
+        $U->copy_status($self->copy->status)->id ==
+            OILS_COPY_STATUS_ON_HOLDS_SHELF;
+
+    # find the hold that put us on the holds shelf
+    my $holds = $self->editor->search_action_hold_request(
+        { 
+            current_copy => $self->copy->id,
+            capture_time => { '!=' => undef },
+            fulfillment_time => undef,
+            cancel_time => undef,
+        }
+    );
+
+    unless(@$holds) {
+        $logger->warn("circulator: copy is on-holds-shelf, but there is no hold - reshelving");
+        $self->reshelve_copy(1);
+        return 0;
+    }
+
+    my $hold = $$holds[0];
+
+    $logger->info("circulator: we found a captured, un-fulfilled hold [".
+        $hold->id. "] for copy ".$self->copy->barcode);
+
+    if( $hold->pickup_lib == $self->circ_lib ) {
+        $logger->info("circulator: hold is for here .. we're done: ".$self->copy->barcode);
+        return 1;
+    }
+
+    $logger->info("circulator: hold is not for here..");
+    $self->remote_hold($hold);
+    return 0;
+}
+
+
+sub checkin_handle_precat {
+    my $self    = shift;
+   my $copy    = $self->copy;
+
+   if( $self->is_precat and ($copy->status != OILS_COPY_STATUS_CATALOGING) ) {
+        $copy->status(OILS_COPY_STATUS_CATALOGING);
+        $self->update_copy();
+        $self->checkin_changed(1);
+        $self->push_events(OpenILS::Event->new('ITEM_NOT_CATALOGED'));
+   }
+}
+
+
+sub checkin_build_copy_transit {
+    my $self            = shift;
+    my $dest            = shift;
+    my $copy       = $self->copy;
+   my $transit    = Fieldmapper::action::transit_copy->new;
+
+    #$dest  ||= (ref($copy->circ_lib)) ? $copy->circ_lib->id : $copy->circ_lib;
+    $logger->info("circulator: transiting copy to $dest");
+
+   $transit->source($self->circ_lib);
+   $transit->dest($dest);
+   $transit->target_copy($copy->id);
+   $transit->source_send_time('now');
+   $transit->copy_status( $U->copy_status($copy->status)->id );
+
+    $logger->debug("circulator: setting copy status on transit: ".$transit->copy_status);
+
+    return $self->bail_on_events($self->editor->event)
+        unless $self->editor->create_action_transit_copy($transit);
+
+   $copy->status(OILS_COPY_STATUS_IN_TRANSIT);
+    $self->update_copy;
+    $self->checkin_changed(1);
+}
+
+
+sub hold_capture_is_possible {
+    my $self = shift;
+    my $copy = $self->copy;
+
+    # we've been explicitly told not to capture any holds
+    return 0 if $self->capture eq 'nocapture';
+
+    # See if this copy can fulfill any holds
+    my $hold = $holdcode->find_nearest_permitted_hold(
+        $self->editor, $copy, $self->editor->requestor, 1 # check_only
+    );
+    return undef if ref $hold eq "HASH" and
+        $hold->{"textcode"} eq "ACTION_HOLD_REQUEST_NOT_FOUND";
+    return $hold;
+}
+
+sub reservation_capture_is_possible {
+    my $self = shift;
+    my $copy = $self->copy;
+
+    # we've been explicitly told not to capture any holds
+    return 0 if $self->capture eq 'nocapture';
+
+    my $booking_ses = OpenSRF::AppSession->connect("open-ils.booking");
+    my $resv = $booking_ses->request(
+        "open-ils.booking.reservations.could_capture",
+        $self->editor->authtoken, $copy->barcode
+    )->gather(1);
+    $booking_ses->disconnect;
+    if (ref($resv) eq "HASH" and exists $resv->{"textcode"}) {
+        $self->push_events($resv);
+    } else {
+        return $resv;
+    }
+}
+
+# returns true if the item was used (or may potentially be used 
+# in subsequent calls) to capture a hold.
+sub attempt_checkin_hold_capture {
+    my $self = shift;
+    my $copy = $self->copy;
+
+    # we've been explicitly told not to capture any holds
+    return 0 if $self->capture eq 'nocapture';
+
+    # See if this copy can fulfill any holds
+    my ($hold, undef, $retarget) = $holdcode->find_nearest_permitted_hold( 
+        $self->editor, $copy, $self->editor->requestor );
+
+    if(!$hold) {
+        $logger->debug("circulator: no potential permitted".
+            "holds found for copy ".$copy->barcode);
+        return 0;
+    }
+
+    if($self->capture ne 'capture') {
+        # see if this item is in a hold-capture-delay location
+        my $location = $self->editor->retrieve_asset_copy_location($self->copy->location);
+        if($U->is_true($location->hold_verify)) {
+            $self->bail_on_events(
+                OpenILS::Event->new('HOLD_CAPTURE_DELAYED', copy_location => $location));
+            return 1;
+        }
+    }
+
+    $self->retarget($retarget);
+
+    $logger->info("circulator: found permitted hold ".$hold->id." for copy, capturing...");
+
+    $hold->current_copy($copy->id);
+    $hold->capture_time('now');
+    $self->put_hold_on_shelf($hold) 
+        if $hold->pickup_lib == $self->circ_lib;
+
+    # prevent DB errors caused by fetching 
+    # holds from storage, and updating through cstore
+    $hold->clear_fulfillment_time;
+    $hold->clear_fulfillment_staff;
+    $hold->clear_fulfillment_lib;
+    $hold->clear_expire_time; 
+    $hold->clear_cancel_time;
+    $hold->clear_prev_check_time unless $hold->prev_check_time;
+
+    $self->bail_on_events($self->editor->event)
+        unless $self->editor->update_action_hold_request($hold);
+    $self->hold($hold);
+    $self->checkin_changed(1);
+
+    return 0 if $self->bail_out;
+
+    if( $hold->pickup_lib == $self->circ_lib ) {
+
+        # This hold was captured in the correct location
+        $copy->status(OILS_COPY_STATUS_ON_HOLDS_SHELF);
+        $self->push_events(OpenILS::Event->new('SUCCESS'));
+
+        #$self->do_hold_notify($hold->id);
+        $self->notify_hold($hold->id);
+
+    } else {
+    
+        # Hold needs to be picked up elsewhere.  Build a hold
+        # transit and route the item.
+        $self->checkin_build_hold_transit();
+        $copy->status(OILS_COPY_STATUS_IN_TRANSIT);
+        return 0 if $self->bail_out;
+        $self->push_events(OpenILS::Event->new('ROUTE_ITEM', org => $hold->pickup_lib));
+    }
+
+    # make sure we save the copy status
+    $self->update_copy;
+    return 1;
+}
+
+sub attempt_checkin_reservation_capture {
+    my $self = shift;
+    my $copy = $self->copy;
+
+    # we've been explicitly told not to capture any holds
+    return 0 if $self->capture eq 'nocapture';
+
+    my $booking_ses = OpenSRF::AppSession->connect("open-ils.booking");
+    my $evt = $booking_ses->request(
+        "open-ils.booking.resources.capture_for_reservation",
+        $self->editor->authtoken,
+        $copy->barcode,
+        1 # don't update copy - we probably have it locked
+    )->gather(1);
+    $booking_ses->disconnect;
+
+    if (ref($evt) ne "HASH" or not exists $evt->{"textcode"}) {
+        $logger->warn(
+            "open-ils.booking.resources.capture_for_reservation " .
+            "didn't return an event!"
+        );
+    } else {
+        if (
+            $evt->{"textcode"} eq "RESERVATION_NOT_FOUND" and
+            $evt->{"payload"}->{"fail_cause"} eq "not-transferable"
+        ) {
+            # not-transferable is an error event we'll pass on the user
+            $logger->warn("reservation capture attempted against non-transferable item");
+            $self->push_events($evt);
+            return 0;
+        } elsif ($evt->{"textcode"} eq "SUCCESS") {
+            # Re-retrieve copy as reservation capture may have changed
+            # its status and whatnot.
+            $logger->info(
+                "circulator: booking capture win on copy " . $self->copy->id
+            );
+            if (my $new_copy_status = $evt->{"payload"}->{"new_copy_status"}) {
+                $logger->info(
+                    "circulator: changing copy " . $self->copy->id .
+                    "'s status from " . $self->copy->status . " to " .
+                    $new_copy_status
+                );
+                $self->copy->status($new_copy_status);
+                $self->update_copy;
+            }
+            $self->reservation($evt->{"payload"}->{"reservation"});
+
+            if (exists $evt->{"payload"}->{"transit"}) {
+                $self->push_events(
+                    new OpenILS::Event(
+                        "ROUTE_ITEM",
+                        "org" => $evt->{"payload"}->{"transit"}->dest
+                    )
+                );
+            }
+            $self->checkin_changed(1);
+            return 1;
+        }
+    }
+    # other results are treated as "nothing to capture"
+    return 0;
+}
+
+sub do_hold_notify {
+    my( $self, $holdid ) = @_;
+
+    my $e = new_editor(xact => 1);
+    my $hold = $e->retrieve_action_hold_request($holdid) or return $e->die_event;
+    $e->rollback;
+    my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+    $ses->request('open-ils.trigger.event.autocreate', 'hold.available', $hold, $hold->pickup_lib);
+
+    $logger->info("circulator: running delayed hold notify process");
+
+#   my $notifier = OpenILS::Application::Circ::HoldNotify->new(
+#       hold_id => $holdid, editor => new_editor(requestor=>$self->editor->requestor));
+
+    my $notifier = OpenILS::Application::Circ::HoldNotify->new(
+        hold_id => $holdid, requestor => $self->editor->requestor);
+
+    $logger->debug("circulator: built hold notifier");
+
+    if(!$notifier->event) {
+
+        $logger->info("circulator: attempt at sending hold notification for hold $holdid");
+
+        my $stat = $notifier->send_email_notify;
+        if( $stat == '1' ) {
+            $logger->info("circulator: hold notify succeeded for hold $holdid");
+            return;
+        } 
+
+        $logger->debug("circulator:  * hold notify cancelled or failed for hold $holdid");
+
+    } else {
+        $logger->info("circulator: Not sending hold notification since the patron has no email address");
+    }
+}
+
+sub retarget_holds {
+    my $self = shift;
+    $logger->info("circulator: retargeting holds @{$self->retarget} after opportunistic capture");
+    my $ses = OpenSRF::AppSession->create('open-ils.storage');
+    $ses->request('open-ils.storage.action.hold_request.copy_targeter', undef, $self->retarget);
+    # no reason to wait for the return value
+    return;
+}
+
+sub checkin_build_hold_transit {
+    my $self = shift;
+
+   my $copy = $self->copy;
+   my $hold = $self->hold;
+   my $trans = Fieldmapper::action::hold_transit_copy->new;
+
+    $logger->debug("circulator: building hold transit for ".$copy->barcode);
+
+   $trans->hold($hold->id);
+   $trans->source($self->circ_lib);
+   $trans->dest($hold->pickup_lib);
+   $trans->source_send_time("now");
+   $trans->target_copy($copy->id);
+
+    # when the copy gets to its destination, it will recover
+    # this status - put it onto the holds shelf
+   $trans->copy_status(OILS_COPY_STATUS_ON_HOLDS_SHELF);
+
+    return $self->bail_on_events($self->editor->event)
+        unless $self->editor->create_action_hold_transit_copy($trans);
+}
+
+
+
+sub process_received_transit {
+    my $self = shift;
+    my $copy = $self->copy;
+    my $copyid = $self->copy->id;
+
+    my $status_name = $U->copy_status($copy->status)->name;
+    $logger->debug("circulator: attempting transit receive on ".
+        "copy $copyid. Copy status is $status_name");
+
+    my $transit = $self->transit;
+
+    if( $transit->dest != $self->circ_lib ) {
+        # - this item is in-transit to a different location
+
+        my $tid = $transit->id; 
+        my $loc = $self->circ_lib;
+        my $dest = $transit->dest;
+
+        $logger->info("circulator: Fowarding transit on copy which is destined ".
+            "for a different location. transit=$tid, copy=$copyid, current ".
+            "location=$loc, destination location=$dest");
+
+        my $evt = OpenILS::Event->new('ROUTE_ITEM', org => $dest, payload => {});
+
+        # grab the associated hold object if available
+        my $ht = $self->editor->retrieve_action_hold_transit_copy($tid);
+        $self->hold($self->editor->retrieve_action_hold_request($ht->hold)) if $ht;
+
+        return $self->bail_on_events($evt);
+    }
+
+    # The transit is received, set the receive time
+    $transit->dest_recv_time('now');
+    $self->bail_on_events($self->editor->event)
+        unless $self->editor->update_action_transit_copy($transit);
+
+    my $hold_transit = $self->editor->retrieve_action_hold_transit_copy($transit->id);
+
+    $logger->info("circulator: Recovering original copy status in transit: ".$transit->copy_status);
+    $copy->status( $transit->copy_status );
+    $self->update_copy();
+    return if $self->bail_out;
+
+    my $ishold = 0;
+    if($hold_transit) { 
+        my $hold = $self->editor->retrieve_action_hold_request($hold_transit->hold);
+
+        # hold has arrived at destination, set shelf time
+        $self->put_hold_on_shelf($hold);
+        $self->bail_on_events($self->editor->event)
+            unless $self->editor->update_action_hold_request($hold);
+        return if $self->bail_out;
+
+        $self->notify_hold($hold_transit->hold);
+        $ishold = 1;
+    }
+
+    $self->push_events( 
+        OpenILS::Event->new(
+        'SUCCESS', 
+        ishold => $ishold,
+      payload => { transit => $transit, holdtransit => $hold_transit } ));
+
+    return $hold_transit;
+}
+
+
+# ------------------------------------------------------------------
+# Sets the shelf_time and shelf_expire_time for a newly shelved hold
+# ------------------------------------------------------------------
+sub put_hold_on_shelf {
+    my($self, $hold) = @_;
+
+    $hold->shelf_time('now');
+
+    my $shelf_expire = $U->ou_ancestor_setting_value(
+        $self->circ_lib, 'circ.holds.default_shelf_expire_interval', $self->editor);
+
+    if($shelf_expire) {
+        my $seconds = OpenSRF::Utils->interval_to_seconds($shelf_expire);
+        my $expire_time = DateTime->now->add(seconds => $seconds);
+        $hold->shelf_expire_time($expire_time->strftime('%FT%T%z'));
+    }
+
+    return undef;
+}
+
+
+
+sub generate_fines {
+   my $self = shift;
+   my $reservation = shift;
+
+   $self->generate_fines_start($reservation);
+   $self->generate_fines_finish($reservation);
+
+   return undef;
+}
+
+sub generate_fines_start {
+   my $self = shift;
+   my $reservation = shift;
+
+   my $id = $reservation ? $self->reservation->id : $self->circ->id;
+
+   if (!exists($self->{_gen_fines_req})) {
+      $self->{_gen_fines_req} = OpenSRF::AppSession->create('open-ils.storage') 
+          ->request(
+             'open-ils.storage.action.circulation.overdue.generate_fines',
+             undef,
+             $id
+          );
+   }
+
+   return undef;
+}
+
+sub generate_fines_finish {
+   my $self = shift;
+   my $reservation = shift;
+
+   my $id = $reservation ? $self->reservation->id : $self->circ->id;
+
+   $self->{_gen_fines_req}->wait_complete;
+   delete($self->{_gen_fines_req});
+
+   # refresh the circ in case the fine generator set the stop_fines field
+   $self->reservation($self->editor->retrieve_booking_reservation($id)) if $reservation;
+   $self->circ($self->editor->retrieve_action_circulation($id)) if !$reservation;
+
+   return undef;
+}
+
+sub checkin_handle_circ {
+   my $self = shift;
+   my $circ = $self->circ;
+   my $copy = $self->copy;
+   my $evt;
+   my $obt;
+
+   $self->backdate($circ->xact_start) if $self->claims_never_checked_out;
+
+   # backdate the circ if necessary
+   if($self->backdate) {
+        my $evt = $self->checkin_handle_backdate;
+        return $self->bail_on_events($evt) if $evt;
+   }
+
+   if($self->void_overdues) {
+        my $evt = OpenILS::Application::Circ::CircCommon->void_overdues(
+            $self->editor, $circ, undef, 'System: Amnesty Checkin'); # TODO i18n for system-generated notes
+        return $self->bail_on_events($evt) if $evt;
+   }
+
+   if(!$circ->stop_fines) {
+      $circ->stop_fines(OILS_STOP_FINES_CHECKIN);
+      $circ->stop_fines(OILS_STOP_FINES_RENEW) if $self->is_renewal;
+      $circ->stop_fines(OILS_STOP_FINES_CLAIMS_NEVERCHECKEDOUT) if $self->claims_never_checked_out;
+      $circ->stop_fines_time('now');
+      $circ->stop_fines_time($self->backdate) if $self->backdate;
+   }
+
+    # Set the checkin vars since we have the item
+    $circ->checkin_time( ($self->backdate) ? $self->backdate : 'now' );
+
+    # capture the true scan time for back-dated checkins
+    $circ->checkin_scan_time('now');
+
+    $circ->checkin_staff($self->editor->requestor->id);
+    $circ->checkin_lib($self->circ_lib);
+    $circ->checkin_workstation($self->editor->requestor->wsid);
+
+    my $circ_lib = (ref $self->copy->circ_lib) ?  
+        $self->copy->circ_lib->id : $self->copy->circ_lib;
+    my $stat = $U->copy_status($self->copy->status)->id;
+
+    # immediately available keeps items lost or missing items from going home before being handled
+    my $lost_immediately_available = $U->ou_ancestor_setting_value(
+        $circ_lib, OILS_SETTING_LOST_IMMEDIATELY_AVAILABLE, $self->editor) || 0;
+
+
+    if ( (!$lost_immediately_available) && ($circ_lib != $self->circ_lib) ) {
+
+        if( ($stat == OILS_COPY_STATUS_LOST or $stat == OILS_COPY_STATUS_MISSING) ) {
+            $logger->info("circulator: not updating copy status on checkin because copy is lost/missing");
+        } else {
+            $self->copy->status($U->copy_status(OILS_COPY_STATUS_RESHELVING));
+            $self->update_copy;
+        }
+
+    } elsif ($stat == OILS_COPY_STATUS_LOST) {
+
+        $self->checkin_handle_lost($circ_lib);
+
+    } else {
+
+        $self->copy->status($U->copy_status(OILS_COPY_STATUS_RESHELVING));
+        $self->update_copy;
+    }
+
+
+    # see if there are any fines owed on this circ.  if not, close it
+    ($obt) = $U->fetch_mbts($circ->id, $self->editor);
+    $circ->xact_finish('now') if( $obt and $obt->balance_owed == 0 );
+
+    $logger->debug("circulator: ".$obt->balance_owed." is owed on this circulation");
+
+    return $self->bail_on_events($self->editor->event)
+        unless $self->editor->update_action_circulation($circ);
+
+    # make sure the circ isn't closed if we just voided some fines
+    $evt = OpenILS::Application::Circ::CircCommon->reopen_xact($self->editor, $circ->id);
+    return $self->bail_on_events($evt) if $evt;
+
+    return undef;
+}
+
+
+# ------------------------------------------------------------------
+# See if we need to void billings for lost checkin
+# ------------------------------------------------------------------
+sub checkin_handle_lost {
+    my $self = shift;
+    my $circ_lib = shift;
+    my $circ = $self->circ;
+
+    my $max_return = $U->ou_ancestor_setting_value(
+        $circ_lib, OILS_SETTING_MAX_ACCEPT_RETURN_OF_LOST, $self->editor) || 0;
+
+    if ($max_return) {
+
+        my $today = time();
+        my @tm = reverse($circ->due_date =~ /([\d\.]+)/og);
+        $tm[5] -= 1 if $tm[5] > 0;
+        my $due = timelocal(int($tm[1]), int($tm[2]), int($tm[3]), int($tm[4]), int($tm[5]), int($tm[6]));
+
+        my $last_chance = OpenSRF::Utils->interval_to_seconds($max_return) + int($due);
+        $logger->info("MAX OD: ".$max_return."  DUEDATE: ".$circ->due_date."  TODAY: ".$today."  DUE: ".$due."  LAST: ".$last_chance);
+
+        $max_return = 0 if $today < $last_chance;
+    }
+
+    if (!$max_return){  # there's either no max time to accept returns defined or we're within that time
+
+        my $void_lost = $U->ou_ancestor_setting_value(
+            $circ_lib, OILS_SETTING_VOID_LOST_ON_CHECKIN, $self->editor) || 0;
+        my $void_lost_fee = $U->ou_ancestor_setting_value(
+            $circ_lib, OILS_SETTING_VOID_LOST_PROCESS_FEE_ON_CHECKIN, $self->editor) || 0;
+        my $restore_od = $U->ou_ancestor_setting_value(
+            $circ_lib, OILS_SETTING_RESTORE_OVERDUE_ON_LOST_RETURN, $self->editor) || 0;
+
+        $self->checkin_handle_lost_now_found(3) if $void_lost;
+        $self->checkin_handle_lost_now_found(4) if $void_lost_fee;
+        $self->checkin_handle_lost_now_found_restore_od() if $restore_od && ! $self->void_overdues;
+    }
+
+    $self->copy->status($U->copy_status(OILS_COPY_STATUS_RESHELVING));
+    $self->update_copy;
+}
+
+
+sub checkin_handle_backdate {
+    my $self = shift;
+
+    # ------------------------------------------------------------------
+    # clean up the backdate for date comparison
+    # XXX We are currently taking the due-time from the original due-date,
+    # not the input.  Do we need to do this?  This certainly interferes with
+    # backdating of hourly checkouts, but that is likely a very rare case.
+    # ------------------------------------------------------------------
+    my $bd = cleanse_ISO8601($self->backdate);
+    my $original_date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($self->circ->due_date));
+    my $new_date = DateTime::Format::ISO8601->new->parse_datetime($bd);
+    $bd = cleanse_ISO8601($new_date->ymd . 'T' . $original_date->strftime('%T%z'));
+
+    $self->backdate($bd);
+
+    my $evt = OpenILS::Application::Circ::CircCommon->void_overdues($self->editor, $self->circ, $bd);
+    return $evt if $evt;
+
+    return undef;
+}
+
+
+sub check_checkin_copy_status {
+    my $self = shift;
+   my $copy = $self->copy;
+
+   my $status = $U->copy_status($copy->status)->id;
+
+   return undef
+      if(   $status == OILS_COPY_STATUS_AVAILABLE   ||
+            $status == OILS_COPY_STATUS_CHECKED_OUT ||
+            $status == OILS_COPY_STATUS_IN_PROCESS  ||
+            $status == OILS_COPY_STATUS_ON_HOLDS_SHELF  ||
+            $status == OILS_COPY_STATUS_IN_TRANSIT  ||
+            $status == OILS_COPY_STATUS_CATALOGING  ||
+            $status == OILS_COPY_STATUS_ON_RESV_SHELF  ||
+            $status == OILS_COPY_STATUS_RESHELVING );
+
+   return OpenILS::Event->new('COPY_STATUS_LOST', payload => $copy )
+      if( $status == OILS_COPY_STATUS_LOST );
+
+   return OpenILS::Event->new('COPY_STATUS_MISSING', payload => $copy )
+      if( $status == OILS_COPY_STATUS_MISSING );
+
+   return OpenILS::Event->new('COPY_BAD_STATUS', payload => $copy );
+}
+
+
+
+# --------------------------------------------------------------------------
+# On checkin, we need to return as many relevant objects as we can
+# --------------------------------------------------------------------------
+sub checkin_flesh_events {
+    my $self = shift;
+
+    if( grep { $_->{textcode} eq 'SUCCESS' } @{$self->events} 
+        and grep { $_->{textcode} eq 'ITEM_NOT_CATALOGED' } @{$self->events} ) {
+            $self->events([grep { $_->{textcode} eq 'ITEM_NOT_CATALOGED' } @{$self->events}]);
+    }
+
+    my $record = $U->record_to_mvr($self->title) if($self->title and !$self->is_precat);
+
+    my $hold;
+    if($self->hold and !$self->hold->cancel_time) {
+        $hold = $self->hold;
+        $hold->notes($self->editor->search_action_hold_request_note({hold => $hold->id}));
+    }
+
+    if($self->circ) {
+        # if we checked in a circulation, flesh the billing summary data
+        $self->circ->billable_transaction(
+            $self->editor->retrieve_money_billable_transaction([
+                $self->circ->id,
+                {flesh => 1, flesh_fields => {mbt => ['summary']}}
+            ])
+        );
+    }
+
+    if($self->patron) {
+        # flesh some patron fields before returning
+        $self->patron(
+            $self->editor->retrieve_actor_user([
+                $self->patron->id,
+                {
+                    flesh => 1,
+                    flesh_fields => {
+                        au => ['card', 'billing_address', 'mailing_address']
+                    }
+                }
+            ])
+        );
+    }
+
+    for my $evt (@{$self->events}) {
+
+        my $payload         = {};
+        $payload->{copy}    = $U->unflesh_copy($self->copy);
+        $payload->{record}  = $record,
+        $payload->{circ}    = $self->circ;
+        $payload->{transit} = $self->transit;
+        $payload->{cancelled_hold_transit} = 1 if $self->cancelled_hold_transit;
+        $payload->{hold}    = $hold;
+        $payload->{patron}  = $self->patron;
+        $payload->{reservation} = $self->reservation
+            unless (not $self->reservation or $self->reservation->cancel_time);
+
+        $evt->{payload}     = $payload;
+    }
+}
+
+sub log_me {
+    my( $self, $msg ) = @_;
+    my $bc = ($self->copy) ? $self->copy->barcode :
+        $self->barcode;
+    $bc ||= "";
+    my $usr = ($self->patron) ? $self->patron->id : "";
+    $logger->info("circulator: $msg requestor=".$self->editor->requestor->id.
+        ", recipient=$usr, copy=$bc");
+}
+
+
+sub do_renew {
+    my $self = shift;
+    $self->log_me("do_renew()");
+
+    # Make sure there is an open circ to renew that is not
+    # marked as LOST, CLAIMSRETURNED, or LONGOVERDUE
+    my $usrid = $self->patron->id if $self->patron;
+    my $circ = $self->editor->search_action_circulation({
+        target_copy => $self->copy->id,
+        xact_finish => undef,
+        ($usrid ? (usr => $usrid) : ()),
+        '-or' => [
+            {stop_fines => undef},
+            {stop_fines => OILS_STOP_FINES_MAX_FINES}
+        ]
+    })->[0];
+
+    return $self->bail_on_events($self->editor->event) unless $circ;
+
+    # A user is not allowed to renew another user's items without permission
+    unless( $circ->usr eq $self->editor->requestor->id ) {
+        return $self->bail_on_events($self->editor->events)
+            unless $self->editor->allowed('RENEW_CIRC', $circ->circ_lib);
+    }   
+
+    $self->push_events(OpenILS::Event->new('MAX_RENEWALS_REACHED'))
+        if $circ->renewal_remaining < 1;
+
+    # -----------------------------------------------------------------
+
+    $self->parent_circ($circ->id);
+    $self->renewal_remaining( $circ->renewal_remaining - 1 );
+    $self->circ($circ);
+
+    # Run the fine generator against the old circ
+    $self->generate_fines_start;
+
+    $self->run_renew_permit;
+
+    # Check the item in
+    $self->do_checkin();
+    return if $self->bail_out;
+
+    unless( $self->permit_override ) {
+        $self->do_permit();
+        return if $self->bail_out;
+        $self->is_precat(1) if $self->have_event('ITEM_NOT_CATALOGED');
+        $self->remove_event('ITEM_NOT_CATALOGED');
+    }   
+
+    $self->override_events;
+    return if $self->bail_out;
+
+    $self->events([]);
+    $self->do_checkout();
+}
+
+
+sub remove_event {
+    my( $self, $evt ) = @_;
+    $evt = (ref $evt) ? $evt->{textcode} : $evt;
+    $logger->debug("circulator: removing event from list: $evt");
+    my @events = @{$self->events};
+    $self->events( [ grep { $_->{textcode} ne $evt } @events ] );
+}
+
+
+sub have_event {
+    my( $self, $evt ) = @_;
+    $evt = (ref $evt) ? $evt->{textcode} : $evt;
+    return grep { $_->{textcode} eq $evt } @{$self->events};
+}
+
+
+
+sub run_renew_permit {
+    my $self = shift;
+
+    if ($U->ou_ancestor_setting_value($self->circ_lib, 'circ.block_renews_for_holds')) {
+        my ($hold, undef, $retarget) = $holdcode->find_nearest_permitted_hold(
+            $self->editor, $self->copy, $self->editor->requestor, 1
+        );
+        $self->push_events(new OpenILS::Event("COPY_NEEDED_FOR_HOLD")) if $hold;
+    }
+
+    if(!$self->legacy_script_support) {
+        my $results = $self->run_indb_circ_test;
+        $self->push_events($self->matrix_test_result_events)
+            unless $self->circ_test_success;
+    } else {
+
+        my $runner = $self->script_runner;
+
+        $runner->load($self->circ_permit_renew);
+        my $result = $runner->run or 
+            throw OpenSRF::EX::ERROR ("Circ Permit Renew Script Died: $@");
+        if ($result->{"events"}) {
+            $self->push_events(
+                map { new OpenILS::Event($_) } @{$result->{"events"}}
+            );
+            $logger->activity(
+                "circulator: circ_permit_renew for user " .
+                $self->patron->id . " returned " .
+                scalar(@{$result->{"events"}}) . " event(s)"
+            );
+        }
+
+        $self->mk_script_runner;
+    }
+
+    $logger->debug("circulator: re-creating script runner to be safe");
+}
+
+
+# XXX: The primary mechanism for storing circ history is now handled
+# by tracking real circulation objects instead of bibs in a bucket.
+# However, this code is disabled by default and could be useful 
+# some day, so may as well leave it for now.
+sub append_reading_list {
+    my $self = shift;
+
+    return undef unless 
+        $self->is_checkout and 
+        $self->patron and 
+        $self->copy and 
+        !$self->is_noncat;
+
+
+    # verify history is globally enabled and uses the bucket mechanism
+    my $htype = OpenSRF::Utils::SettingsClient->new->config_value(
+        apps => 'open-ils.circ' => app_settings => 'checkout_history_mechanism');
+
+    return undef unless $htype and $htype eq 'bucket';
+
+    my $e = new_editor(xact => 1, requestor => $self->editor->requestor);
+
+    # verify the patron wants to retain the hisory
+	my $setting = $e->search_actor_user_setting(
+		{usr => $self->patron->id, name => 'circ.keep_checkout_history'})->[0];
+    
+    unless($setting and $setting->value) {
+        $e->rollback;
+        return undef;
+    }
+
+    my $bkt = $e->search_container_copy_bucket(
+        {owner => $self->patron->id, btype => 'circ_history'})->[0];
+
+    my $pos = 1;
+
+    if($bkt) {
+        # find the next item position
+        my $last_item = $e->search_container_copy_bucket_item(
+            {bucket => $bkt->id}, {order_by => {ccbi => 'pos desc'}, limit => 1})->[0];
+        $pos = $last_item->pos + 1 if $last_item;
+
+    } else {
+        # create the history bucket if necessary
+        $bkt = Fieldmapper::container::copy_bucket->new;
+        $bkt->owner($self->patron->id);
+        $bkt->name('');
+        $bkt->btype('circ_history');
+        $bkt->pub('f');
+        $e->create_container_copy_bucket($bkt) or return $e->die_event;
+    }
+
+    my $item = Fieldmapper::container::copy_bucket_item->new;
+
+    $item->bucket($bkt->id);
+    $item->target_copy($self->copy->id);
+    $item->pos($pos);
+
+    $e->create_container_copy_bucket_item($item) or return $e->die_event;
+    $e->commit;
+
+    return undef;
+}
+
+
+sub make_trigger_events {
+    my $self = shift;
+    return unless $self->circ;
+    $U->create_events_for_hook('checkout', $self->circ, $self->circ_lib) if $self->is_checkout;
+    $U->create_events_for_hook('checkin',  $self->circ, $self->circ_lib) if $self->is_checkin;
+    $U->create_events_for_hook('renewal',  $self->circ, $self->circ_lib) if $self->is_renewal;
+}
+
+
+
+sub checkin_handle_lost_now_found {
+    my ($self, $bill_type) = @_;
+
+    # ------------------------------------------------------------------
+    # remove charge from patron's account if lost item is returned
+    # ------------------------------------------------------------------
+
+    my $bills = $self->editor->search_money_billing(
+        {
+            xact => $self->circ->id,
+            btype => $bill_type
+        }
+    );
+
+    $logger->debug("voiding lost item charge of  ".scalar(@$bills));
+    for my $bill (@$bills) {
+        if( !$U->is_true($bill->voided) ) {
+            $logger->info("lost item returned - voiding bill ".$bill->id);
+            $bill->voided('t');
+            $bill->void_time('now');
+            $bill->voider($self->editor->requestor->id);
+            my $note = ($bill->note) ? $bill->note . "\n" : '';
+            $bill->note("${note}System: VOIDED FOR LOST ITEM RETURNED");
+
+            $self->bail_on_events($self->editor->event)
+                unless $self->editor->update_money_billing($bill);
+        }
+    }
+}
+
+sub checkin_handle_lost_now_found_restore_od {
+    my $self = shift;
+
+    # ------------------------------------------------------------------
+    # restore those overdue charges voided when item was set to lost
+    # ------------------------------------------------------------------
+
+    my $ods = $self->editor->search_money_billing(
+        {
+                xact => $self->circ->id,
+                btype => 1
+        }
+    );
+
+    $logger->debug("returning overdue charges pre-lost  ".scalar(@$ods));
+    for my $bill (@$ods) {
+        if( $U->is_true($bill->voided) ) {
+                $logger->info("lost item returned - restoring overdue ".$bill->id);
+                $bill->voided('f');
+                $bill->clear_void_time;
+                $bill->voider($self->editor->requestor->id);
+                my $note = ($bill->note) ? $bill->note . "\n" : '';
+                $bill->note("${note}System: LOST RETURNED - OVERDUES REINSTATED");
+
+                $self->bail_on_events($self->editor->event)
+                        unless $self->editor->update_money_billing($bill);
+        }
+    }
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/CopyLocations.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/CopyLocations.pm
new file mode 100644
index 0000000000..d7f0773293
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/CopyLocations.pm
@@ -0,0 +1,220 @@
+package OpenILS::Application::Circ::CopyLocations;
+use base 'OpenILS::Application';
+use strict; use warnings;
+use Data::Dumper;
+$Data::Dumper::Indent = 0;
+use OpenSRF::EX qw(:try);
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+my $U = "OpenILS::Application::AppUtils";
+
+
+__PACKAGE__->register_method(
+	api_name		=> "open-ils.circ.copy_location.retrieve.all",
+	method		=> 'cl_retrieve_all',
+	argc			=>	2,
+	signature	=> q/
+		Retrieves the ranged set of copy locations for the requested org.
+		If no org is provided, all copy locations are returned
+		@param orgId The org location id
+		@param noi18n No i18n in result
+        @param flesh_owning_lib Flesh owning lib in results
+		@return An array of copy location objects
+		/);
+
+sub cl_retrieve_all {
+	my ($self, $client, $org_id, $no_i18n, $flesh_owning_lib) = @_;
+
+	if(!$org_id) {
+		my $otree = $U->get_org_tree();
+		$org_id = $otree->id;
+	}
+
+    my $second_cstore_arg = {"no_i18n" => scalar($no_i18n)};
+    if ($flesh_owning_lib) {
+        $second_cstore_arg->{"flesh"} = 1;
+        $second_cstore_arg->{"flesh_fields"} = {"acpl" => ["owning_lib"]};
+    }
+
+    return new_editor()->search_asset_copy_location([{
+        owning_lib => $U->get_org_full_path($org_id)
+    }, $second_cstore_arg]);
+}
+
+__PACKAGE__->register_method(
+    "api_name" => "open-ils.circ.copy_location.retrieve.distinct",
+    "method" => "cl_retrieve_distinct",
+    "stream" => 1,
+    "argc" => 0,
+    "signature" => q/Retrieve copy locations with distinct names globally/
+);
+
+sub cl_retrieve_distinct {
+    my ($self, $client) = @_;
+
+    my $e = new_editor();
+    my $names = $e->json_query({
+        "select" => {
+            "acpl" => [{"transform" => "distinct", "column" => "name"}]
+        },
+        "from" => {"acpl" => {}}
+    }) or return $e->die_event;
+    $e->disconnect;
+
+    $client->respond($_->{"name"}) for @$names;
+    undef;
+}
+
+__PACKAGE__->register_method(
+	api_name		=> 'open-ils.circ.copy_location.create',
+	method		=> 'cl_create',
+	argc			=> 2,
+	signature	=> q/
+		Creates a new copy location.  Requestor must have the CREATE_COPY_LOCATION
+		permission at the location specified on the new location object
+		@param authtoken The login session key
+		@param copyLoc The new copy location object
+		@return The if of the new location object on success, event on error
+	/);
+
+
+sub cl_create {
+    my( $self, $conn, $auth, $location ) = @_;
+
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless 
+        $e->allowed('CREATE_COPY_LOCATION', $location->owning_lib);
+
+    # make sure there is no copy_location with the same name in the same place
+    my $existing = $e->search_asset_copy_location(
+        {owning_lib => $location->owning_lib, name => $location->name}, {idlist=>1});
+    return OpenILS::Event->new('COPY_LOCATION_EXISTS') if @$existing;
+
+    $e->create_asset_copy_location($location) or return $e->die_event;
+    $e->commit;
+    return $location->id;
+}
+
+
+
+__PACKAGE__->register_method (
+	api_name		=> 'open-ils.circ.copy_location.delete',
+	method		=> 'cl_delete',
+	argc			=> 2,
+	signature	=> q/
+		Deletes a copy location. Requestor must have the 
+		DELETE_COPY_LOCATION permission.
+		@param authtoken The login session key
+		@param id The copy location object id
+		@return 1 on success, event on error
+	/);
+
+
+sub cl_delete {
+    my( $self, $conn, $auth, $id ) = @_;
+
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+
+    my $cloc = $e->retrieve_asset_copy_location($id) 
+        or return $e->die_event;
+    return $e->die_event unless 
+        $e->allowed('DELETE_COPY_LOCATION', $cloc->owning_lib);
+
+    $e->delete_asset_copy_location($cloc) or return $e->die_event;
+    $e->commit;
+    return 1;
+}
+
+
+__PACKAGE__->register_method (
+	api_name		=> 'open-ils.circ.copy_location.update',
+	method		=> 'cl_update',
+	argc			=> 2,
+	signature	=> q/
+		Updates a copy location object.  Requestor must have 
+		the UPDATE_COPY_LOCATION permission
+		@param authtoken The login session key
+		@param copyLoc	The copy location object
+		@return 1 on success, event on error
+	/);
+
+
+sub cl_update {
+    my( $self, $conn, $auth, $location ) = @_;
+
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+
+    # check permissions against the original copy location
+    my $orig_loc = $e->retrieve_asset_copy_location($location->id)
+        or return $e->die_event;
+
+    return $e->die_event unless 
+        $e->allowed('UPDATE_COPY_LOCATION', $orig_loc->owning_lib);
+
+    # disallow hijacking of the location
+    $location->owning_lib($orig_loc->owning_lib);  
+
+    $e->update_asset_copy_location($location)
+        or return $e->die_event;
+
+    $e->commit;
+    return 1;
+}
+
+
+
+__PACKAGE__->register_method(
+	method => 'fetch_loc',
+    authoritative => 1,
+	api_name => 'open-ils.circ.copy_location.retrieve',
+);
+
+sub fetch_loc {
+	my( $self, $con, $id ) = @_;
+	my $e = new_editor();
+	my $cl = $e->retrieve_asset_copy_location($id)
+		or return $e->event;
+	return $cl;
+}
+
+__PACKAGE__->register_method(
+    api_name => "open-ils.circ.copy_location_order.update",
+    method => 'update_clo',
+    argc =>	2,
+);
+
+sub update_clo {
+    my($self, $client, $auth, $orders) = @_;
+    return [] unless $orders and @$orders;
+
+    my $e = new_editor(authtoken => $auth, xact =>1);
+    return $e->die_event unless $e->checkauth;
+
+    my $org = $$orders[0]->org;
+    return $e->die_event unless $e->allowed('ADMIN_COPY_LOCATION_ORDER', $org);
+
+    # clear out the previous order entries
+    my $existing = $e->search_asset_copy_location_order({org => $org});
+    $e->delete_asset_copy_location_order($_) or return $e->die_event for @$existing;
+
+    # create the new order entries
+    my $progress = 0; 
+    for my $order (@$orders) {
+        return $e->die_event(OpenILS::Event->new('BAD_PARAMS')) unless $order->org == $org;
+        $e->create_asset_copy_location_order($order) or return $e->die_event;
+        $client->respond({maximum => scalar(@$orders), progress => $progress}) unless ($progress++ % 10);
+    }
+
+    # fetch the new entries
+    $orders = $e->search_asset_copy_location_order({org => $org});
+    $e->commit;
+    return {orders => $orders};
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/CreditCard.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/CreditCard.pm
new file mode 100644
index 0000000000..647cc26f47
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/CreditCard.pm
@@ -0,0 +1,297 @@
+# --------------------------------------------------------------------
+# Copyright (C) 2008 Niles Ingalls 
+# Niles Ingalls 
+# Bill Erickson 
+# Joe Atzberger 
+# Lebbeous Fogle-Weekley 
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# --------------------------------------------------------------------
+package OpenILS::Application::Circ::CreditCard;
+use base qw/OpenSRF::Application/;
+use strict; use warnings;
+
+use Business::CreditCard;
+use Business::OnlinePayment;
+use UUID::Tiny qw/:std/;
+use Locale::Country;
+
+use OpenILS::Event;
+use OpenSRF::Utils::Logger qw/:logger/;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenILS::Application::AppUtils;
+my $U = "OpenILS::Application::AppUtils";
+
+use constant CREDIT_NS => "credit";
+
+# Given the argshash from process_payment(), this helper function just finds
+# a function in the current namespace named "bop_args_{processor}" and calls
+# it with $argshash as an argument, returning the result, or returning an
+# empty hash if it can't find such a function.
+sub get_bop_args_filler {
+    no strict 'refs';
+
+    my $argshash = shift;
+    my $funcname = "bop_args_" . $argshash->{processor};
+    return &{$funcname}($argshash) if defined &{$funcname};
+    return ();
+}
+
+# Provide default arguments for calls using the AuthorizeNet processor
+sub bop_args_AuthorizeNet {
+    my $argshash = shift;
+    if ($argshash->{server}) {
+        return (
+            # One might provide "test.authorize.net" here.
+            Server => $argshash->{server},
+        );
+    }
+    else {
+        return ();
+    }
+}
+
+# Provide default arguments for calls using the PayPal processor
+sub bop_args_PayPal {
+    my $argshash = shift;
+    return (
+        Username => $argshash->{login},
+        Password => $argshash->{password},
+        Signature => $argshash->{signature}
+    );
+}
+
+# Provide default arguments for calls using the PayflowPro processor
+sub bop_args_PayflowPro {
+    my $argshash = shift;
+    return (
+        "vendor" => $argshash->{vendor},
+        "partner" => $argshash->{partner} || "PayPal" # reasonable default?
+    );
+}
+
+sub get_processor_settings {
+    my $org_unit = shift;
+    my $processor = lc shift;
+
+    # XXX TODO: make this one single cstore request instead of many
+    +{ map { ($_ =>
+        $U->ou_ancestor_setting_value(
+            $org_unit, CREDIT_NS . ".processor.${processor}.${_}"
+        )) } qw/enabled login password signature server testmode vendor partner/
+    };
+}
+
+#        argshash (Hash of arguments with these keys):
+#                patron_id: Not a barcode, but a patron's internal ID
+#                       ou: Org unit where transaction happens
+#                processor: Payment processor to use
+#                           (AuthorizeNet/PayPal/PayflowPro)
+#                       cc: credit card number
+#                     cvv2: 3 or 4 digits from back of card
+#                   amount: transaction value
+#                   action: optional (default: Normal Authorization)
+#               first_name: optional (default: patron's first_given_name field)
+#                last_name: optional (default: patron's family_name field)
+#                  address: optional (default: patron's street1 field + street2)
+#                     city: optional (default: patron's city field)
+#                    state: optional (default: patron's state field)
+#                      zip: optional (default: patron's zip field)
+#                  country: optional (some processor APIs: 2 letter code.)
+#              description: optional
+
+sub process_payment {
+    my ($argshash) = @_;
+
+    # Confirm some required arguments.
+    return OpenILS::Event->new('BAD_PARAMS')
+        unless $argshash
+            and $argshash->{cc}
+            and $argshash->{amount}
+            and $argshash->{expiration}
+            and $argshash->{ou};
+
+    if (!$argshash->{processor}) {
+        if (!($argshash->{processor} =
+                $U->ou_ancestor_setting_value(
+                    $argshash->{ou}, CREDIT_NS . '.processor.default'))) {
+            return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_SPECIFIED');
+        }
+    }
+    # Basic sanity check on processor name.
+    if ($argshash->{processor} !~ /^[a-z0-9_\-]+$/i) {
+        return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_ALLOWED');
+    }
+
+    # Get org unit settings related to our processor
+    my $psettings = get_processor_settings(
+        $argshash->{ou}, $argshash->{processor}
+    );
+
+    if (!$psettings->{enabled}) {
+        return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_ENABLED');
+    }
+
+    # Add the org unit settings for the chosen processor to our argshash.
+    $argshash = +{ %{$argshash}, %{$psettings} };
+
+    # At least the following (derived from org unit settings) are required.
+    return OpenILS::Event->new('CREDIT_PROCESSOR_BAD_PARAMS')
+        unless $argshash->{login}
+            and $argshash->{password};
+
+    # A valid patron_id is also required.
+    my $e = new_editor();
+    my $patron = $e->retrieve_actor_user(
+        [
+            $argshash->{patron_id},
+            {
+                flesh        => 1,
+                flesh_fields => { au => ["mailing_address"] }
+            }
+        ]
+    ) or return $e->event;
+
+    return dispatch($argshash, $patron);
+}
+
+sub prepare_bop_content {
+    my ($argshash, $patron, $cardtype) = @_;
+
+    my %content;
+    foreach (qw/
+        login
+        password
+        description
+        first_name
+        last_name
+        amount
+        expiration
+        cvv2
+        address
+        city
+        state
+        zip
+        country/) {
+        if (exists $argshash->{$_}) {
+            $content{$_} = $argshash->{$_};
+        }
+    }
+    
+    $content{action}       = $argshash->{action} || "Normal Authorization";
+    $content{type}         = $cardtype;      #'American Express', 'VISA', 'MasterCard'
+    $content{card_number}  = $argshash->{cc};
+    $content{customer_id}  = $patron->id;
+    
+    $content{first_name} ||= $patron->first_given_name;
+    $content{last_name}  ||= $patron->family_name;
+
+    $content{FirstName}    = $content{first_name};   # kludge mcugly for PP
+    $content{LastName}     = $content{last_name};
+
+
+    # Especially for the following fields, do we need to support different
+    # mapping of fields for different payment processors, particularly ones
+    # in other countries?
+    $content{address}    ||= $patron->mailing_address->street1;
+    $content{address} .= ", " . $patron->mailing_address->street2
+        if $patron->mailing_address->street2;
+
+    $content{city}       ||= $patron->mailing_address->city;
+    $content{state}      ||= $patron->mailing_address->state;
+    $content{zip}        ||= $patron->mailing_address->post_code;
+    $content{country}    ||= $patron->mailing_address->country;
+
+    # Yet another fantastic kludge. country2code() comes from Locale::Country.
+    # PayPal must have 2 letter country field (ISO 3166) that's uppercase.
+    if (length($content{country}) > 2 && $argshash->{processor} eq 'PayPal') {
+        $content{country} = uc country2code($content{country});
+    } elsif($argshash->{processor} eq "PayflowPro") {
+        ($content{request_id} = create_uuid_as_string(UUID_V4)) =~ s/-//;
+    }
+
+    %content;
+}
+
+sub dispatch {
+    my ($argshash, $patron) = @_;
+    
+    # The validate() sub is exported by Business::CreditCard.
+    if (!validate($argshash->{cc})) {
+        # Although it might help a troubleshooter, it's probably not a good
+        # idea to put the credit card number in the log file.
+        $logger->info("Credit card number invalid");
+
+        return new OpenILS::Event("CREDIT_PROCESSOR_INVALID_CC_NUMBER");
+    }
+
+    # cardtype() also comes from Business::CreditCard.  It is not certain that
+    # a) the card type returned by this method will be suitable input for
+    #   a payment processor, nor that
+    # b) it is even necessary to supply this argument to processors in all
+    #   cases.  Testing this with several processors would be a good idea.
+    (my $cardtype = cardtype($argshash->{cc})) =~ s/ card//i;
+
+    if (lc($cardtype) eq "unknown") {
+        $logger->info("Credit card number passed validate(), " .
+            "yet cardtype() returned $cardtype");
+        return new OpenILS::Event(
+            "CREDIT_PROCESSOR_INVALID_CC_NUMBER", "note" => "cardtype $cardtype"
+        );
+    }
+
+    $logger->debug(
+        "applying payment via processor '" . $argshash->{processor} . "'"
+    );
+
+    # Find B:OP constructor arguments specific to our payment processor.
+    my %bop_args = get_bop_args_filler($argshash);
+
+    # We're assuming that all B:OP processors accept this argument to the
+    # constructor.
+    $bop_args{test_transaction} = $argshash->{testmode};
+
+    my $transaction = new Business::OnlinePayment(
+        $argshash->{processor}, %bop_args
+    );
+
+    my %content = prepare_bop_content($argshash, $patron, $cardtype);
+    $transaction->content(%content);
+
+    # submit() does not return a value, although crashing is possible here
+    # with some bad input depending on the payment processor.
+    $transaction->submit;
+
+    my $payload = {
+        "processor" => $argshash->{"processor"}, "card_type" => $cardtype
+    };
+
+    # Put the values of any of these fields into the event payload, if present.
+    foreach (qw/authorization correlationid avs_code request_id
+        server_response cvv2_response cvv2_code error_message order_number/) {
+        $payload->{$_} = $transaction->$_ if $transaction->can($_);
+    }
+
+    my $event_name;
+
+    if ($transaction->is_success) {
+        $logger->info($argshash->{processor} . " payment succeeded");
+        $event_name = "SUCCESS";
+    } else {
+        $logger->info($argshash->{processor} . " payment failed");
+        $event_name = "CREDIT_PROCESSOR_DECLINED_TRANSACTION";
+    }
+
+    return new OpenILS::Event($event_name, "payload" => $payload);
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/HoldNotify.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/HoldNotify.pm
new file mode 100644
index 0000000000..674131695d
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/HoldNotify.pm
@@ -0,0 +1,382 @@
+# ---------------------------------------------------------------
+# Copyright (C) 2005  Georgia Public Library Service 
+# Bill Erickson 
+
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# ---------------------------------------------------------------
+
+
+package OpenILS::Application::Circ::HoldNotify;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+use OpenSRF::EX qw(:try);
+use vars q/$AUTOLOAD/;
+use OpenILS::Event;
+use OpenSRF::Utils::JSON;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Application::AppUtils;
+use OpenILS::Const qw/:const/;
+use OpenILS::Utils::Fieldmapper;
+use Email::Send;
+use Data::Dumper;
+use OpenSRF::EX qw/:try/;
+my $U = 'OpenILS::Application::AppUtils';
+
+use open ':utf8';
+
+
+__PACKAGE__->register_method(
+	method => 'send_email_notify_pub',
+	api_name => 'open-ils.circ.send_hold_notify.email',
+);
+
+
+sub send_email_notify_pub {
+	my( $self, $conn, $auth, $hold_id ) = @_;
+	my $e = new_editor(authtoken => $auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('CREATE_HOLD_NOTIFICATION');
+	my $notifier = __PACKAGE__->new(requestor => $e->requestor, hold_id => $hold_id);
+	return $notifier->event if $notifier->event;
+	my $stat = $notifier->send_email_notify;
+#	$e->commit if $stat == '1';
+	return $stat;
+}
+
+
+
+
+
+# ---------------------------------------------------------------
+# Define the notifier object
+# ---------------------------------------------------------------
+
+my @AUTOLOAD_FIELDS = qw/
+	hold
+	copy
+	volume
+	title
+	editor
+	patron
+	event
+	pickup_lib
+	smtp_server
+	settings_client
+/;
+
+sub AUTOLOAD {
+	my $self = shift;
+	my $type = ref($self) or die "$self is not an object";
+	my $data = shift;
+	my $name = $AUTOLOAD;
+	$name =~ s/.*://o;   
+
+	unless (grep { $_ eq $name } @AUTOLOAD_FIELDS) {
+		$logger->error("hold_notify: $type: invalid autoload field: $name");
+		die "$type: invalid autoload field: $name\n" 
+	}
+
+	{
+		no strict 'refs';
+		*{"${type}::${name}"} = sub {
+			my $s = shift;
+			my $v = shift;
+			$s->{$name} = $v if defined $v;
+			return $s->{$name};
+		}
+	}
+	return $self->$name($data);
+}
+
+
+sub new {
+	my( $class, %args ) = @_;
+	$class = ref($class) || $class;
+	my $self = bless( {}, $class );
+	$self->editor( new_editor( xact => 1, requestor => $args{requestor} ));
+	$logger->debug("circulator: creating new hold-notifier with requestor ".
+		$self->editor->requestor->id);
+	$self->fetch_data($args{hold_id});
+	return $self;
+}
+
+sub send_email_notify {
+	my $self = shift;
+
+	my $sc = OpenSRF::Utils::SettingsClient->new;
+	my $setting = $sc->config_value(
+		qw/ apps open-ils.circ app_settings notify_hold email / );
+
+	$logger->debug("hold_notify: email enabled setting = $setting");
+
+	if( !$setting or $setting ne 'true' ) {
+      $self->editor->rollback;
+		$logger->info("hold_notify: not sending hold notify - email notifications disabled");
+		return 0;
+	}
+
+	unless ($U->is_true($self->hold->email_notify)) {
+      $self->editor->rollback;
+		$logger->info("hold_notify: not sending hold notification because email_notify is false");
+		return 0;
+	}
+
+	unless( $self->patron->email and $self->patron->email =~ /.+\@.+/ ) { # see if it's remotely email-esque
+      $self->editor->rollback;
+	   return OpenILS::Event->new('PATRON_NO_EMAIL_ADDRESS');
+   }
+
+	$logger->info("hold_notify: attempting email notify on hold ".$self->hold->id);
+
+	my $sclient = OpenSRF::Utils::SettingsClient->new;
+	$self->settings_client($sclient);
+	my $template = $sclient->config_value('email_notify', 'template');
+	my $str = $self->flesh_template($self->load_template($template));
+
+	unless( $str ) {
+      $self->editor->rollback;
+		$logger->error("hold_notify: No email notify template found - cannot notify");
+		return 0;
+	}
+
+   my $reqr = $self->editor->requestor;
+   $self->editor->rollback; # we're done with this transaction
+
+	return 0 unless $self->send_email($str);
+
+	# ------------------------------------------------------------------
+	# If the hold email takes too long to send, the existing editor 
+	# transaction may have timed out.  Create a one-off editor to write 
+	# the notification to the DB.
+	# ------------------------------------------------------------------
+	my $we = new_editor(xact=>1, requestor=>$reqr);
+
+	my $notify = Fieldmapper::action::hold_notification->new;
+	$notify->hold($self->hold->id);
+	$notify->notify_staff($we->requestor->id);
+	$notify->notify_time('now');
+	$notify->method('email');
+	
+	$we->create_action_hold_notification($notify)
+		or return $we->die_event;
+	$we->commit;
+
+	return 1;
+}
+
+sub send_email {
+	my( $self, $text ) = @_;
+
+   # !!! $self->editor xact has been rolled back before we get here
+
+	my $smtp = $self->settings_client->config_value('email_notify', 'smtp_server');
+
+	$logger->info("hold_notify: sending email notice to ".
+		$self->patron->email." with SMTP server $smtp");
+
+	my $sender = Email::Send->new({mailer => 'SMTP'});
+	$sender->mailer_args([Host => $smtp]);
+
+	my $stat;
+	my $err;
+
+	try {
+		$stat = $sender->send($text);
+	} catch Error with {
+		$err = $stat = shift;
+		$logger->error("hold_notify: Email notify failed with error: $err");
+	};
+
+	if( !$err and $stat and $stat->type eq 'success' ) {
+		$logger->info("hold_notify: successfully sent hold notification");
+		return 1;
+	} else {
+		$logger->warn("hold_notify: unable to send hold notification: ".Dumper($stat));
+		return 0;
+	}
+
+	return undef;
+}
+
+
+# -------------------------------------------------------------------------
+# Fetches all of the hold-related data
+# -------------------------------------------------------------------------
+sub fetch_data {
+	my $self		= shift;
+	my $holdid	= shift;
+	my $e			= $self->editor;
+
+	$logger->debug("circulator: fetching hold notify data");
+
+	$self->hold($e->retrieve_action_hold_request($holdid)) or return $self->event($e->event);
+	$self->copy($e->retrieve_asset_copy($self->hold->current_copy)) or return $self->event($e->event);
+	$self->volume($e->retrieve_asset_call_number($self->copy->call_number)) or return $self->event($e->event);
+	$self->title($e->retrieve_biblio_record_entry($self->volume->record)) or return $self->event($e->event);
+	$self->patron($e->retrieve_actor_user($self->hold->usr)) or return $self->event($e->event);
+	$self->pickup_lib($e->retrieve_actor_org_unit($self->hold->pickup_lib)) or return $self->event($e->event);
+}
+
+
+sub extract_data {
+	my $self = shift;
+	my $e = $self->editor;
+
+	my $patron = $self->patron;
+	my $o_name = $self->pickup_lib->name;
+	my $p_name = $patron->first_given_name .' '.$patron->family_name;
+
+	# try to find a suitable address for the patron
+	my $p_addr;
+	my $p_addrs;
+	unless( $p_addr = 
+			$e->retrieve_actor_user_address($patron->billing_address)) {
+		unless( $p_addr = 
+				$e->retrieve_actor_user_address($patron->mailing_address)) {
+			$logger->warn("hold_notify: No address for user ".$patron->id);
+			$p_addrs = "";
+		}
+	}
+
+	unless( defined $p_addrs ) {
+		$p_addrs = 
+			$p_addr->street1." ".
+			$p_addr->street2." ".
+			$p_addr->city." ".
+			$p_addr->state." ".
+			$p_addr->post_code;
+	}
+
+	my $l_addr = $e->retrieve_actor_org_address($self->pickup_lib->holds_address);
+	my $l_addrs = (!$l_addr) ? "" : 
+			$l_addr->street1." ".
+			$l_addr->street2." ".
+			$l_addr->city." ".
+			$l_addr->state." ".
+			$l_addr->post_code;
+
+	my $title;	
+	my $author;
+
+	if( $self->title->id == OILS_PRECAT_RECORD ) {
+		$title = ($self->copy->dummy_title) ? 
+			$self->copy->dummy_title : "";
+		$author = ($self->copy->dummy_author) ? 
+			$self->copy->dummy_author : "";
+	} else {
+		my $mods	= $U->record_to_mvr($self->title);
+		$title	= ($mods->title) ? $mods->title : "";
+		$author	= ($mods->author) ? $mods->author : "";
+	}
+
+
+	return { 
+		patron_email => $self->patron->email,
+		pickup_lib_name => $o_name,
+		pickup_lib_addr => $l_addrs,
+		patron_name => $p_name, 
+		patron_addr => $p_addrs, 
+		title => $title, 
+		author => $author, 
+		call_number => $self->volume->label,
+		copy_barcode => $self->copy->barcode,
+		copy_number => $self->copy->copy_number,
+	};
+}
+
+
+
+sub load_template {
+	my $self = shift;
+	my $template = shift;
+
+	unless( open(F, $template) ) {
+		$logger->error("hold_notify: Unable to open hold notification template file: $template");
+		return undef;
+	}
+
+	# load the template, strip comments
+	my @lines = ;
+	close(F);
+
+	my $str = '';
+	for(@lines) {
+   	chomp $_;
+   	next if $_ =~ /^\s*\#/o;
+   	$_ =~ s/\#.*//og;
+   	$str .= "$_\n";
+	}
+
+	return $str;
+}
+
+sub flesh_template {
+	my( $self, $str ) = @_;
+	return undef unless $str;
+
+	my @time 	= CORE::localtime();
+	my $day 		= $time[3];
+	my $month 	= $time[4] + 1;
+	my $year 	= $time[5] + 1900;
+
+	my $data = $self->extract_data;
+
+	my $email		= $$data{patron_email};
+	my $p_name		= $$data{patron_name};
+	my $p_addr		= $$data{patron_addr};
+	my $o_name		= $$data{pickup_lib_name};
+	my $o_addr		= $$data{pickup_lib_addr};
+	my $title		= $$data{title};
+	my $author		= $$data{author};
+	my $cn			= $$data{call_number};
+	my $barcode		= $$data{copy_barcode};
+	my $copy_number = $$data{copy_number};
+
+	my $sender = $self->settings_client->config_value('email_notify', 'sender_address');
+	my $reply_to = $self->pickup_lib->email;
+	$reply_to ||= $sender; 
+
+   # if they have an org setting for bounced emails, use that as the sender address
+   if( my $set = $self->editor->search_actor_org_unit_setting(
+         {  name => OILS_SETTING_ORG_BOUNCED_EMAIL, 
+            org_unit => $self->pickup_lib->id } )->[0] ) {
+
+      my $bemail = OpenSRF::Utils::JSON->JSON2perl($set->value);
+      $sender = $bemail if $bemail;
+   }
+
+   $str =~ s/\${EMAIL_SENDER}/$sender/;
+   $str =~ s/\${EMAIL_RECIPIENT}/$email/;
+   $str =~ s/\${EMAIL_REPLY_TO}/$reply_to/;
+   $str =~ s/\${EMAIL_HEADERS}//;
+
+   $str =~ s/\${DATE}/$year-$month-$day/;
+   $str =~ s/\${LIBRARY}/$o_name/;
+   $str =~ s/\${LIBRARY_ADDRESS}/$o_addr/;
+   $str =~ s/\${PATRON_NAME}/$p_name/;
+   $str =~ s/\${PATRON_ADDRESS}/$p_addr/;
+
+   $str =~ s/\${TITLE}/$title/;
+   $str =~ s/\${AUTHOR}/$author/;
+   $str =~ s/\${CALL_NUMBER}/$cn/;
+   $str =~ s/\${COPY_BARCODE}/$barcode/;
+   $str =~ s/\${COPY_NUMBER}/$copy_number/;
+
+	return $str;
+}
+
+
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Holds.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Holds.pm
new file mode 100644
index 0000000000..c95bafe6f2
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Holds.pm
@@ -0,0 +1,3356 @@
+# ---------------------------------------------------------------
+# Copyright (C) 2005  Georgia Public Library Service 
+# Bill Erickson 
+
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# ---------------------------------------------------------------
+
+
+package OpenILS::Application::Circ::Holds;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+use OpenILS::Application::AppUtils;
+use DateTime;
+use Data::Dumper;
+use OpenSRF::EX qw(:try);
+use OpenILS::Perm;
+use OpenILS::Event;
+use OpenSRF::Utils;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Utils::PermitHold;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Const qw/:const/;
+use OpenILS::Application::Circ::Transit;
+use OpenILS::Application::Actor::Friends;
+use DateTime;
+use DateTime::Format::ISO8601;
+use OpenSRF::Utils qw/:datetime/;
+use Digest::MD5 qw(md5_hex);
+use OpenSRF::Utils::Cache;
+my $apputils = "OpenILS::Application::AppUtils";
+my $U = $apputils;
+
+
+__PACKAGE__->register_method(
+    method    => "create_hold_batch",
+    api_name  => "open-ils.circ.holds.create.batch",
+    stream => 1,
+    signature => {
+        desc => q/@see open-ils.circ.holds.create.batch/,
+        params => [
+            { desc => 'Authentication token', type => 'string' },
+            { desc => 'Array of hold objects', type => 'array' }
+        ],
+        return => {
+            desc => 'Array of hold ID on success, -1 on missing arg, event (or ref to array of events) on error(s)',
+        },
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "create_hold_batch",
+    api_name  => "open-ils.circ.holds.create.override.batch",
+    stream => 1,
+    signature => {
+        desc  => '@see open-ils.circ.holds.create.batch',
+    }
+);
+
+
+sub create_hold_batch {
+	my( $self, $conn, $auth, $hold_list ) = @_;
+    (my $method = $self->api_name) =~ s/\.batch//og;
+    foreach (@$hold_list) {
+        my ($res) = $self->method_lookup($method)->run($auth, $_);
+        $conn->respond($res);
+    }
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+    method    => "create_hold",
+    api_name  => "open-ils.circ.holds.create",
+    signature => {
+        desc => "Create a new hold for an item.  From a permissions perspective, " .
+                "the login session is used as the 'requestor' of the hold.  "      . 
+                "The hold recipient is determined by the 'usr' setting within the hold object. " .
+                'First we verify the requestor has holds request permissions.  '         .
+                'Then we verify that the recipient is allowed to make the given hold.  ' .
+                'If not, we see if the requestor has "override" capabilities.  If not, ' .
+                'a permission exception is returned.  If permissions allow, we cycle '   .
+                'through the set of holds objects and create.  '                         .
+                'If the recipient does not have permission to place multiple holds '     .
+                'on a single title and said operation is attempted, a permission '       .
+                'exception is returned',
+        params => [
+            { desc => 'Authentication token',               type => 'string' },
+            { desc => 'Hold object for hold to be created',
+                type => 'object', class => 'ahr' }
+        ],
+        return => {
+            desc => 'New ahr ID on success, -1 on missing arg, event (or ref to array of events) on error(s)',
+        },
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "create_hold",
+    api_name  => "open-ils.circ.holds.create.override",
+    notes     => '@see open-ils.circ.holds.create',
+    signature => {
+        desc  => "If the recipient is not allowed to receive the requested hold, " .
+                 "call this method to attempt the override",
+        params => [
+            { desc => 'Authentication token',               type => 'string' },
+            {
+                desc => 'Hold object for hold to be created',
+                type => 'object', class => 'ahr'
+            }
+        ],
+        return => {
+            desc => 'New hold (ahr) ID on success, -1 on missing arg, event (or ref to array of events) on error(s)',
+        },
+    }
+);
+
+sub create_hold {
+	my( $self, $conn, $auth, $hold ) = @_;
+    return -1 unless $hold;
+	my $e = new_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+
+	my $override = 1 if $self->api_name =~ /override/;
+
+    my @events;
+
+    my $requestor = $e->requestor;
+    my $recipient = $requestor;
+
+    if( $requestor->id ne $hold->usr ) {
+        # Make sure the requestor is allowed to place holds for 
+        # the recipient if they are not the same people
+        $recipient = $e->retrieve_actor_user($hold->usr)  or return $e->die_event;
+        $e->allowed('REQUEST_HOLDS', $recipient->home_ou) or return $e->die_event;
+    }
+
+    # If the related org setting tells us to, block if patron privs have expired
+    my $expire_setting = $U->ou_ancestor_setting_value($recipient->home_ou, OILS_SETTING_BLOCK_HOLD_FOR_EXPIRED_PATRON);
+    if ($expire_setting) {
+        my $expire = DateTime::Format::ISO8601->new->parse_datetime(
+            cleanse_ISO8601($recipient->expire_date));
+
+        push( @events, OpenILS::Event->new(
+            'PATRON_ACCOUNT_EXPIRED',
+            "payload" => {"fail_part" => "actor.usr.privs_expired"}
+            )) if( CORE::time > $expire->epoch ) ;
+    }
+
+    # Now make sure the recipient is allowed to receive the specified hold
+    my $porg = $recipient->home_ou;
+    my $rid  = $e->requestor->id;
+    my $t    = $hold->hold_type;
+
+    # See if a duplicate hold already exists
+    my $sargs = {
+        usr			=> $recipient->id, 
+        hold_type	=> $t, 
+        fulfillment_time => undef, 
+        target		=> $hold->target,
+        cancel_time	=> undef,
+    };
+
+    $sargs->{holdable_formats} = $hold->holdable_formats if $t eq 'M';
+        
+    my $existing = $e->search_action_hold_request($sargs); 
+    push( @events, OpenILS::Event->new('HOLD_EXISTS')) if @$existing;
+
+    my $checked_out = hold_item_is_checked_out($e, $recipient->id, $hold->hold_type, $hold->target);
+    push( @events, OpenILS::Event->new('HOLD_ITEM_CHECKED_OUT')) if $checked_out;
+
+    if ( $t eq OILS_HOLD_TYPE_METARECORD ) {
+        return $e->die_event unless $e->allowed('MR_HOLDS',     $porg);
+    } elsif ( $t eq OILS_HOLD_TYPE_TITLE ) {
+        return $e->die_event unless $e->allowed('TITLE_HOLDS',  $porg);
+    } elsif ( $t eq OILS_HOLD_TYPE_VOLUME ) {
+        return $e->die_event unless $e->allowed('VOLUME_HOLDS', $porg);
+    } elsif ( $t eq OILS_HOLD_TYPE_ISSUANCE ) {
+        return $e->die_event unless $e->allowed('ISSUANCE_HOLDS', $porg);
+    } elsif ( $t eq OILS_HOLD_TYPE_COPY ) {
+        return $e->die_event unless $e->allowed('COPY_HOLDS',   $porg);
+    } elsif ( $t eq OILS_HOLD_TYPE_FORCE ) {
+        return $e->die_event unless $e->allowed('COPY_HOLDS',   $porg);
+    } elsif ( $t eq OILS_HOLD_TYPE_RECALL ) {
+        return $e->die_event unless $e->allowed('COPY_HOLDS',   $porg);
+    }
+
+    if( @events ) {
+        if (!$override) {
+            $e->rollback;
+            return \@events;
+        }
+        for my $evt (@events) {
+            next unless $evt;
+            my $name = $evt->{textcode};
+            return $e->die_event unless $e->allowed("$name.override", $porg);
+        }
+    }
+
+    # set the configured expire time
+    unless($hold->expire_time) {
+        my $interval = $U->ou_ancestor_setting_value($recipient->home_ou, OILS_SETTING_HOLD_EXPIRE);
+        if($interval) {
+            my $date = DateTime->now->add(seconds => OpenSRF::Utils::interval_to_seconds($interval));
+            $hold->expire_time($U->epoch2ISO8601($date->epoch));
+        }
+    }
+
+    $hold->requestor($e->requestor->id); 
+    $hold->request_lib($e->requestor->ws_ou);
+    $hold->selection_ou($hold->pickup_lib) unless $hold->selection_ou;
+    $hold = $e->create_action_hold_request($hold) or return $e->die_event;
+
+	$e->commit;
+
+	$conn->respond_complete($hold->id);
+
+    $U->storagereq(
+        'open-ils.storage.action.hold_request.copy_targeter', 
+        undef, $hold->id ) unless $U->is_true($hold->frozen);
+
+	return undef;
+}
+
+# makes sure that a user has permission to place the type of requested hold
+# returns the Perm exception if not allowed, returns undef if all is well
+sub _check_holds_perm {
+	my($type, $user_id, $org_id) = @_;
+
+	my $evt;
+	if ($type eq "M") {
+		$evt = $apputils->check_perms($user_id, $org_id, "MR_HOLDS"    );
+	} elsif ($type eq "T") {
+		$evt = $apputils->check_perms($user_id, $org_id, "TITLE_HOLDS" );
+	} elsif($type eq "V") {
+		$evt = $apputils->check_perms($user_id, $org_id, "VOLUME_HOLDS");
+	} elsif($type eq "C") {
+		$evt = $apputils->check_perms($user_id, $org_id, "COPY_HOLDS"  );
+	}
+
+    return $evt if $evt;
+	return undef;
+}
+
+# tests if the given user is allowed to place holds on another's behalf
+sub _check_request_holds_perm {
+	my $user_id = shift;
+	my $org_id  = shift;
+	if (my $evt = $apputils->check_perms(
+		$user_id, $org_id, "REQUEST_HOLDS")) {
+		return $evt;
+	}
+}
+
+my $ses_is_req_note = 'The login session is the requestor.  If the requestor is different from the user, ' .
+                      'then the requestor must have VIEW_HOLD permissions';
+
+__PACKAGE__->register_method(
+    method    => "retrieve_holds_by_id",
+    api_name  => "open-ils.circ.holds.retrieve_by_id",
+    signature => {
+        desc   => "Retrieve the hold, with hold transits attached, for the specified ID.  $ses_is_req_note",
+        params => [
+            { desc => 'Authentication token', type => 'string' },
+            { desc => 'Hold ID',              type => 'number' }
+        ],
+        return => {
+            desc => 'Hold object with transits attached, event on error',
+        }
+    }
+);
+
+
+sub retrieve_holds_by_id {
+	my($self, $client, $auth, $hold_id) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	$e->checkauth or return $e->event;
+	$e->allowed('VIEW_HOLD') or return $e->event;
+
+	my $holds = $e->search_action_hold_request(
+		[
+			{ id =>  $hold_id , fulfillment_time => undef }, 
+			{ 
+                order_by => { ahr => "request_time" },
+                flesh => 1,
+                flesh_fields => {ahr => ['notes']}
+            }
+		]
+	);
+
+	flesh_hold_transits($holds);
+	flesh_hold_notices($holds, $e);
+	return $holds;
+}
+
+
+__PACKAGE__->register_method(
+    method    => "retrieve_holds",
+    api_name  => "open-ils.circ.holds.retrieve",
+    signature => {
+        desc   => "Retrieves all the holds, with hold transits attached, for the specified user.  $ses_is_req_note",
+        params => [
+            { desc => 'Authentication token', type => 'string'  },
+            { desc => 'User ID',              type => 'integer' }
+        ],
+        return => {
+            desc => 'list of holds, event on error',
+        }
+   }
+);
+
+__PACKAGE__->register_method(
+    method        => "retrieve_holds",
+    api_name      => "open-ils.circ.holds.id_list.retrieve",
+    authoritative => 1,
+    signature     => {
+        desc   => "Retrieves all the hold IDs, for the specified user.  $ses_is_req_note",
+        params => [
+            { desc => 'Authentication token', type => 'string'  },
+            { desc => 'User ID',              type => 'integer' }
+        ],
+        return => {
+            desc => 'list of holds, event on error',
+        }
+   }
+);
+
+__PACKAGE__->register_method(
+    method        => "retrieve_holds",
+    api_name      => "open-ils.circ.holds.canceled.retrieve",
+    authoritative => 1,
+    signature     => {
+        desc   => "Retrieves all the cancelled holds for the specified user.  $ses_is_req_note",
+        params => [
+            { desc => 'Authentication token', type => 'string'  },
+            { desc => 'User ID',              type => 'integer' }
+        ],
+        return => {
+            desc => 'list of holds, event on error',
+        }
+   }
+);
+
+__PACKAGE__->register_method(
+    method        => "retrieve_holds",
+    api_name      => "open-ils.circ.holds.canceled.id_list.retrieve",
+    authoritative => 1,
+    signature     => {
+        desc   => "Retrieves list of cancelled hold IDs for the specified user.  $ses_is_req_note",
+        params => [
+            { desc => 'Authentication token', type => 'string'  },
+            { desc => 'User ID',              type => 'integer' }
+        ],
+        return => {
+            desc => 'list of hold IDs, event on error',
+        }
+   }
+);
+
+
+sub retrieve_holds {
+    my ($self, $client, $auth, $user_id) = @_;
+
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    $user_id = $e->requestor->id unless defined $user_id;
+
+    my $notes_filter = {staff => 'f'};
+    my $user = $e->retrieve_actor_user($user_id) or return $e->event;
+    unless($user_id == $e->requestor->id) {
+        if($e->allowed('VIEW_HOLD', $user->home_ou)) {
+            $notes_filter = {staff => 't'}
+        } else {
+            my $allowed = OpenILS::Application::Actor::Friends->friend_perm_allowed(
+                $e, $user_id, $e->requestor->id, 'hold.view');
+            return $e->event unless $allowed;
+        }
+    } else {
+        # staff member looking at his/her own holds can see staff and non-staff notes
+        $notes_filter = {} if $e->allowed('VIEW_HOLD', $user->home_ou);
+    }
+
+    my $holds_query = {
+        select => {ahr => ['id']},
+        from => 'ahr', 
+        where => {usr => $user_id, fulfillment_time => undef}
+    };
+
+    if($self->api_name =~ /canceled/) {
+
+        # Fetch the canceled holds
+        # order cancelled holds by cancel time, most recent first
+
+        $holds_query->{order_by} = [{class => 'ahr', field => 'cancel_time', direction => 'desc'}];
+
+        my $cancel_age;
+        my $cancel_count = $U->ou_ancestor_setting_value(
+                $e->requestor->ws_ou, 'circ.holds.canceled.display_count', $e);
+
+        unless($cancel_count) {
+            $cancel_age = $U->ou_ancestor_setting_value(
+                $e->requestor->ws_ou, 'circ.holds.canceled.display_age', $e);
+
+            # if no settings are defined, default to last 10 cancelled holds
+            $cancel_count = 10 unless $cancel_age;
+        }
+
+        if($cancel_count) { # limit by count
+
+            $holds_query->{where}->{cancel_time} = {'!=' => undef};
+            $holds_query->{limit} = $cancel_count;
+
+        } elsif($cancel_age) { # limit by age
+
+            # find all of the canceled holds that were canceled within the configured time frame
+            my $date = DateTime->now->subtract(seconds => OpenSRF::Utils::interval_to_seconds($cancel_age));
+            $date = $U->epoch2ISO8601($date->epoch);
+            $holds_query->{where}->{cancel_time} = {'>=' => $date};
+        }
+
+    } else {
+
+        # order non-cancelled holds by ready-for-pickup, then active, followed by suspended
+        $holds_query->{order_by} = {ahr => ['shelf_time', 'frozen', 'request_time']};
+        $holds_query->{where}->{cancel_time} = undef;
+    }
+
+    my $hold_ids = $e->json_query($holds_query);
+    $hold_ids = [ map { $_->{id} } @$hold_ids ];
+
+    return $hold_ids if $self->api_name =~ /id_list/;
+
+    my @holds;
+    for my $hold_id ( @$hold_ids ) {
+
+        my $hold = $e->retrieve_action_hold_request($hold_id);
+        $hold->notes($e->search_action_hold_request_note({hold => $hold_id, %$notes_filter}));
+
+        $hold->transit(
+            $e->search_action_hold_transit_copy([
+                {hold => $hold->id},
+                {order_by => {ahtc => 'source_send_time desc'}, limit => 1}])->[0]
+        );
+
+        push(@holds, $hold);
+    }
+
+    return \@holds;
+}
+
+
+__PACKAGE__->register_method(
+    method   => 'user_hold_count',
+    api_name => 'open-ils.circ.hold.user.count'
+);
+
+sub user_hold_count {
+    my ( $self, $conn, $auth, $userid ) = @_;
+    my $e = new_editor( authtoken => $auth );
+    return $e->event unless $e->checkauth;
+    my $patron = $e->retrieve_actor_user($userid)
+        or return $e->event;
+    return $e->event unless $e->allowed( 'VIEW_HOLD', $patron->home_ou );
+    return __user_hold_count( $self, $e, $userid );
+}
+
+sub __user_hold_count {
+    my ( $self, $e, $userid ) = @_;
+    my $holds = $e->search_action_hold_request(
+        {
+            usr              => $userid,
+            fulfillment_time => undef,
+            cancel_time      => undef,
+        },
+        { idlist => 1 }
+    );
+
+    return scalar(@$holds);
+}
+
+
+__PACKAGE__->register_method(
+    method   => "retrieve_holds_by_pickup_lib",
+    api_name => "open-ils.circ.holds.retrieve_by_pickup_lib",
+    notes    => 
+      "Retrieves all the holds, with hold transits attached, for the specified pickup_ou id."
+);
+
+__PACKAGE__->register_method(
+    method   => "retrieve_holds_by_pickup_lib",
+    api_name => "open-ils.circ.holds.id_list.retrieve_by_pickup_lib",
+    notes    => "Retrieves all the hold ids for the specified pickup_ou id. "
+);
+
+sub retrieve_holds_by_pickup_lib {
+    my ($self, $client, $login_session, $ou_id) = @_;
+
+    #FIXME -- put an appropriate permission check here
+    #my( $user, $target, $evt ) = $apputils->checkses_requestor(
+    #	$login_session, $user_id, 'VIEW_HOLD' );
+    #return $evt if $evt;
+
+	my $holds = $apputils->simplereq(
+		'open-ils.cstore',
+		"open-ils.cstore.direct.action.hold_request.search.atomic",
+		{ 
+			pickup_lib =>  $ou_id , 
+			fulfillment_time => undef,
+			cancel_time => undef
+		}, 
+		{ order_by => { ahr => "request_time" } }
+    );
+
+    if ( ! $self->api_name =~ /id_list/ ) {
+        flesh_hold_transits($holds);
+        return $holds;
+    }
+    # else id_list
+    return [ map { $_->id } @$holds ];
+}
+
+
+__PACKAGE__->register_method(
+    method   => "uncancel_hold",
+    api_name => "open-ils.circ.hold.uncancel"
+);
+
+sub uncancel_hold {
+	my($self, $client, $auth, $hold_id) = @_;
+	my $e = new_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+
+	my $hold = $e->retrieve_action_hold_request($hold_id)
+		or return $e->die_event;
+    return $e->die_event unless $e->allowed('CANCEL_HOLDS', $hold->request_lib);
+
+    if ($hold->fulfillment_time) {
+        $e->rollback;
+        return 0;
+    }
+    unless ($hold->cancel_time) {
+        $e->rollback;
+        return 1;
+    }
+
+    # if configured to reset the request time, also reset the expire time
+    if($U->ou_ancestor_setting_value(
+        $hold->request_lib, 'circ.holds.uncancel.reset_request_time', $e)) {
+
+        $hold->request_time('now');
+        my $interval = $U->ou_ancestor_setting_value($hold->request_lib, OILS_SETTING_HOLD_EXPIRE);
+        if($interval) {
+            my $date = DateTime->now->add(seconds => OpenSRF::Utils::interval_to_seconds($interval));
+            $hold->expire_time($U->epoch2ISO8601($date->epoch));
+        }
+    }
+
+    $hold->clear_cancel_time;
+    $hold->clear_cancel_cause;
+    $hold->clear_cancel_note;
+    $e->update_action_hold_request($hold) or return $e->die_event;
+    $e->commit;
+
+    $U->storagereq('open-ils.storage.action.hold_request.copy_targeter', undef, $hold_id);
+
+    return 1;
+}
+
+
+__PACKAGE__->register_method(
+    method    => "cancel_hold",
+    api_name  => "open-ils.circ.hold.cancel",
+    signature => {
+        desc   => 'Cancels the specified hold.  The login session is the requestor.  If the requestor is different from the usr field ' .
+                  'on the hold, the requestor must have CANCEL_HOLDS permissions. The hold may be either the hold object or the hold id',
+        param  => [
+            {desc => 'Authentication token',  type => 'string'},
+            {desc => 'Hold ID',               type => 'number'},
+            {desc => 'Cause of Cancellation', type => 'string'},
+            {desc => 'Note',                  type => 'string'}
+        ],
+        return => {
+            desc => '1 on success, event on error'
+        }
+    }
+);
+
+sub cancel_hold {
+	my($self, $client, $auth, $holdid, $cause, $note) = @_;
+
+	my $e = new_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+
+	my $hold = $e->retrieve_action_hold_request($holdid)
+		or return $e->die_event;
+
+	if( $e->requestor->id ne $hold->usr ) {
+		return $e->die_event unless $e->allowed('CANCEL_HOLDS');
+	}
+
+	if ($hold->cancel_time) {
+        $e->rollback;
+        return 1;
+    }
+
+	# If the hold is captured, reset the copy status
+	if( $hold->capture_time and $hold->current_copy ) {
+
+		my $copy = $e->retrieve_asset_copy($hold->current_copy)
+			or return $e->die_event;
+
+		if( $copy->status == OILS_COPY_STATUS_ON_HOLDS_SHELF ) {
+         $logger->info("canceling hold $holdid whose item is on the holds shelf");
+#			$logger->info("setting copy to status 'reshelving' on hold cancel");
+#			$copy->status(OILS_COPY_STATUS_RESHELVING);
+#			$copy->editor($e->requestor->id);
+#			$copy->edit_date('now');
+#			$e->update_asset_copy($copy) or return $e->event;
+
+		} elsif( $copy->status == OILS_COPY_STATUS_IN_TRANSIT ) {
+
+			my $hid = $hold->id;
+			$logger->warn("! canceling hold [$hid] that is in transit");
+			my $transid = $e->search_action_hold_transit_copy({hold=>$hold->id},{idlist=>1})->[0];
+
+			if( $transid ) {
+				my $trans = $e->retrieve_action_transit_copy($transid);
+				# Leave the transit alive, but  set the copy status to 
+				# reshelving so it will be properly reshelved when it gets back home
+				if( $trans ) {
+					$trans->copy_status( OILS_COPY_STATUS_RESHELVING );
+					$e->update_action_transit_copy($trans) or return $e->die_event;
+				}
+			}
+		}
+	}
+
+	$hold->cancel_time('now');
+    $hold->cancel_cause($cause);
+    $hold->cancel_note($note);
+	$e->update_action_hold_request($hold)
+		or return $e->die_event;
+
+	delete_hold_copy_maps($self, $e, $hold->id);
+
+	$e->commit;
+
+    $U->create_events_for_hook('hold_request.cancel.staff', $hold, $hold->pickup_lib)
+        if $e->requestor->id != $hold->usr;
+
+	return 1;
+}
+
+sub delete_hold_copy_maps {
+	my $class  = shift;
+	my $editor = shift;
+	my $holdid = shift;
+
+	my $maps = $editor->search_action_hold_copy_map({hold=>$holdid});
+	for(@$maps) {
+		$editor->delete_action_hold_copy_map($_) 
+			or return $editor->event;
+	}
+	return undef;
+}
+
+
+my $update_hold_desc = 'The login session is the requestor. '       .
+   'If the requestor is different from the usr field on the hold, ' .
+   'the requestor must have UPDATE_HOLDS permissions. '             .
+   'If supplying a hash of hold data, "id" must be included. '      .
+   'The hash is ignored if a hold object is supplied, '             .
+   'so you should supply only one kind of hold data argument.'      ;
+
+__PACKAGE__->register_method(
+    method    => "update_hold",
+    api_name  => "open-ils.circ.hold.update",
+    signature => {
+        desc   => "Updates the specified hold.  $update_hold_desc",
+        params => [
+            {desc => 'Authentication token',         type => 'string'},
+            {desc => 'Hold Object',                  type => 'object'},
+            {desc => 'Hash of values to be applied', type => 'object'}
+        ],
+        return => {
+            desc => 'Hold ID on success, event on error',
+            # type => 'number'
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "batch_update_hold",
+    api_name  => "open-ils.circ.hold.update.batch",
+    stream    => 1,
+    signature => {
+        desc   => "Updates the specified hold(s).  $update_hold_desc",
+        params => [
+            {desc => 'Authentication token',                    type => 'string'},
+            {desc => 'Array of hold obejcts',                   type => 'array' },
+            {desc => 'Array of hashes of values to be applied', type => 'array' }
+        ],
+        return => {
+            desc => 'Hold ID per success, event per error',
+        }
+    }
+);
+
+sub update_hold {
+	my($self, $client, $auth, $hold, $values) = @_;
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+    my $resp = update_hold_impl($self, $e, $hold, $values);
+    if ($U->event_code($resp)) {
+        $e->rollback;
+        return $resp;
+    }
+    $e->commit;     # FIXME: update_hold_impl already does $e->commit  ??
+    return $resp;
+}
+
+sub batch_update_hold {
+	my($self, $client, $auth, $hold_list, $values_list) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $count = ($hold_list) ? scalar(@$hold_list) : scalar(@$values_list);     # FIXME: we don't know for sure that we got $values_list.  we could have neither list.
+    $hold_list   ||= [];
+    $values_list ||= [];      # FIXME: either move this above $count declaration, or send an event if both lists undef.  Probably the latter.
+
+# FIXME: Failing over to [] guarantees warnings for "Use of unitialized value" in update_hold_impl call.
+# FIXME: We should be sure we only call update_hold_impl with hold object OR hash, not both.
+
+    for my $idx (0..$count-1) {
+        $e->xact_begin;
+        my $resp = update_hold_impl($self, $e, $hold_list->[$idx], $values_list->[$idx]);
+        $e->xact_commit unless $U->event_code($resp);
+        $client->respond($resp);
+    }
+
+    $e->disconnect;
+    return undef;       # not in the register return type, assuming we should always have at least one list populated
+}
+
+sub update_hold_impl {
+    my($self, $e, $hold, $values) = @_;
+
+    unless($hold) {
+        $hold = $e->retrieve_action_hold_request($values->{id})
+            or return $e->die_event;
+        for my $k (keys %$values) {
+            if (defined $values->{$k}) {
+                $hold->$k($values->{$k});
+            } else {
+                my $f = "clear_$k"; $hold->$f();
+            }
+        }
+    }
+
+    my $orig_hold = $e->retrieve_action_hold_request($hold->id)
+        or return $e->die_event;
+
+    # don't allow the user to be changed
+    return OpenILS::Event->new('BAD_PARAMS') if $hold->usr != $orig_hold->usr;
+
+    if($hold->usr ne $e->requestor->id) {
+        # if the hold is for a different user, make sure the 
+        # requestor has the appropriate permissions
+        my $usr = $e->retrieve_actor_user($hold->usr)
+            or return $e->die_event;
+        return $e->die_event unless $e->allowed('UPDATE_HOLD', $usr->home_ou);
+    }
+
+
+    # --------------------------------------------------------------
+    # Changing the request time is like playing God
+    # --------------------------------------------------------------
+    if($hold->request_time ne $orig_hold->request_time) {
+        return OpenILS::Event->new('BAD_PARAMS') if $hold->fulfillment_time;
+        return $e->die_event unless $e->allowed('UPDATE_HOLD_REQUEST_TIME', $hold->pickup_lib);
+    }
+
+    # --------------------------------------------------------------
+    # if the hold is on the holds shelf or in transit and the pickup 
+    # lib changes we need to create a new transit.
+    # --------------------------------------------------------------
+    if($orig_hold->pickup_lib ne $hold->pickup_lib) {
+
+        my $status = _hold_status($e, $hold);
+
+        if($status == 3) { # in transit
+
+            return $e->die_event unless $e->allowed('UPDATE_PICKUP_LIB_FROM_TRANSIT', $orig_hold->pickup_lib);
+            return $e->die_event unless $e->allowed('UPDATE_PICKUP_LIB_FROM_TRANSIT', $hold->pickup_lib);
+
+            $logger->info("updating pickup lib for hold ".$hold->id." while already in transit");
+
+            # update the transit to reflect the new pickup location
+			my $transit = $e->search_action_hold_transit_copy(
+                {hold=>$hold->id, dest_recv_time => undef})->[0] 
+                or return $e->die_event;
+
+            $transit->prev_dest($transit->dest); # mark the previous destination on the transit
+            $transit->dest($hold->pickup_lib);
+            $e->update_action_hold_transit_copy($transit) or return $e->die_event;
+
+        } elsif($status == 4) { # on holds shelf
+
+            return $e->die_event unless $e->allowed('UPDATE_PICKUP_LIB_FROM_HOLDS_SHELF', $orig_hold->pickup_lib);
+            return $e->die_event unless $e->allowed('UPDATE_PICKUP_LIB_FROM_HOLDS_SHELF', $hold->pickup_lib);
+
+            $logger->info("updating pickup lib for hold ".$hold->id." while on holds shelf");
+
+            # create the new transit
+            my $evt = transit_hold($e, $orig_hold, $hold, $e->retrieve_asset_copy($hold->current_copy));
+            return $evt if $evt;
+        }
+    } 
+
+    update_hold_if_frozen($self, $e, $hold, $orig_hold);
+    $e->update_action_hold_request($hold) or return $e->die_event;
+    $e->commit;
+
+    # a change to mint-condition changes the set of potential copies, so retarget the hold;
+    if($U->is_true($hold->mint_condition) and !$U->is_true($orig_hold->mint_condition)) {
+        _reset_hold($self, $e->requestor, $hold) 
+    }
+
+    return $hold->id;
+}
+
+sub transit_hold {
+    my($e, $orig_hold, $hold, $copy) = @_;
+    my $src  = $orig_hold->pickup_lib;
+    my $dest = $hold->pickup_lib;
+
+    $logger->info("putting hold into transit on pickup_lib update");
+
+    my $transit = Fieldmapper::action::hold_transit_copy->new;
+    $transit->hold($hold->id);
+    $transit->source($src);
+    $transit->dest($dest);
+    $transit->target_copy($copy->id);
+    $transit->source_send_time('now');
+    $transit->copy_status(OILS_COPY_STATUS_ON_HOLDS_SHELF);
+
+    $copy->status(OILS_COPY_STATUS_IN_TRANSIT);
+    $copy->editor($e->requestor->id);
+    $copy->edit_date('now');
+
+    $e->create_action_hold_transit_copy($transit) or return $e->die_event;
+    $e->update_asset_copy($copy) or return $e->die_event;
+    return undef;
+}
+
+# if the hold is frozen, this method ensures that the hold is not "targeted", 
+# that is, it clears the current_copy and prev_check_time to essentiallly 
+# reset the hold.  If it is being activated, it runs the targeter in the background
+sub update_hold_if_frozen {
+    my($self, $e, $hold, $orig_hold) = @_;
+    return if $hold->capture_time;
+
+    if($U->is_true($hold->frozen)) {
+        $logger->info("clearing current_copy and check_time for frozen hold ".$hold->id);
+        $hold->clear_current_copy;
+        $hold->clear_prev_check_time;
+
+    } else {
+        if($U->is_true($orig_hold->frozen)) {
+            $logger->info("Running targeter on activated hold ".$hold->id);
+            $U->storagereq( 'open-ils.storage.action.hold_request.copy_targeter', undef, $hold->id );
+        }
+    }
+}
+
+__PACKAGE__->register_method(
+    method    => "hold_note_CUD",
+    api_name  => "open-ils.circ.hold_request.note.cud",
+    signature => {
+        desc   => 'Create, update or delete a hold request note.  If the operator (from Auth. token) '
+                . 'is not the owner of the hold, the UPDATE_HOLD permission is required',
+        params => [
+            { desc => 'Authentication token', type => 'string' },
+            { desc => 'Hold note object',     type => 'object' }
+        ],
+        return => {
+            desc => 'Returns the note ID, event on error'
+        },
+    }
+);
+
+sub hold_note_CUD {
+	my($self, $conn, $auth, $note) = @_;
+
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+
+    my $hold = $e->retrieve_action_hold_request($note->hold)
+        or return $e->die_event;
+
+    if($hold->usr ne $e->requestor->id) {
+        my $usr = $e->retrieve_actor_user($hold->usr);
+        return $e->die_event unless $e->allowed('UPDATE_HOLD', $usr->home_ou);
+        $note->staff('t') if $note->isnew;
+    }
+
+    if($note->isnew) {
+        $e->create_action_hold_request_note($note) or return $e->die_event;
+    } elsif($note->ischanged) {
+        $e->update_action_hold_request_note($note) or return $e->die_event;
+    } elsif($note->isdeleted) {
+        $e->delete_action_hold_request_note($note) or return $e->die_event;
+    }
+
+    $e->commit;
+    return $note->id;
+}
+
+
+__PACKAGE__->register_method(
+    method    => "retrieve_hold_status",
+    api_name  => "open-ils.circ.hold.status.retrieve",
+    signature => {
+        desc   => 'Calculates the current status of the hold. The requestor must have '      .
+                  'VIEW_HOLD permissions if the hold is for a user other than the requestor' ,
+        param  => [
+            { desc => 'Hold ID', type => 'number' }
+        ],
+        return => {
+            # type => 'number',     # event sometimes
+            desc => <<'END_OF_DESC'
+Returns event on error or:
+-1 on error (for now),
+ 1 for 'waiting for copy to become available',
+ 2 for 'waiting for copy capture',
+ 3 for 'in transit',
+ 4 for 'arrived',
+ 5 for 'hold-shelf-delay'
+ 6 for 'canceled'
+END_OF_DESC
+        }
+    }
+);
+
+sub retrieve_hold_status {
+	my($self, $client, $auth, $hold_id) = @_;
+
+	my $e = new_editor(authtoken => $auth);
+	return $e->event unless $e->checkauth;
+	my $hold = $e->retrieve_action_hold_request($hold_id)
+		or return $e->event;
+
+	if( $e->requestor->id != $hold->usr ) {
+		return $e->event unless $e->allowed('VIEW_HOLD');
+	}
+
+	return _hold_status($e, $hold);
+
+}
+
+sub _hold_status {
+	my($e, $hold) = @_;
+    if ($hold->cancel_time) {
+        return 6;
+    }
+	return 1 unless $hold->current_copy;
+	return 2 unless $hold->capture_time;
+
+	my $copy = $hold->current_copy;
+	unless( ref $copy ) {
+		$copy = $e->retrieve_asset_copy($hold->current_copy)
+			or return $e->event;
+	}
+
+	return 3 if $copy->status == OILS_COPY_STATUS_IN_TRANSIT;
+
+	if($copy->status == OILS_COPY_STATUS_ON_HOLDS_SHELF) {
+
+        my $hs_wait_interval = $U->ou_ancestor_setting_value($hold->pickup_lib, 'circ.hold_shelf_status_delay');
+        return 4 unless $hs_wait_interval;
+
+        # if a hold_shelf_status_delay interval is defined and start_time plus 
+        # the interval is greater than now, consider the hold to be in the virtual 
+        # "on its way to the holds shelf" status. Return 5.
+
+        my $transit    = $e->search_action_hold_transit_copy({hold => $hold->id})->[0];
+        my $start_time = ($transit) ? $transit->dest_recv_time : $hold->capture_time;
+        $start_time    = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($start_time));
+        my $end_time   = $start_time->add(seconds => OpenSRF::Utils::interval_to_seconds($hs_wait_interval));
+
+        return 5 if $end_time > DateTime->now;
+        return 4;
+    }
+
+    return -1;  # error
+}
+
+
+
+__PACKAGE__->register_method(
+    method    => "retrieve_hold_queue_stats",
+    api_name  => "open-ils.circ.hold.queue_stats.retrieve",
+    signature => {
+        desc   => 'Returns summary data about the state of a hold',
+        params => [
+            { desc => 'Authentication token',  type => 'string'},
+            { desc => 'Hold ID', type => 'number'},
+        ],
+        return => {
+            desc => q/Summary object with keys: 
+                total_holds : total holds in queue
+                queue_position : current queue position
+                potential_copies : number of potential copies for this hold
+                estimated_wait : estimated wait time in days
+                status : hold status  
+                     -1 => error or unexpected state,
+                     1 => 'waiting for copy to become available',
+                     2 => 'waiting for copy capture',
+                     3 => 'in transit',
+                     4 => 'arrived',
+                     5 => 'hold-shelf-delay'
+            /,
+            type => 'object'
+        }
+    }
+);
+
+sub retrieve_hold_queue_stats {
+    my($self, $conn, $auth, $hold_id) = @_;
+	my $e = new_editor(authtoken => $auth);
+	return $e->event unless $e->checkauth;
+	my $hold = $e->retrieve_action_hold_request($hold_id) or return $e->event;
+	if($e->requestor->id != $hold->usr) {
+		return $e->event unless $e->allowed('VIEW_HOLD');
+	}
+    return retrieve_hold_queue_status_impl($e, $hold);
+}
+
+sub retrieve_hold_queue_status_impl {
+    my $e = shift;
+    my $hold = shift;
+
+    # The holds queue is defined as the distinct set of holds that share at 
+    # least one potential copy with the context hold, plus any holds that
+    # share the same hold type and target.  The latter part exists to
+    # accomodate holds that currently have no potential copies
+    my $q_holds = $e->json_query({
+
+        # fetch cut_in_line and request_time since they're in the order_by
+        # and we're asking for distinct values
+        select => {ahr => ['id', 'cut_in_line', 'request_time']},
+        from   => { ahr => 'ahcm' },
+        order_by => [
+            {
+                "class" => "ahr",
+                "field" => "cut_in_line",
+                "transform" => "coalesce",
+                "params" => [ 0 ],
+                "direction" => "desc"
+            },
+            { "class" => "ahr", "field" => "request_time" }
+        ],
+        distinct => 1,
+        where => {
+            '+ahcm' => {
+                target_copy => {
+                    in => {
+                        select => {ahcm => ['target_copy']},
+                        from   => 'ahcm',
+                        where  => {hold => $hold->id}
+                    } 
+                } 
+            }
+        }
+    });
+
+    if (!@$q_holds) { # none? maybe we don't have a map ... 
+        $q_holds = $e->json_query({
+            select => {ahr => ['id', 'cut_in_line', 'request_time']},
+            from   => 'ahr',
+            order_by => [
+                {
+                    "class" => "ahr",
+                    "field" => "cut_in_line",
+                    "transform" => "coalesce",
+                    "params" => [ 0 ],
+                    "direction" => "desc"
+                },
+                { "class" => "ahr", "field" => "request_time" }
+            ],
+            where    => {
+                hold_type => $hold->hold_type, 
+                target    => $hold->target 
+           } 
+        });
+    }
+
+
+    my $qpos = 1;
+    for my $h (@$q_holds) {
+        last if $h->{id} == $hold->id;
+        $qpos++;
+    }
+
+    my $hold_data = $e->json_query({
+        select => {
+            acp => [ {column => 'id', transform => 'count', aggregate => 1, alias => 'count'} ],
+            ccm => [ {column =>'avg_wait_time'} ]
+        }, 
+        from => {
+            ahcm => {
+                acp => {
+                    join => {
+                        ccm => {type => 'left'}
+                    }
+                }
+            }
+        }, 
+        where => {'+ahcm' => {hold => $hold->id} }
+    });
+
+    my $user_org = $e->json_query({select => {au => ['home_ou']}, from => 'au', where => {id => $hold->usr}})->[0]->{home_ou};
+
+    my $default_wait = $U->ou_ancestor_setting_value($user_org, OILS_SETTING_HOLD_ESIMATE_WAIT_INTERVAL);
+    my $min_wait = $U->ou_ancestor_setting_value($user_org, 'circ.holds.min_estimated_wait_interval');
+    $min_wait = OpenSRF::Utils::interval_to_seconds($min_wait || '0 seconds');
+    $default_wait ||= '0 seconds';
+
+    # Estimated wait time is the average wait time across the set 
+    # of potential copies, divided by the number of potential copies
+    # times the queue position.  
+
+    my $combined_secs = 0;
+    my $num_potentials = 0;
+
+    for my $wait_data (@$hold_data) {
+        my $count += $wait_data->{count};
+        $combined_secs += $count * 
+            OpenSRF::Utils::interval_to_seconds($wait_data->{avg_wait_time} || $default_wait);
+        $num_potentials += $count;
+    }
+
+    my $estimated_wait = -1;
+
+    if($num_potentials) {
+        my $avg_wait = $combined_secs / $num_potentials;
+        $estimated_wait = $qpos * ($avg_wait / $num_potentials);
+        $estimated_wait = $min_wait if $estimated_wait < $min_wait and $estimated_wait != -1;
+    }
+
+    return {
+        total_holds      => scalar(@$q_holds),
+        queue_position   => $qpos,
+        potential_copies => $num_potentials,
+        status           => _hold_status( $e, $hold ),
+        estimated_wait   => int($estimated_wait)
+    };
+}
+
+
+sub fetch_open_hold_by_current_copy {
+	my $class = shift;
+	my $copyid = shift;
+	my $hold = $apputils->simplereq(
+		'open-ils.cstore', 
+		'open-ils.cstore.direct.action.hold_request.search.atomic',
+		{ current_copy =>  $copyid , cancel_time => undef, fulfillment_time => undef });
+	return $hold->[0] if ref($hold);
+	return undef;
+}
+
+sub fetch_related_holds {
+	my $class = shift;
+	my $copyid = shift;
+	return $apputils->simplereq(
+		'open-ils.cstore', 
+		'open-ils.cstore.direct.action.hold_request.search.atomic',
+		{ current_copy =>  $copyid , cancel_time => undef, fulfillment_time => undef });
+}
+
+
+__PACKAGE__->register_method(
+    method    => "hold_pull_list",
+    api_name  => "open-ils.circ.hold_pull_list.retrieve",
+    signature => {
+        desc   => 'Returns (reference to) a list of holds that need to be "pulled" by a given location. ' .
+                  'The location is determined by the login session.',
+        params => [
+            { desc => 'Limit (optional)',  type => 'number'},
+            { desc => 'Offset (optional)', type => 'number'},
+        ],
+        return => {
+            desc => 'reference to a list of holds, or event on failure',
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "hold_pull_list",
+    api_name  => "open-ils.circ.hold_pull_list.id_list.retrieve",
+    signature => {
+        desc   => 'Returns (reference to) a list of holds IDs that need to be "pulled" by a given location. ' .
+                  'The location is determined by the login session.',
+        params => [
+            { desc => 'Limit (optional)',  type => 'number'},
+            { desc => 'Offset (optional)', type => 'number'},
+        ],
+        return => {
+            desc => 'reference to a list of holds, or event on failure',
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => "hold_pull_list",
+    api_name  => "open-ils.circ.hold_pull_list.retrieve.count",
+    signature => {
+        desc   => 'Returns a count of holds that need to be "pulled" by a given location. ' .
+                  'The location is determined by the login session.',
+        params => [
+            { desc => 'Limit (optional)',  type => 'number'},
+            { desc => 'Offset (optional)', type => 'number'},
+        ],
+        return => {
+            desc => 'Holds count (integer), or event on failure',
+            # type => 'number'
+        }
+    }
+);
+
+
+sub hold_pull_list {
+	my( $self, $conn, $authtoken, $limit, $offset ) = @_;
+	my( $reqr, $evt ) = $U->checkses($authtoken);
+	return $evt if $evt;
+
+	my $org = $reqr->ws_ou || $reqr->home_ou;
+	# the perm locaiton shouldn't really matter here since holds
+	# will exist all over and VIEW_HOLDS should be universal
+	$evt = $U->check_perms($reqr->id, $org, 'VIEW_HOLD');
+	return $evt if $evt;
+
+    if($self->api_name =~ /count/) {
+
+		my $count = $U->storagereq(
+			'open-ils.storage.direct.action.hold_request.pull_list.current_copy_circ_lib.status_filtered.count',
+			$org, $limit, $offset ); 
+
+        $logger->info("Grabbing pull list for org unit $org with $count items");
+        return $count;
+
+    } elsif( $self->api_name =~ /id_list/ ) {
+		return $U->storagereq(
+			'open-ils.storage.direct.action.hold_request.pull_list.id_list.current_copy_circ_lib.status_filtered.atomic',
+			$org, $limit, $offset ); 
+
+	} else {
+		return $U->storagereq(
+			'open-ils.storage.direct.action.hold_request.pull_list.search.current_copy_circ_lib.status_filtered.atomic',
+			$org, $limit, $offset ); 
+	}
+}
+
+__PACKAGE__->register_method(
+    method    => "print_hold_pull_list",
+    api_name  => "open-ils.circ.hold_pull_list.print",
+    signature => {
+        desc   => 'Returns an HTML-formatted holds pull list',
+        params => [
+            { desc => 'Authtoken', type => 'string'},
+            { desc => 'Org unit ID.  Optional, defaults to workstation org unit', type => 'number'},
+        ],
+        return => {
+            desc => 'HTML string',
+            type => 'string'
+        }
+    }
+);
+
+sub print_hold_pull_list {
+    my($self, $client, $auth, $org_id) = @_;
+
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+
+    $org_id = (defined $org_id) ? $org_id : $e->requestor->ws_ou;
+    return $e->event unless $e->allowed('VIEW_HOLD', $org_id);
+
+    my $hold_ids = $U->storagereq(
+        'open-ils.storage.direct.action.hold_request.pull_list.id_list.current_copy_circ_lib.status_filtered.atomic',
+        $org_id, 10000);
+
+    return undef unless @$hold_ids;
+
+    $client->status(new OpenSRF::DomainObject::oilsContinueStatus);
+
+    # Holds will /NOT/ be in order after this ...
+    my $holds = $e->search_action_hold_request({id => $hold_ids}, {substream => 1});
+    $client->status(new OpenSRF::DomainObject::oilsContinueStatus);
+
+    # ... so we must resort.
+    my $hold_map = +{map { $_->id => $_ } @$holds};
+    my $sorted_holds = [];
+    push @$sorted_holds, $hold_map->{$_} foreach @$hold_ids;
+
+    return $U->fire_object_event(
+        undef, "ahr.format.pull_list", $sorted_holds,
+        $org_id, undef, undef, $client
+    );
+
+}
+
+__PACKAGE__->register_method(
+    method    => "print_hold_pull_list_stream",
+    stream   => 1,
+    api_name  => "open-ils.circ.hold_pull_list.print.stream",
+    signature => {
+        desc   => 'Returns a stream of fleshed holds',
+        params => [
+            { desc => 'Authtoken', type => 'string'},
+            { desc => 'Hash of optional param: Org unit ID (defaults to workstation org unit), limit, offset, sort (array of: acplo.position, call_number, request_time)',
+              type => 'object'
+            },
+        ],
+        return => {
+            desc => 'A stream of fleshed holds',
+            type => 'object'
+        }
+    }
+);
+
+sub print_hold_pull_list_stream {
+    my($self, $client, $auth, $params) = @_;
+
+    my $e = new_editor(authtoken=>$auth);
+    return $e->die_event unless $e->checkauth;
+
+    delete($$params{org_id}) unless (int($$params{org_id}));
+    delete($$params{limit}) unless (int($$params{limit}));
+    delete($$params{offset}) unless (int($$params{offset}));
+    delete($$params{chunk_size}) unless (int($$params{chunk_size}));
+    delete($$params{chunk_size}) if  ($$params{chunk_size} && $$params{chunk_size} > 50); # keep the size reasonable
+    $$params{chunk_size} ||= 10;
+
+    $$params{org_id} = (defined $$params{org_id}) ? $$params{org_id}: $e->requestor->ws_ou;
+    return $e->die_event unless $e->allowed('VIEW_HOLD', $$params{org_id });
+
+    my $sort = [];
+    if ($$params{sort} && @{ $$params{sort} }) {
+        for my $s (@{ $$params{sort} }) {
+            if ($s eq 'acplo.position') {
+                push @$sort, {
+                    "class" => "acplo", "field" => "position",
+                    "transform" => "coalesce", "params" => [999]
+                };
+            } elsif ($s eq 'call_number') {
+                push @$sort, {"class" => "acn", "field" => "label"};
+            } elsif ($s eq 'request_time') {
+                push @$sort, {"class" => "ahr", "field" => "request_time"};
+            }
+        }
+    } else {
+        push @$sort, {"class" => "ahr", "field" => "request_time"};
+    }
+
+    my $holds_ids = $e->json_query(
+        {
+            "select" => {"ahr" => ["id"]},
+            "from" => {
+                "ahr" => {
+                    "acp" => { 
+                        "field" => "id",
+                        "fkey" => "current_copy",
+                        "filter" => {
+                            "circ_lib" => $$params{org_id}, "status" => [0,7]
+                        },
+                        "join" => {
+                            "acn" => {
+                                "field" => "id",
+                                "fkey" => "call_number" 
+                            },
+                            "acplo" => {
+                                "field" => "org",
+                                "fkey" => "circ_lib", 
+                                "type" => "left",
+                                "filter" => {
+                                    "location" => {"=" => {"+acp" => "location"}}
+                                }
+                            }
+                        }
+                    }
+                }
+            },
+            "where" => {
+                "+ahr" => {
+                    "capture_time" => undef,
+                    "cancel_time" => undef,
+                    "-or" => [
+                        {"expire_time" => undef },
+                        {"expire_time" => {">" => "now"}}
+                    ]
+                }
+            },
+            (@$sort ? (order_by => $sort) : ()),
+            ($$params{limit} ? (limit => $$params{limit}) : ()),
+            ($$params{offset} ? (offset => $$params{offset}) : ())
+        }, {"substream" => 1}
+    ) or return $e->die_event;
+
+    $logger->info("about to stream back " . scalar(@$holds_ids) . " holds");
+
+    my @chunk;
+    for my $hid (@$holds_ids) {
+        push @chunk, $e->retrieve_action_hold_request([
+            $hid->{"id"}, {
+                "flesh" => 3,
+                "flesh_fields" => {
+                    "ahr" => ["usr", "current_copy"],
+                    "au"  => ["card"],
+                    "acp" => ["location", "call_number"],
+                    "acn" => ["record"]
+                }
+            }
+        ]);
+
+        if (@chunk >= $$params{chunk_size}) {
+            $client->respond( \@chunk );
+            @chunk = ();
+        }
+    }
+    $client->respond_complete( \@chunk ) if (@chunk);
+    $e->disconnect;
+    return undef;
+}
+
+
+
+__PACKAGE__->register_method(
+    method        => 'fetch_hold_notify',
+    api_name      => 'open-ils.circ.hold_notification.retrieve_by_hold',
+    authoritative => 1,
+    signature     => q/ 
+Returns a list of hold notification objects based on hold id.
+@param authtoken The loggin session key
+@param holdid The id of the hold whose notifications we want to retrieve
+@return An array of hold notification objects, event on error.
+/
+);
+
+sub fetch_hold_notify {
+	my( $self, $conn, $authtoken, $holdid ) = @_;
+	my( $requestor, $evt ) = $U->checkses($authtoken);
+	return $evt if $evt;
+	my ($hold, $patron);
+	($hold, $evt) = $U->fetch_hold($holdid);
+	return $evt if $evt;
+	($patron, $evt) = $U->fetch_user($hold->usr);
+	return $evt if $evt;
+
+	$evt = $U->check_perms($requestor->id, $patron->home_ou, 'VIEW_HOLD_NOTIFICATION');
+	return $evt if $evt;
+
+	$logger->info("User ".$requestor->id." fetching hold notifications for hold $holdid");
+	return $U->cstorereq(
+		'open-ils.cstore.direct.action.hold_notification.search.atomic', {hold => $holdid} );
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'create_hold_notify',
+    api_name  => 'open-ils.circ.hold_notification.create',
+    signature => q/
+Creates a new hold notification object
+@param authtoken The login session key
+@param notification The hold notification object to create
+@return ID of the new object on success, Event on error
+/
+);
+
+sub create_hold_notify {
+   my( $self, $conn, $auth, $note ) = @_;
+   my $e = new_editor(authtoken=>$auth, xact=>1);
+   return $e->die_event unless $e->checkauth;
+
+   my $hold = $e->retrieve_action_hold_request($note->hold)
+      or return $e->die_event;
+   my $patron = $e->retrieve_actor_user($hold->usr) 
+      or return $e->die_event;
+
+   return $e->die_event unless 
+      $e->allowed('CREATE_HOLD_NOTIFICATION', $patron->home_ou);
+
+   $note->notify_staff($e->requestor->id);
+   $e->create_action_hold_notification($note) or return $e->die_event;
+   $e->commit;
+   return $note->id;
+}
+
+__PACKAGE__->register_method(
+    method    => 'create_hold_note',
+    api_name  => 'open-ils.circ.hold_note.create',
+    signature => q/
+		Creates a new hold request note object
+		@param authtoken The login session key
+		@param note The hold note object to create
+		@return ID of the new object on success, Event on error
+		/
+);
+
+sub create_hold_note {
+   my( $self, $conn, $auth, $note ) = @_;
+   my $e = new_editor(authtoken=>$auth, xact=>1);
+   return $e->die_event unless $e->checkauth;
+
+   my $hold = $e->retrieve_action_hold_request($note->hold)
+      or return $e->die_event;
+   my $patron = $e->retrieve_actor_user($hold->usr) 
+      or return $e->die_event;
+
+   return $e->die_event unless 
+      $e->allowed('UPDATE_HOLD', $patron->home_ou); # FIXME: Using permcrud perm listed in fm_IDL.xml for ahrn.  Probably want something more specific
+
+   $e->create_action_hold_request_note($note) or return $e->die_event;
+   $e->commit;
+   return $note->id;
+}
+
+__PACKAGE__->register_method(
+    method    => 'reset_hold',
+    api_name  => 'open-ils.circ.hold.reset',
+    signature => q/
+		Un-captures and un-targets a hold, essentially returning
+		it to the state it was in directly after it was placed,
+		then attempts to re-target the hold
+		@param authtoken The login session key
+		@param holdid The id of the hold
+	/
+);
+
+
+sub reset_hold {
+	my( $self, $conn, $auth, $holdid ) = @_;
+	my $reqr;
+	my ($hold, $evt) = $U->fetch_hold($holdid);
+	return $evt if $evt;
+	($reqr, $evt) = $U->checksesperm($auth, 'UPDATE_HOLD');
+	return $evt if $evt;
+	$evt = _reset_hold($self, $reqr, $hold);
+	return $evt if $evt;
+	return 1;
+}
+
+
+__PACKAGE__->register_method(
+    method   => 'reset_hold_batch',
+    api_name => 'open-ils.circ.hold.reset.batch'
+);
+
+sub reset_hold_batch {
+    my($self, $conn, $auth, $hold_ids) = @_;
+
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    for my $hold_id ($hold_ids) {
+
+        my $hold = $e->retrieve_action_hold_request(
+            [$hold_id, {flesh => 1, flesh_fields => {ahr => ['usr']}}]) 
+            or return $e->event;
+
+	    next unless $e->allowed('UPDATE_HOLD', $hold->usr->home_ou);
+        _reset_hold($self, $e->requestor, $hold);
+    }
+
+    return 1;
+}
+
+
+sub _reset_hold {
+	my ($self, $reqr, $hold) = @_;
+
+	my $e = new_editor(xact =>1, requestor => $reqr);
+
+	$logger->info("reseting hold ".$hold->id);
+
+	my $hid = $hold->id;
+
+	if( $hold->capture_time and $hold->current_copy ) {
+
+		my $copy = $e->retrieve_asset_copy($hold->current_copy)
+			or return $e->die_event;
+
+		if( $copy->status == OILS_COPY_STATUS_ON_HOLDS_SHELF ) {
+			$logger->info("setting copy to status 'reshelving' on hold retarget");
+			$copy->status(OILS_COPY_STATUS_RESHELVING);
+			$copy->editor($e->requestor->id);
+			$copy->edit_date('now');
+			$e->update_asset_copy($copy) or return $e->die_event;
+
+		} elsif( $copy->status == OILS_COPY_STATUS_IN_TRANSIT ) {
+
+			# We don't want the copy to remain "in transit"
+			$copy->status(OILS_COPY_STATUS_RESHELVING);
+			$logger->warn("! reseting hold [$hid] that is in transit");
+			my $transid = $e->search_action_hold_transit_copy({hold=>$hold->id},{idlist=>1})->[0];
+
+			if( $transid ) {
+				my $trans = $e->retrieve_action_transit_copy($transid);
+				if( $trans ) {
+					$logger->info("Aborting transit [$transid] on hold [$hid] reset...");
+					my $evt = OpenILS::Application::Circ::Transit::__abort_transit($e, $trans, $copy, 1);
+					$logger->info("Transit abort completed with result $evt");
+					unless ("$evt" eq 1) {
+                        $e->rollback;
+					    return $evt;
+                    }
+				}
+			}
+		}
+	}
+
+	$hold->clear_capture_time;
+	$hold->clear_current_copy;
+	$hold->clear_shelf_time;
+	$hold->clear_shelf_expire_time;
+
+	$e->update_action_hold_request($hold) or return $e->die_event;
+	$e->commit;
+
+	$U->storagereq(
+		'open-ils.storage.action.hold_request.copy_targeter', undef, $hold->id );
+
+	return undef;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'fetch_open_title_holds',
+    api_name  => 'open-ils.circ.open_holds.retrieve',
+    signature => q/
+		Returns a list ids of un-fulfilled holds for a given title id
+		@param authtoken The login session key
+		@param id the id of the item whose holds we want to retrieve
+		@param type The hold type - M, T, I, V, C, F, R
+	/
+);
+
+sub fetch_open_title_holds {
+	my( $self, $conn, $auth, $id, $type, $org ) = @_;
+	my $e = new_editor( authtoken => $auth );
+	return $e->event unless $e->checkauth;
+
+	$type ||= "T";
+	$org  ||= $e->requestor->ws_ou;
+
+#	return $e->search_action_hold_request(
+#		{ target => $id, hold_type => $type, fulfillment_time => undef }, {idlist=>1});
+
+	# XXX make me return IDs in the future ^--
+	my $holds = $e->search_action_hold_request(
+		{ 
+			target				=> $id, 
+			cancel_time			=> undef, 
+			hold_type			=> $type, 
+			fulfillment_time	=> undef 
+		}
+	);
+
+	flesh_hold_transits($holds);
+	return $holds;
+}
+
+
+sub flesh_hold_transits {
+	my $holds = shift;
+	for my $hold ( @$holds ) {
+		$hold->transit(
+			$apputils->simplereq(
+				'open-ils.cstore',
+				"open-ils.cstore.direct.action.hold_transit_copy.search.atomic",
+				{ hold => $hold->id },
+				{ order_by => { ahtc => 'id desc' }, limit => 1 }
+			)->[0]
+		);
+	}
+}
+
+sub flesh_hold_notices {
+	my( $holds, $e ) = @_;
+	$e ||= new_editor();
+
+	for my $hold (@$holds) {
+		my $notices = $e->search_action_hold_notification(
+			[
+				{ hold => $hold->id },
+				{ order_by => { anh => 'notify_time desc' } },
+			],
+			{idlist=>1}
+		);
+
+		$hold->notify_count(scalar(@$notices));
+		if( @$notices ) {
+			my $n = $e->retrieve_action_hold_notification($$notices[0])
+				or return $e->event;
+			$hold->notify_time($n->notify_time);
+		}
+	}
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'fetch_captured_holds',
+    api_name  => 'open-ils.circ.captured_holds.on_shelf.retrieve',
+    stream    => 1,
+    signature => q/
+		Returns a list of un-fulfilled holds (on the Holds Shelf) for a given title id
+		@param authtoken The login session key
+		@param org The org id of the location in question
+	/
+);
+
+__PACKAGE__->register_method(
+    method    => 'fetch_captured_holds',
+    api_name  => 'open-ils.circ.captured_holds.id_list.on_shelf.retrieve',
+    stream    => 1,
+    signature => q/
+		Returns list ids of un-fulfilled holds (on the Holds Shelf) for a given title id
+		@param authtoken The login session key
+		@param org The org id of the location in question
+	/
+);
+
+__PACKAGE__->register_method(
+    method    => 'fetch_captured_holds',
+    api_name  => 'open-ils.circ.captured_holds.id_list.expired_on_shelf.retrieve',
+    stream    => 1,
+    signature => q/
+		Returns list ids of shelf-expired un-fulfilled holds for a given title id
+		@param authtoken The login session key
+		@param org The org id of the location in question
+	/
+);
+
+
+sub fetch_captured_holds {
+	my( $self, $conn, $auth, $org ) = @_;
+
+	my $e = new_editor(authtoken => $auth);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('VIEW_HOLD'); # XXX rely on editor perm
+
+	$org ||= $e->requestor->ws_ou;
+
+    my $query = { 
+        select => { ahr => ['id'] },
+        from   => {
+            ahr => {
+                acp => {
+                    field => 'id',
+                    fkey  => 'current_copy'
+                },
+            }
+        }, 
+        where => {
+            '+acp' => { status => OILS_COPY_STATUS_ON_HOLDS_SHELF },
+            '+ahr' => {
+                capture_time     => { "!=" => undef },
+                current_copy     => { "!=" => undef },
+                fulfillment_time => undef,
+                pickup_lib       => $org,
+                cancel_time      => undef,
+              }
+        }
+    };
+    if($self->api_name =~ /expired/) {
+        $query->{'where'}->{'+ahr'}->{'shelf_expire_time'} = {'<' => 'now'};
+        $query->{'where'}->{'+ahr'}->{'shelf_time'} = {'!=' => undef};
+    }
+    my $hold_ids = $e->json_query( $query );
+
+    for my $hold_id (@$hold_ids) {
+        if($self->api_name =~ /id_list/) {
+            $conn->respond($hold_id->{id});
+            next;
+        } else {
+            $conn->respond(
+                $e->retrieve_action_hold_request([
+                    $hold_id->{id},
+                    {
+                        flesh => 1,
+                        flesh_fields => {ahr => ['notifications', 'transit', 'notes']},
+                        order_by => {anh => 'notify_time desc'}
+                    }
+                ])
+            );
+        }
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method(
+    method    => "print_expired_holds_stream",
+    api_name  => "open-ils.circ.captured_holds.expired.print.stream",
+    stream    => 1
+);
+
+sub print_expired_holds_stream {
+    my ($self, $client, $auth, $params) = @_;
+
+    # No need to check specific permissions: we're going to call another method
+    # that will do that.
+    my $e = new_editor("authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    delete($$params{org_id}) unless (int($$params{org_id}));
+    delete($$params{limit}) unless (int($$params{limit}));
+    delete($$params{offset}) unless (int($$params{offset}));
+    delete($$params{chunk_size}) unless (int($$params{chunk_size}));
+    delete($$params{chunk_size}) if  ($$params{chunk_size} && $$params{chunk_size} > 50); # keep the size reasonable
+    $$params{chunk_size} ||= 10;
+
+    $$params{org_id} = (defined $$params{org_id}) ? $$params{org_id}: $e->requestor->ws_ou;
+
+    my @hold_ids = $self->method_lookup(
+        "open-ils.circ.captured_holds.id_list.expired_on_shelf.retrieve"
+    )->run($auth, $params->{"org_id"});
+
+    if (!@hold_ids) {
+        $e->disconnect;
+        return;
+    } elsif (defined $U->event_code($hold_ids[0])) {
+        $e->disconnect;
+        return $hold_ids[0];
+    }
+
+    $logger->info("about to stream back up to " . scalar(@hold_ids) . " expired holds");
+
+    while (@hold_ids) {
+        my @hid_chunk = splice @hold_ids, 0, $params->{"chunk_size"};
+
+        my $result_chunk = $e->json_query({
+            "select" => {
+                "acp" => ["barcode"],
+                "au" => [qw/
+                    first_given_name second_given_name family_name alias
+                /],
+                "acn" => ["label"],
+                "bre" => ["marc"],
+                "acpl" => ["name"]
+            },
+            "from" => {
+                "ahr" => {
+                    "acp" => {
+                        "field" => "id", "fkey" => "current_copy",
+                        "join" => {
+                            "acn" => {
+                                "field" => "id", "fkey" => "call_number",
+                                "join" => {
+                                    "bre" => {
+                                        "field" => "id", "fkey" => "record"
+                                    }
+                                }
+                            },
+                            "acpl" => {"field" => "id", "fkey" => "location"}
+                        }
+                    },
+                    "au" => {"field" => "id", "fkey" => "usr"}
+                }
+            },
+            "where" => {"+ahr" => {"id" => \@hid_chunk}}
+        }) or return $e->die_event;
+        $client->respond($result_chunk);
+    }
+
+    $e->disconnect;
+    undef;
+}
+
+__PACKAGE__->register_method(
+    method    => "check_title_hold_batch",
+    api_name  => "open-ils.circ.title_hold.is_possible.batch",
+    stream    => 1,
+    signature => {
+        desc  => '@see open-ils.circ.title_hold.is_possible.batch',
+        params => [
+            { desc => 'Authentication token',     type => 'string'},
+            { desc => 'Array of Hash of named parameters', type => 'array'},
+        ],
+        return => {
+            desc => 'Array of response objects',
+            type => 'array'
+        }
+    }
+);
+
+sub check_title_hold_batch {
+    my($self, $client, $authtoken, $param_list) = @_;
+    foreach (@$param_list) {
+        my ($res) = $self->method_lookup('open-ils.circ.title_hold.is_possible')->run($authtoken, $_);
+        $client->respond($res);
+    }
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+    method    => "check_title_hold",
+    api_name  => "open-ils.circ.title_hold.is_possible",
+    signature => {
+        desc  => 'Determines if a hold were to be placed by a given user, ' .
+             'whether or not said hold would have any potential copies to fulfill it.' .
+             'The named paramaters of the second argument include: ' .
+             'patronid, titleid, volume_id, copy_id, mrid, depth, pickup_lib, hold_type, selection_ou. ' .
+             'See perldoc ' . __PACKAGE__ . ' for more info on these fields.' , 
+        params => [
+            { desc => 'Authentication token',     type => 'string'},
+            { desc => 'Hash of named parameters', type => 'object'},
+        ],
+        return => {
+            desc => 'List of new message IDs (empty if none)',
+            type => 'array'
+        }
+    }
+);
+
+=head3 check_title_hold (token, hash)
+
+The named fields in the hash are: 
+
+ patronid     - ID of the hold recipient  (required)
+ depth        - hold range depth          (default 0)
+ pickup_lib   - destination for hold, fallback value for selection_ou
+ selection_ou - ID of org_unit establishing hard and soft hold boundary settings
+ issuanceid   - ID of the issuance to be held, required for Issuance level hold
+ titleid      - ID (BRN) of the title to be held, required for Title level hold
+ volume_id    - required for Volume level hold
+ copy_id      - required for Copy level hold
+ mrid         - required for Meta-record level hold
+ hold_type    - T, C (or R or F), I, V or M for Title, Copy, Issuance, Volume or Meta-record  (default "T")
+
+All key/value pairs are passed on to do_possibility_checks.
+
+=cut
+
+# FIXME: better params checking.  what other params are required, if any?
+# FIXME: 3 copies of values confusing: $x, $params->{x} and $params{x}
+# FIXME: for example, $depth gets a default value, but then $$params{depth} is still 
+# used in conditionals, where it may be undefined, causing a warning.
+# FIXME: specify proper usage/interaction of selection_ou and pickup_lib
+
+sub check_title_hold {
+    my( $self, $client, $authtoken, $params ) = @_;
+    my $e = new_editor(authtoken=>$authtoken);
+    return $e->event unless $e->checkauth;
+
+    my %params       = %$params;
+    my $depth        = $params{depth}        || 0;
+    my $selection_ou = $params{selection_ou} || $params{pickup_lib};
+
+	my $patron = $e->retrieve_actor_user($params{patronid})
+		or return $e->event;
+
+	if( $e->requestor->id ne $patron->id ) {
+		return $e->event unless 
+			$e->allowed('VIEW_HOLD_PERMIT', $patron->home_ou);
+	}
+
+	return OpenILS::Event->new('PATRON_BARRED') if $U->is_true($patron->barred);
+
+	my $request_lib = $e->retrieve_actor_org_unit($e->requestor->ws_ou)
+		or return $e->event;
+
+    my $soft_boundary = $U->ou_ancestor_setting_value($selection_ou, OILS_SETTING_HOLD_SOFT_BOUNDARY);
+    my $hard_boundary = $U->ou_ancestor_setting_value($selection_ou, OILS_SETTING_HOLD_HARD_BOUNDARY);
+
+    my @status = ();
+    my $return_depth = $hard_boundary; # default depth to return on success
+    if(defined $soft_boundary and $depth < $soft_boundary) {
+        # work up the tree and as soon as we find a potential copy, use that depth
+        # also, make sure we don't go past the hard boundary if it exists
+
+        # our min boundary is the greater of user-specified boundary or hard boundary
+        my $min_depth = (defined $hard_boundary and $hard_boundary > $depth) ?  
+            $hard_boundary : $depth;
+
+        my $depth = $soft_boundary;
+        while($depth >= $min_depth) {
+            $logger->info("performing hold possibility check with soft boundary $depth");
+            @status = do_possibility_checks($e, $patron, $request_lib, $depth, %params);
+            if ($status[0]) {
+                $return_depth = $depth;
+                last;
+            }
+            $depth--;
+        }
+    } elsif(defined $hard_boundary and $depth < $hard_boundary) {
+        # there is no soft boundary, enforce the hard boundary if it exists
+        $logger->info("performing hold possibility check with hard boundary $hard_boundary");
+        @status = do_possibility_checks($e, $patron, $request_lib, $hard_boundary, %params);
+    } else {
+        # no boundaries defined, fall back to user specifed boundary or no boundary
+        $logger->info("performing hold possibility check with no boundary");
+        @status = do_possibility_checks($e, $patron, $request_lib, $params{depth}, %params);
+    }
+
+    if ($status[0]) {
+        return {
+            "success" => 1,
+            "depth" => $return_depth,
+            "local_avail" => $status[1]
+        };
+    } elsif ($status[2]) {
+        my $n = scalar @{$status[2]};
+        return {"success" => 0, "last_event" => $status[2]->[$n - 1]};
+    } else {
+        return {"success" => 0};
+    }
+}
+
+
+
+sub do_possibility_checks {
+    my($e, $patron, $request_lib, $depth, %params) = @_;
+
+    my $issuanceid   = $params{issuanceid}      || "";
+    my $titleid      = $params{titleid}      || "";
+    my $volid        = $params{volume_id};
+    my $copyid       = $params{copy_id};
+    my $mrid         = $params{mrid}         || "";
+    my $pickup_lib   = $params{pickup_lib};
+    my $hold_type    = $params{hold_type}    || 'T';
+    my $selection_ou = $params{selection_ou} || $pickup_lib;
+
+
+	my $copy;
+	my $volume;
+	my $title;
+
+	if( $hold_type eq OILS_HOLD_TYPE_FORCE || $hold_type eq OILS_HOLD_TYPE_RECALL || $hold_type eq OILS_HOLD_TYPE_COPY ) {
+
+        return $e->event unless $copy   = $e->retrieve_asset_copy($copyid);
+        return $e->event unless $volume = $e->retrieve_asset_call_number($copy->call_number);
+        return $e->event unless $title  = $e->retrieve_biblio_record_entry($volume->record);
+
+        return verify_copy_for_hold( 
+            $patron, $e->requestor, $title, $copy, $pickup_lib, $request_lib
+        );
+
+	} elsif( $hold_type eq OILS_HOLD_TYPE_VOLUME ) {
+
+		return $e->event unless $volume = $e->retrieve_asset_call_number($volid);
+		return $e->event unless $title  = $e->retrieve_biblio_record_entry($volume->record);
+
+		return _check_volume_hold_is_possible(
+			$volume, $title, $depth, $request_lib, $patron, $e->requestor, $pickup_lib, $selection_ou
+        );
+
+	} elsif( $hold_type eq OILS_HOLD_TYPE_TITLE ) {
+
+		return _check_title_hold_is_possible(
+			$titleid, $depth, $request_lib, $patron, $e->requestor, $pickup_lib, $selection_ou
+        );
+
+	} elsif( $hold_type eq OILS_HOLD_TYPE_ISSUANCE ) {
+
+		return _check_issuance_hold_is_possible(
+			$issuanceid, $depth, $request_lib, $patron, $e->requestor, $pickup_lib, $selection_ou
+        );
+
+	} elsif( $hold_type eq OILS_HOLD_TYPE_METARECORD ) {
+
+		my $maps = $e->search_metabib_metarecord_source_map({metarecord=>$mrid});
+		my @recs = map { $_->source } @$maps;
+		my @status = ();
+		for my $rec (@recs) {
+			@status = _check_title_hold_is_possible(
+				$rec, $depth, $request_lib, $patron, $e->requestor, $pickup_lib, $selection_ou
+			);
+			last if $status[1];
+		}
+		return @status;
+	}
+#   else { Unrecognized hold_type ! }   # FIXME: return error? or 0?
+}
+
+my %prox_cache;
+sub create_ranged_org_filter {
+    my($e, $selection_ou, $depth) = @_;
+
+    # find the orgs from which this hold may be fulfilled, 
+    # based on the selection_ou and depth
+
+    my $top_org = $e->search_actor_org_unit([
+        {parent_ou => undef}, 
+        {flesh=>1, flesh_fields=>{aou=>['ou_type']}}])->[0];
+    my %org_filter;
+
+    return () if $depth == $top_org->ou_type->depth;
+
+    my $org_list = $U->storagereq('open-ils.storage.actor.org_unit.descendants.atomic', $selection_ou, $depth);
+    %org_filter = (circ_lib => []);
+    push(@{$org_filter{circ_lib}}, $_->id) for @$org_list;
+
+    $logger->info("hold org filter at depth $depth and selection_ou ".
+        "$selection_ou created list of @{$org_filter{circ_lib}}");
+
+    return %org_filter;
+}
+
+
+sub _check_title_hold_is_possible {
+    my( $titleid, $depth, $request_lib, $patron, $requestor, $pickup_lib, $selection_ou ) = @_;
+   
+    my $e = new_editor();
+    my %org_filter = create_ranged_org_filter($e, $selection_ou, $depth);
+
+    # this monster will grab the id and circ_lib of all of the "holdable" copies for the given record
+    my $copies = $e->json_query(
+        { 
+            select => { acp => ['id', 'circ_lib'] },
+              from => {
+                acp => {
+                    acn => {
+                        field  => 'id',
+                        fkey   => 'call_number',
+                        'join' => {
+                            bre => {
+                                field  => 'id',
+                                filter => { id => $titleid },
+                                fkey   => 'record'
+                            }
+                        }
+                    },
+                    acpl => { field => 'id', filter => { holdable => 't'}, fkey => 'location' },
+                    ccs  => { field => 'id', filter => { holdable => 't'}, fkey => 'status'   }
+                }
+            }, 
+            where => {
+                '+acp' => { circulate => 't', deleted => 'f', holdable => 't', %org_filter }
+            }
+        }
+    );
+
+    $logger->info("title possible found ".scalar(@$copies)." potential copies");
+    return (
+        0, 0, [
+            new OpenILS::Event(
+                "HIGH_LEVEL_HOLD_HAS_NO_COPIES",
+                "payload" => {"fail_part" => "no_ultimate_items"}
+            )
+        ]
+    ) unless @$copies;
+
+    # -----------------------------------------------------------------------
+    # sort the copies into buckets based on their circ_lib proximity to 
+    # the patron's home_ou.  
+    # -----------------------------------------------------------------------
+
+    my $home_org = $patron->home_ou;
+    my $req_org = $request_lib->id;
+
+    $logger->info("prox cache $home_org " . $prox_cache{$home_org});
+
+    $prox_cache{$home_org} = 
+        $e->search_actor_org_unit_proximity({from_org => $home_org})
+        unless $prox_cache{$home_org};
+    my $home_prox = $prox_cache{$home_org};
+
+    my %buckets;
+    my %hash = map { ($_->to_org => $_->prox) } @$home_prox;
+    push( @{$buckets{ $hash{$_->{circ_lib}} } }, $_->{id} ) for @$copies;
+
+    my @keys = sort { $a <=> $b } keys %buckets;
+
+
+    if( $home_org ne $req_org ) {
+      # -----------------------------------------------------------------------
+      # shove the copies close to the request_lib into the primary buckets 
+      # directly before the farthest away copies.  That way, they are not 
+      # given priority, but they are checked before the farthest copies.
+      # -----------------------------------------------------------------------
+        $prox_cache{$req_org} = 
+            $e->search_actor_org_unit_proximity({from_org => $req_org})
+            unless $prox_cache{$req_org};
+        my $req_prox = $prox_cache{$req_org};
+
+        my %buckets2;
+        my %hash2 = map { ($_->to_org => $_->prox) } @$req_prox;
+        push( @{$buckets2{ $hash2{$_->{circ_lib}} } }, $_->{id} ) for @$copies;
+
+        my $highest_key = $keys[@keys - 1];  # the farthest prox in the exising buckets
+        my $new_key = $highest_key - 0.5; # right before the farthest prox
+        my @keys2   = sort { $a <=> $b } keys %buckets2;
+        for my $key (@keys2) {
+            last if $key >= $highest_key;
+            push( @{$buckets{$new_key}}, $_ ) for @{$buckets2{$key}};
+        }
+    }
+
+    @keys = sort { $a <=> $b } keys %buckets;
+
+    my $title;
+    my %seen;
+    my @status;
+    OUTER: for my $key (@keys) {
+      my @cps = @{$buckets{$key}};
+
+      $logger->info("looking at " . scalar(@{$buckets{$key}}). " copies in proximity bucket $key");
+
+      for my $copyid (@cps) {
+
+         next if $seen{$copyid};
+         $seen{$copyid} = 1; # there could be dupes given the merged buckets
+         my $copy = $e->retrieve_asset_copy($copyid);
+         $logger->debug("looking at bucket_key=$key, copy $copyid : circ_lib = " . $copy->circ_lib);
+
+         unless($title) { # grab the title if we don't already have it
+            my $vol = $e->retrieve_asset_call_number(
+               [ $copy->call_number, { flesh => 1, flesh_fields => { bre => ['fixed_fields'], acn => ['record'] } } ] );
+            $title = $vol->record;
+         }
+   
+         @status = verify_copy_for_hold(
+            $patron, $requestor, $title, $copy, $pickup_lib, $request_lib);
+
+         last OUTER if $status[0];
+      }
+    }
+
+    return @status;
+}
+
+sub _check_issuance_hold_is_possible {
+    my( $issuanceid, $depth, $request_lib, $patron, $requestor, $pickup_lib, $selection_ou ) = @_;
+   
+    my $e = new_editor();
+    my %org_filter = create_ranged_org_filter($e, $selection_ou, $depth);
+
+    # this monster will grab the id and circ_lib of all of the "holdable" copies for the given record
+    my $copies = $e->json_query(
+        { 
+            select => { acp => ['id', 'circ_lib'] },
+              from => {
+                acp => {
+                    sitem => {
+                        field  => 'unit',
+                        fkey   => 'id',
+                        filter => { issuance => $issuanceid }
+                    },
+                    acpl => { field => 'id', filter => { holdable => 't'}, fkey => 'location' },
+                    ccs  => { field => 'id', filter => { holdable => 't'}, fkey => 'status'   }
+                }
+            }, 
+            where => {
+                '+acp' => { circulate => 't', deleted => 'f', holdable => 't', %org_filter }
+            },
+            distinct => 1
+        }
+    );
+
+    $logger->info("issuance possible found ".scalar(@$copies)." potential copies");
+
+    my $empty_ok;
+    if (!@$copies) {
+        $empty_ok = $e->retrieve_config_global_flag('circ.holds.empty_issuance_ok');
+        $empty_ok = ($empty_ok and $U->is_true($empty_ok->enabled));
+
+        return (
+            0, 0, [
+                new OpenILS::Event(
+                    "HIGH_LEVEL_HOLD_HAS_NO_COPIES",
+                    "payload" => {"fail_part" => "no_ultimate_items"}
+                )
+            ]
+        ) unless $empty_ok;
+
+        return (1, 0);
+    }
+
+    # -----------------------------------------------------------------------
+    # sort the copies into buckets based on their circ_lib proximity to 
+    # the patron's home_ou.  
+    # -----------------------------------------------------------------------
+
+    my $home_org = $patron->home_ou;
+    my $req_org = $request_lib->id;
+
+    $logger->info("prox cache $home_org " . $prox_cache{$home_org});
+
+    $prox_cache{$home_org} = 
+        $e->search_actor_org_unit_proximity({from_org => $home_org})
+        unless $prox_cache{$home_org};
+    my $home_prox = $prox_cache{$home_org};
+
+    my %buckets;
+    my %hash = map { ($_->to_org => $_->prox) } @$home_prox;
+    push( @{$buckets{ $hash{$_->{circ_lib}} } }, $_->{id} ) for @$copies;
+
+    my @keys = sort { $a <=> $b } keys %buckets;
+
+
+    if( $home_org ne $req_org ) {
+      # -----------------------------------------------------------------------
+      # shove the copies close to the request_lib into the primary buckets 
+      # directly before the farthest away copies.  That way, they are not 
+      # given priority, but they are checked before the farthest copies.
+      # -----------------------------------------------------------------------
+        $prox_cache{$req_org} = 
+            $e->search_actor_org_unit_proximity({from_org => $req_org})
+            unless $prox_cache{$req_org};
+        my $req_prox = $prox_cache{$req_org};
+
+        my %buckets2;
+        my %hash2 = map { ($_->to_org => $_->prox) } @$req_prox;
+        push( @{$buckets2{ $hash2{$_->{circ_lib}} } }, $_->{id} ) for @$copies;
+
+        my $highest_key = $keys[@keys - 1];  # the farthest prox in the exising buckets
+        my $new_key = $highest_key - 0.5; # right before the farthest prox
+        my @keys2   = sort { $a <=> $b } keys %buckets2;
+        for my $key (@keys2) {
+            last if $key >= $highest_key;
+            push( @{$buckets{$new_key}}, $_ ) for @{$buckets2{$key}};
+        }
+    }
+
+    @keys = sort { $a <=> $b } keys %buckets;
+
+    my $title;
+    my %seen;
+    my @status;
+    OUTER: for my $key (@keys) {
+      my @cps = @{$buckets{$key}};
+
+      $logger->info("looking at " . scalar(@{$buckets{$key}}). " copies in proximity bucket $key");
+
+      for my $copyid (@cps) {
+
+         next if $seen{$copyid};
+         $seen{$copyid} = 1; # there could be dupes given the merged buckets
+         my $copy = $e->retrieve_asset_copy($copyid);
+         $logger->debug("looking at bucket_key=$key, copy $copyid : circ_lib = " . $copy->circ_lib);
+
+         unless($title) { # grab the title if we don't already have it
+            my $vol = $e->retrieve_asset_call_number(
+               [ $copy->call_number, { flesh => 1, flesh_fields => { bre => ['fixed_fields'], acn => ['record'] } } ] );
+            $title = $vol->record;
+         }
+   
+         @status = verify_copy_for_hold(
+            $patron, $requestor, $title, $copy, $pickup_lib, $request_lib);
+
+         last OUTER if $status[0];
+      }
+    }
+
+    if (!$status[0]) {
+        if (!defined($empty_ok)) {
+            $empty_ok = $e->retrieve_config_global_flag('circ.holds.empty_issuance_ok');
+            $empty_ok = ($empty_ok and $U->is_true($empty_ok->enabled));
+        }
+
+        return (1,0) if ($empty_ok);
+    }
+    return @status;
+}
+
+
+sub _check_volume_hold_is_possible {
+	my( $vol, $title, $depth, $request_lib, $patron, $requestor, $pickup_lib, $selection_ou ) = @_;
+    my %org_filter = create_ranged_org_filter(new_editor(), $selection_ou, $depth);
+	my $copies = new_editor->search_asset_copy({call_number => $vol->id, %org_filter});
+	$logger->info("checking possibility of volume hold for volume ".$vol->id);
+
+    return (
+        0, 0, [
+            new OpenILS::Event(
+                "HIGH_LEVEL_HOLD_HAS_NO_COPIES",
+                "payload" => {"fail_part" => "no_ultimate_items"}
+            )
+        ]
+    ) unless @$copies;
+
+    my @status;
+	for my $copy ( @$copies ) {
+        @status = verify_copy_for_hold(
+			$patron, $requestor, $title, $copy, $pickup_lib, $request_lib );
+        last if $status[0];
+	}
+	return @status;
+}
+
+
+
+sub verify_copy_for_hold {
+	my( $patron, $requestor, $title, $copy, $pickup_lib, $request_lib ) = @_;
+	$logger->info("checking possibility of copy in hold request for copy ".$copy->id);
+    my $permitted = OpenILS::Utils::PermitHold::permit_copy_hold(
+		{	patron				=> $patron, 
+			requestor			=> $requestor, 
+			copy				=> $copy,
+			title				=> $title, 
+			title_descriptor	=> $title->fixed_fields, # this is fleshed into the title object
+			pickup_lib			=> $pickup_lib,
+			request_lib			=> $request_lib,
+            new_hold            => 1,
+            show_event_list     => 1
+		} 
+	);
+
+    return (
+        (not scalar @$permitted), # true if permitted is an empty arrayref
+        (
+	        ($copy->circ_lib == $pickup_lib) and 
+            ($copy->status == OILS_COPY_STATUS_AVAILABLE)
+        ),
+        $permitted
+    );
+}
+
+
+
+sub find_nearest_permitted_hold {
+
+    my $class  = shift;
+    my $editor = shift;     # CStoreEditor object
+    my $copy   = shift;     # copy to target
+    my $user   = shift;     # staff
+    my $check_only = shift; # do no updates, just see if the copy could fulfill a hold
+      
+    my $evt = OpenILS::Event->new('ACTION_HOLD_REQUEST_NOT_FOUND');
+
+    my $bc = $copy->barcode;
+
+	# find any existing holds that already target this copy
+	my $old_holds = $editor->search_action_hold_request(
+		{	current_copy => $copy->id, 
+			cancel_time  => undef, 
+			capture_time => undef 
+		} 
+	);
+
+	# hold->type "R" means we need this copy
+	for my $h (@$old_holds) { return ($h) if $h->hold_type eq 'R'; }
+
+
+    my $hold_stall_interval = $U->ou_ancestor_setting_value($user->ws_ou, OILS_SETTING_HOLD_SOFT_STALL);
+
+	$logger->info("circulator: searching for best hold at org ".$user->ws_ou.
+        " and copy $bc with a hold stalling interval of ". ($hold_stall_interval || "(none)"));
+
+	my $fifo = $U->ou_ancestor_setting_value($user->ws_ou, 'circ.holds_fifo');
+
+	# search for what should be the best holds for this copy to fulfill
+	my $best_holds = $U->storagereq(
+        "open-ils.storage.action.hold_request.nearest_hold.atomic", 
+		$user->ws_ou, $copy->id, 10, $hold_stall_interval, $fifo );
+
+	unless(@$best_holds) {
+
+		if( my $hold = $$old_holds[0] ) {
+			$logger->info("circulator: using existing pre-targeted hold ".$hold->id." in hold search");
+			return ($hold);
+		}
+
+		$logger->info("circulator: no suitable holds found for copy $bc");
+		return (undef, $evt);
+	}
+
+
+	my $best_hold;
+
+	# for each potential hold, we have to run the permit script
+	# to make sure the hold is actually permitted.
+    my %reqr_cache;
+    my %org_cache;
+	for my $holdid (@$best_holds) {
+		next unless $holdid;
+		$logger->info("circulator: checking if hold $holdid is permitted for copy $bc");
+
+		my $hold = $editor->retrieve_action_hold_request($holdid) or next;
+		my $reqr = $reqr_cache{$hold->requestor} || $editor->retrieve_actor_user($hold->requestor);
+		my $rlib = $org_cache{$hold->request_lib} || $editor->retrieve_actor_org_unit($hold->request_lib);
+
+		$reqr_cache{$hold->requestor} = $reqr;
+		$org_cache{$hold->request_lib} = $rlib;
+
+		# see if this hold is permitted
+		my $permitted = OpenILS::Utils::PermitHold::permit_copy_hold(
+			{	patron_id			=> $hold->usr,
+				requestor			=> $reqr,
+				copy				=> $copy,
+				pickup_lib			=> $hold->pickup_lib,
+				request_lib			=> $rlib,
+				retarget			=> 1
+			} 
+		);
+
+		if( $permitted ) {
+			$best_hold = $hold;
+			last;
+		}
+	}
+
+
+	unless( $best_hold ) { # no "good" permitted holds were found
+		if( my $hold = $$old_holds[0] ) { # can we return a pre-targeted hold?
+			$logger->info("circulator: using existing pre-targeted hold ".$hold->id." in hold search");
+			return ($hold);
+		}
+
+		# we got nuthin
+		$logger->info("circulator: no suitable holds found for copy $bc");
+		return (undef, $evt);
+	}
+
+	$logger->info("circulator: best hold ".$best_hold->id." found for copy $bc");
+
+	# indicate a permitted hold was found
+	return $best_hold if $check_only;
+
+	# we've found a permitted hold.  we need to "grab" the copy 
+	# to prevent re-targeted holds (next part) from re-grabbing the copy
+	$best_hold->current_copy($copy->id);
+	$editor->update_action_hold_request($best_hold) 
+		or return (undef, $editor->event);
+
+
+    my @retarget;
+
+	# re-target any other holds that already target this copy
+	for my $old_hold (@$old_holds) {
+		next if $old_hold->id eq $best_hold->id; # don't re-target the hold we want
+		$logger->info("circulator: clearing current_copy and prev_check_time on hold ".
+            $old_hold->id." after a better hold [".$best_hold->id."] was found");
+        $old_hold->clear_current_copy;
+        $old_hold->clear_prev_check_time;
+        $editor->update_action_hold_request($old_hold) 
+            or return (undef, $editor->event);
+        push(@retarget, $old_hold->id);
+	}
+
+	return ($best_hold, undef, (@retarget) ? \@retarget : undef);
+}
+
+
+
+
+
+
+__PACKAGE__->register_method(
+    method   => 'all_rec_holds',
+    api_name => 'open-ils.circ.holds.retrieve_all_from_title',
+);
+
+sub all_rec_holds {
+	my( $self, $conn, $auth, $title_id, $args ) = @_;
+
+	my $e = new_editor(authtoken=>$auth);
+	$e->checkauth or return $e->event;
+	$e->allowed('VIEW_HOLD') or return $e->event;
+
+	$args ||= {};
+    $args->{fulfillment_time} = undef; #  we don't want to see old fulfilled holds
+	$args->{cancel_time} = undef;
+
+	my $resp = { volume_holds => [], copy_holds => [], metarecord_holds => [] };
+
+    my $mr_map = $e->search_metabib_metarecord_source_map({source => $title_id})->[0];
+    if($mr_map) {
+        $resp->{metarecord_holds} = $e->search_action_hold_request(
+            {   hold_type => OILS_HOLD_TYPE_METARECORD,
+                target => $mr_map->metarecord,
+                %$args 
+            }, {idlist => 1}
+        );
+    }
+
+	$resp->{title_holds} = $e->search_action_hold_request(
+		{ 
+			hold_type => OILS_HOLD_TYPE_TITLE, 
+			target => $title_id, 
+			%$args 
+		}, {idlist=>1} );
+
+	my $vols = $e->search_asset_call_number(
+		{ record => $title_id, deleted => 'f' }, {idlist=>1});
+
+	return $resp unless @$vols;
+
+	$resp->{volume_holds} = $e->search_action_hold_request(
+		{ 
+			hold_type => OILS_HOLD_TYPE_VOLUME, 
+			target => $vols,
+			%$args }, 
+		{idlist=>1} );
+
+	my $copies = $e->search_asset_copy(
+		{ call_number => $vols, deleted => 'f' }, {idlist=>1});
+
+	return $resp unless @$copies;
+
+	$resp->{copy_holds} = $e->search_action_hold_request(
+		{ 
+			hold_type => OILS_HOLD_TYPE_COPY,
+			target => $copies,
+			%$args }, 
+		{idlist=>1} );
+
+	return $resp;
+}
+
+
+
+
+
+__PACKAGE__->register_method(
+    method        => 'uber_hold',
+    authoritative => 1,
+    api_name      => 'open-ils.circ.hold.details.retrieve'
+);
+
+sub uber_hold {
+	my($self, $client, $auth, $hold_id) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	$e->checkauth or return $e->event;
+    return uber_hold_impl($e, $hold_id);
+}
+
+__PACKAGE__->register_method(
+    method        => 'batch_uber_hold',
+    authoritative => 1,
+    stream        => 1,
+    api_name      => 'open-ils.circ.hold.details.batch.retrieve'
+);
+
+sub batch_uber_hold {
+	my($self, $client, $auth, $hold_ids) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	$e->checkauth or return $e->event;
+    $client->respond(uber_hold_impl($e, $_)) for @$hold_ids;
+    return undef;
+}
+
+sub uber_hold_impl {
+    my($e, $hold_id) = @_;
+
+	my $resp = {};
+
+	my $hold = $e->retrieve_action_hold_request(
+		[
+			$hold_id,
+			{
+				flesh => 1,
+				flesh_fields => { ahr => [ 'current_copy', 'usr', 'notes' ] }
+			}
+		]
+	) or return $e->event;
+
+    if($hold->usr->id ne $e->requestor->id) {
+        # A user is allowed to see his/her own holds
+	    $e->allowed('VIEW_HOLD') or return $e->event;
+        $hold->notes( # filter out any non-staff ("private") notes
+            [ grep { !$U->is_true($_->staff) } @{$hold->notes} ] );
+
+    } else {
+        # caller is asking for own hold, but may not have permission to view staff notes
+	    unless($e->allowed('VIEW_HOLD')) {
+            $hold->notes( # filter out any staff notes
+                [ grep { $U->is_true($_->staff) } @{$hold->notes} ] );
+        }
+    }
+
+	my $user = $hold->usr;
+	$hold->usr($user->id);
+
+	my $card = $e->retrieve_actor_card($user->card)
+		or return $e->event;
+
+	my( $mvr, $volume, $copy ) = find_hold_mvr($e, $hold);
+
+	flesh_hold_notices([$hold], $e);
+	flesh_hold_transits([$hold]);
+
+    my $details = retrieve_hold_queue_status_impl($e, $hold);
+
+    return {
+        hold           => $hold,
+        copy           => $copy,
+        volume         => $volume,
+        mvr            => $mvr,
+        patron_first   => $user->first_given_name,
+        patron_last    => $user->family_name,
+        patron_barcode => $card->barcode,
+        patron_alias   => $user->alias,
+        %$details
+    };
+}
+
+
+
+# -----------------------------------------------------
+# Returns the MVR object that represents what the
+# hold is all about
+# -----------------------------------------------------
+sub find_hold_mvr {
+	my( $e, $hold ) = @_;
+
+	my $tid;
+	my $copy;
+	my $volume;
+    my $issuance;
+
+	if( $hold->hold_type eq OILS_HOLD_TYPE_METARECORD ) {
+		my $mr = $e->retrieve_metabib_metarecord($hold->target)
+			or return $e->event;
+		$tid = $mr->master_record;
+
+	} elsif( $hold->hold_type eq OILS_HOLD_TYPE_TITLE ) {
+		$tid = $hold->target;
+
+	} elsif( $hold->hold_type eq OILS_HOLD_TYPE_VOLUME ) {
+		$volume = $e->retrieve_asset_call_number($hold->target)
+			or return $e->event;
+		$tid = $volume->record;
+
+    } elsif( $hold->hold_type eq OILS_HOLD_TYPE_ISSUANCE ) {
+        $issuance = $e->retrieve_serial_issuance([
+            $hold->target,
+            {flesh => 1, flesh_fields => {siss => [ qw/subscription/ ]}}
+        ]) or return $e->event;
+
+        $tid = $issuance->subscription->record_entry;
+
+	} elsif( $hold->hold_type eq OILS_HOLD_TYPE_COPY ) {
+		$copy = $e->retrieve_asset_copy([
+            $hold->target, 
+            {flesh => 1, flesh_fields => {acp => ['call_number']}}
+        ]) or return $e->event;
+        
+		$volume = $copy->call_number;
+		$tid = $volume->record;
+	}
+
+	if(!$copy and ref $hold->current_copy ) {
+		$copy = $hold->current_copy;
+		$hold->current_copy($copy->id);
+	}
+
+	if(!$volume and $copy) {
+		$volume = $e->retrieve_asset_call_number($copy->call_number);
+	}
+
+    # TODO return metarcord mvr for M holds
+	my $title = $e->retrieve_biblio_record_entry($tid);
+	return ( $U->record_to_mvr($title), $volume, $copy, $issuance );
+}
+
+__PACKAGE__->register_method(
+    method    => 'clear_shelf_cache',
+    api_name  => 'open-ils.circ.hold.clear_shelf.get_cache',
+    stream    => 1,
+    signature => {
+        desc => q/
+            Returns the holds processed with the given cache key
+        /
+    }
+);
+
+sub clear_shelf_cache {
+    my($self, $client, $auth, $cache_key, $chunk_size) = @_;
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth and $e->allowed('VIEW_HOLD');
+
+    $chunk_size ||= 25;
+    my $hold_data = OpenSRF::Utils::Cache->new('global')->get_cache($cache_key);
+
+    if (!$hold_data) {
+        $logger->info("no hold data found in cache"); # XXX TODO return event
+        $e->rollback;
+        return undef;
+    }
+
+    my $maximum = 0;
+    foreach (keys %$hold_data) {
+        $maximum += scalar(@{ $hold_data->{$_} });
+    }
+    $client->respond({"maximum" => $maximum, "progress" => 0});
+
+    for my $action (sort keys %$hold_data) {
+        while (@{$hold_data->{$action}}) {
+            my @hid_chunk = splice @{$hold_data->{$action}}, 0, $chunk_size;
+
+            my $result_chunk = $e->json_query({
+                "select" => {
+                    "acp" => ["barcode"],
+                    "au" => [qw/
+                        first_given_name second_given_name family_name alias
+                    /],
+                    "acn" => ["label"],
+                    "bre" => ["marc"],
+                    "acpl" => ["name"],
+                    "ahr" => ["id"]
+                },
+                "from" => {
+                    "ahr" => {
+                        "acp" => {
+                            "field" => "id", "fkey" => "current_copy",
+                            "join" => {
+                                "acn" => {
+                                    "field" => "id", "fkey" => "call_number",
+                                    "join" => {
+                                        "bre" => {
+                                            "field" => "id", "fkey" => "record"
+                                        }
+                                    }
+                                },
+                                "acpl" => {"field" => "id", "fkey" => "location"}
+                            }
+                        },
+                        "au" => {"field" => "id", "fkey" => "usr"}
+                    }
+                },
+                "where" => {"+ahr" => {"id" => \@hid_chunk}}
+            }, {"substream" => 1}) or return $e->die_event;
+
+            $client->respond([
+                map {
+                    +{"action" => $action, "hold_details" => $_}
+                } @$result_chunk
+            ]);
+        }
+    }
+
+    $e->rollback;
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'clear_shelf_process',
+    stream    => 1,
+    api_name  => 'open-ils.circ.hold.clear_shelf.process',
+    signature => {
+        desc => q/
+            1. Find all holds that have expired on the holds shelf
+            2. Cancel the holds
+            3. If a clear-shelf status is configured, put targeted copies into this status
+            4. Divide copies into 3 groups: items to transit, items to reshelve, and items
+                that are needed for holds.  No subsequent action is taken on the holds
+                or items after grouping.
+        /
+    }
+);
+
+sub clear_shelf_process {
+	my($self, $client, $auth, $org_id) = @_;
+
+	my $e = new_editor(authtoken=>$auth, xact => 1);
+	$e->checkauth or return $e->die_event;
+	my $cache = OpenSRF::Utils::Cache->new('global');
+
+    $org_id ||= $e->requestor->ws_ou;
+	$e->allowed('UPDATE_HOLD', $org_id) or return $e->die_event;
+
+    my $copy_status = $U->ou_ancestor_setting_value($org_id, 'circ.holds.clear_shelf.copy_status');
+
+    # Find holds on the shelf that have been there too long
+    my $hold_ids = $e->search_action_hold_request(
+        {   shelf_expire_time => {'<' => 'now'},
+            pickup_lib        => $org_id,
+            cancel_time       => undef,
+            fulfillment_time  => undef,
+            shelf_time        => {'!=' => undef},
+            capture_time      => {'!=' => undef},
+            current_copy      => {'!=' => undef},
+        },
+        { idlist => 1 }
+    );
+
+    my @holds;
+    my $chunk_size = 25; # chunked status updates
+    my $counter = 0;
+    for my $hold_id (@$hold_ids) {
+
+        $logger->info("Clear shelf processing hold $hold_id");
+        
+        my $hold = $e->retrieve_action_hold_request([
+            $hold_id, {   
+                flesh => 1,
+                flesh_fields => {ahr => ['current_copy']}
+            }
+        ]);
+
+        $hold->cancel_time('now');
+        $hold->cancel_cause(2); # Hold Shelf expiration
+        $e->update_action_hold_request($hold) or return $e->die_event;
+
+        my $copy = $hold->current_copy;
+
+        if($copy_status or $copy_status == 0) {
+            # if a clear-shelf copy status is defined, update the copy
+            $copy->status($copy_status);
+            $copy->edit_date('now');
+            $copy->editor($e->requestor->id);
+            $e->update_asset_copy($copy) or return $e->die_event;
+        }
+
+        push(@holds, $hold);
+        $client->respond({maximum => scalar(@holds), progress => $counter}) if ( (++$counter % $chunk_size) == 0);
+    }
+
+    if ($e->commit) {
+
+        my %cache_data = (
+            hold => [],
+            transit => [],
+            shelf => []
+        );
+
+        for my $hold (@holds) {
+
+            my $copy = $hold->current_copy;
+            my ($alt_hold) = __PACKAGE__->find_nearest_permitted_hold($e, $copy, $e->requestor, 1);
+
+            if($alt_hold) {
+
+                push(@{$cache_data{hold}}, $hold->id); # copy is needed for a hold
+
+            } elsif($copy->circ_lib != $e->requestor->ws_ou) {
+
+                push(@{$cache_data{transit}}, $hold->id); # copy needs to transit
+
+            } else {
+
+                push(@{$cache_data{shelf}}, $hold->id); # copy needs to go back to the shelf
+            }
+        }
+
+        my $cache_key = md5_hex(time . $$ . rand());
+        $logger->info("clear_shelf_cache: storing under $cache_key");
+        $cache->put_cache($cache_key, \%cache_data, 7200); # TODO: 2 hours.  configurable?
+
+        # tell the client we're done
+        $client->respond_complete({cache_key => $cache_key});
+
+        # fire off the hold cancelation trigger and wait for response so don't flood the service
+        $U->create_events_for_hook(
+            'hold_request.cancel.expire_holds_shelf', 
+            $_, $org_id, undef, undef, 1) for @holds;
+
+    } else {
+        # tell the client we're done
+        $client->respond_complete;
+    }
+}
+
+__PACKAGE__->register_method(
+    method    => 'usr_hold_summary',
+    api_name  => 'open-ils.circ.holds.user_summary',
+    signature => q/
+        Returns a summary of holds statuses for a given user
+    /
+);
+
+sub usr_hold_summary {
+    my($self, $conn, $auth, $user_id) = @_;
+
+	my $e = new_editor(authtoken=>$auth);
+	$e->checkauth or return $e->event;
+	$e->allowed('VIEW_HOLD') or return $e->event;
+
+    my $holds = $e->search_action_hold_request(
+        {  
+            usr =>  $user_id , 
+            fulfillment_time => undef,
+            cancel_time      => undef,
+        }
+    );
+
+    my %summary = (1 => 0, 2 => 0, 3 => 0, 4 => 0);
+    $summary{_hold_status($e, $_)} += 1 for @$holds;
+    return \%summary;
+}
+
+
+
+__PACKAGE__->register_method(
+    method    => 'hold_has_copy_at',
+    api_name  => 'open-ils.circ.hold.has_copy_at',
+    signature => {
+        desc   => 
+                'Returns the ID of the found copy and name of the shelving location if there is ' .
+                'an available copy at the specified org unit.  Returns empty hash otherwise.  '   .
+                'The anticipated use for this method is to determine whether an item is '         .
+                'available at the library where the user is placing the hold (or, alternatively, '.
+                'at the pickup library) to encourage bypassing the hold placement and just '      .
+                'checking out the item.' ,
+        params => {
+            { desc => 'Authentication Token', type => 'string' },
+            { desc => 'Method Arguments.  Options include: hold_type, hold_target, org_unit.  ' 
+                    . 'hold_type is the hold type code (T, V, C, M, ...).  '
+                    . 'hold_target is the identifier of the hold target object.  ' 
+                    . 'org_unit is org unit ID.', 
+              type => 'object' 
+            },
+        },
+        return => { 
+            desc => q/Result hash like { "copy" : copy_id, "location" : location_name }, empty hash on misses, event on error./,
+            type => 'object' 
+        }
+    }
+);
+
+sub hold_has_copy_at {
+    my($self, $conn, $auth, $args) = @_;
+
+	my $e = new_editor(authtoken=>$auth);
+	$e->checkauth or return $e->event;
+
+    my $hold_type   = $$args{hold_type};
+    my $hold_target = $$args{hold_target};
+    my $org_unit    = $$args{org_unit};
+
+    my $query = {
+        select => {acp => ['id'], acpl => ['name']},
+        from   => {
+            acp => {
+                acpl => {field => 'id', filter => { holdable => 't'}, fkey => 'location'},
+                ccs  => {field => 'id', filter => { holdable => 't'}, fkey => 'status'  }
+            }
+        },
+        where => {'+acp' => { circulate => 't', deleted => 'f', holdable => 't', circ_lib => $org_unit}},
+        limit => 1
+    };
+
+    if($hold_type eq 'C') {
+
+        $query->{where}->{'+acp'}->{id} = $hold_target;
+
+    } elsif($hold_type eq 'V') {
+
+        $query->{where}->{'+acp'}->{call_number} = $hold_target;
+    
+    } elsif($hold_type eq 'T') {
+
+        $query->{from}->{acp}->{acn} = {
+            field  => 'id',
+            fkey   => 'call_number',
+            'join' => {
+                bre => {
+                    field  => 'id',
+                    filter => {id => $hold_target},
+                    fkey   => 'record'
+                }
+            }
+        };
+
+    } else {
+
+        $query->{from}->{acp}->{acn} = {
+            field => 'id',
+            fkey  => 'call_number',
+            join  => {
+                bre => {
+                    field => 'id',
+                    fkey  => 'record',
+                    join  => {
+                        mmrsm => {
+                            field  => 'source',
+                            fkey   => 'id',
+                            filter => {metarecord => $hold_target},
+                        }
+                    }
+                }
+            }
+        };
+    }
+
+    my $res = $e->json_query($query)->[0] or return {};
+    return {copy => $res->{id}, location => $res->{name}} if $res;
+}
+
+
+# returns true if the user already has an item checked out 
+# that could be used to fulfill the requested hold.
+sub hold_item_is_checked_out {
+    my($e, $user_id, $hold_type, $hold_target) = @_;
+
+    my $query = {
+        select => {acp => ['id']},
+        from   => {acp => {}},
+        where  => {
+            '+acp' => {
+                id => {
+                    in => { # copies for circs the user has checked out
+                        select => {circ => ['target_copy']},
+                        from   => 'circ',
+                        where  => {
+                            usr => $user_id,
+                            checkin_time => undef,
+                            '-or' => [
+                                {stop_fines => ["MAXFINES","LONGOVERDUE"]},
+                                {stop_fines => undef}
+                            ],
+                        }
+                    }
+                }
+            }
+        },
+        limit => 1
+    };
+
+    if($hold_type eq 'C' || $hold_type eq 'R' || $hold_type eq 'F') {
+
+        $query->{where}->{'+acp'}->{id}->{in}->{where}->{'target_copy'} = $hold_target;
+
+    } elsif($hold_type eq 'V') {
+
+        $query->{where}->{'+acp'}->{call_number} = $hold_target;
+
+     } elsif($hold_type eq 'I') {
+
+        $query->{from}->{acp}->{sitem} = {
+            field  => 'unit',
+            fkey   => 'id',
+            filter => {issuance => $hold_target},
+        };
+
+    } elsif($hold_type eq 'T') {
+
+        $query->{from}->{acp}->{acn} = {
+            field  => 'id',
+            fkey   => 'call_number',
+            'join' => {
+                bre => {
+                    field  => 'id',
+                    filter => {id => $hold_target},
+                    fkey   => 'record'
+                }
+            }
+        };
+
+    } else {
+
+        $query->{from}->{acp}->{acn} = {
+            field => 'id',
+            fkey => 'call_number',
+            join => {
+                bre => {
+                    field => 'id',
+                    fkey => 'record',
+                    join => {
+                        mmrsm => {
+                            field => 'source',
+                            fkey => 'id',
+                            filter => {metarecord => $hold_target},
+                        }
+                    }
+                }
+            }
+        };
+    }
+
+    return $e->json_query($query)->[0];
+}
+
+__PACKAGE__->register_method(
+    method    => 'change_hold_title',
+    api_name  => 'open-ils.circ.hold.change_title',
+    signature => {
+        desc => q/
+            Updates all title level holds targeting the specified bibs to point a new bib./,
+        params => [
+            { desc => 'Authentication Token', type => 'string' },
+            { desc => 'New Target Bib Id',    type => 'number' },
+            { desc => 'Old Target Bib Ids',   type => 'array'  },
+        ],
+        return => { desc => '1 on success' }
+    }
+);
+
+sub change_hold_title {
+    my( $self, $client, $auth, $new_bib_id, $bib_ids ) = @_;
+
+    my $e = new_editor(authtoken=>$auth, xact=>1);
+    return $e->die_event unless $e->checkauth;
+
+    my $holds = $e->search_action_hold_request(
+        [
+            {
+                cancel_time      => undef,
+                fulfillment_time => undef,
+                hold_type        => 'T',
+                target           => $bib_ids
+            },
+            {
+                flesh        => 1,
+                flesh_fields => { ahr => ['usr'] }
+            }
+        ],
+        { substream => 1 }
+    );
+
+    for my $hold (@$holds) {
+        $e->allowed('UPDATE_HOLD', $hold->usr->home_ou) or return $e->die_event;
+        $logger->info("Changing hold " . $hold->id . " target from " . $hold->target . " to $new_bib_id in title hold target change");
+        $hold->target( $new_bib_id );
+        $e->update_action_hold_request($hold) or return $e->die_event;
+    }
+
+    $e->commit;
+
+    return 1;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'rec_hold_count',
+    api_name  => 'open-ils.circ.bre.holds.count',
+    signature => {
+        desc => q/Returns the total number of holds that target the 
+            selected bib record or its associated copies and call_numbers/,
+        params => [
+            { desc => 'Bib ID', type => 'number' },
+        ],
+        return => {desc => 'Hold count', type => 'number'}
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => 'rec_hold_count',
+    api_name  => 'open-ils.circ.mmr.holds.count',
+    signature => {
+        desc => q/Returns the total number of holds that target the 
+            selected metarecord or its associated copies, call_numbers, and bib records/,
+        params => [
+            { desc => 'Metarecord ID', type => 'number' },
+        ],
+        return => {desc => 'Hold count', type => 'number'}
+    }
+);
+
+sub rec_hold_count {
+    my($self, $conn, $target_id) = @_;
+
+
+    my $mmr_join = {
+        mmrsm => {
+            field => 'id',
+            fkey => 'source',
+            filter => {metarecord => $target_id}
+        }
+    };
+
+    my $bre_join = {
+        bre => {
+            field => 'id',
+            filter => { id => $target_id },
+            fkey => 'record'
+        }
+    };
+
+    if($self->api_name =~ /mmr/) {
+        delete $bre_join->{bre}->{filter};
+        $bre_join->{bre}->{join} = $mmr_join;
+    }
+
+    my $cn_join = {
+        acn => {
+            field => 'id',
+            fkey => 'call_number',
+            join => $bre_join
+        }
+    };
+
+    my $query = {
+        select => {ahr => [{column => 'id', transform => 'count', alias => 'count'}]},
+        from => 'ahr',
+        where => {
+            '+ahr' => {
+                cancel_time => undef, 
+                fulfillment_time => undef,
+                '-or' => [
+                    {
+                        '-and' => {
+                            hold_type => 'C',
+                            target => {
+                                in => {
+                                    select => {acp => ['id']},
+                                    from => { acp => $cn_join }
+                                }
+                            }
+                        }
+                    },
+                    {
+                        '-and' => {
+                            hold_type => 'V',
+                            target => {
+                                in => {
+                                    select => {acn => ['id']},
+                                    from => {acn => $bre_join}
+                                }
+                            }
+                        }
+                    },
+                    {
+                        '-and' => {
+                            hold_type => 'T',
+                            target => $target_id
+                        }
+                    }
+                ]
+            }
+        }
+    };
+
+    if($self->api_name =~ /mmr/) {
+        $query->{where}->{'+ahr'}->{'-or'}->[2] = {
+            '-and' => {
+                hold_type => 'T',
+                target => {
+                    in => {
+                        select => {bre => ['id']},
+                        from => {bre => $mmr_join}
+                    }
+                }
+            }
+        };
+
+        $query->{where}->{'+ahr'}->{'-or'}->[3] = {
+            '-and' => {
+                hold_type => 'M',
+                target => $target_id
+            }
+        };
+    }
+
+
+    return new_editor()->json_query($query)->[0]->{count};
+}
+
+
+
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Money.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Money.pm
new file mode 100644
index 0000000000..66de1abc0d
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Money.pm
@@ -0,0 +1,1001 @@
+# ---------------------------------------------------------------
+# Copyright (C) 2005  Georgia Public Library Service 
+# Bill Erickson 
+
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# ---------------------------------------------------------------
+
+package OpenILS::Application::Circ::Money;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+use OpenILS::Application::AppUtils;
+my $apputils = "OpenILS::Application::AppUtils";
+my $U = "OpenILS::Application::AppUtils";
+
+use OpenSRF::EX qw(:try);
+use OpenILS::Perm;
+use Data::Dumper;
+use OpenILS::Event;
+use OpenSRF::Utils::Logger qw/:logger/;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenILS::Utils::Penalty;
+$Data::Dumper::Indent = 0;
+
+__PACKAGE__->register_method(
+    method => "make_payments",
+    api_name => "open-ils.circ.money.payment",
+    signature => {
+        desc => q/Create payments for a given user and set of transactions,
+            login must have CREATE_PAYMENT privileges.
+            If any payments fail, all are reverted back./,
+        params => [
+            {desc => 'Authtoken', type => 'string'},
+            {desc => q/Arguments Hash, supporting the following params:
+                { 
+                    payment_type
+                    userid
+                    patron_credit
+                    note
+                    cc_args: {
+                        where_process   1 to use processor, !1 for out-of-band
+                        approval_code   (for out-of-band payment)
+                        type            (for out-of-band payment)
+                        number          (for call to payment processor)
+                        expire_month    (for call to payment processor)
+                        expire_year     (for call to payment processor)
+                        billing_first   (for out-of-band payments and for call to payment processor)
+                        billing_last    (for out-of-band payments and for call to payment processor)
+                        billing_address (for call to payment processor)
+                        billing_city    (for call to payment processor)
+                        billing_state   (for call to payment processor)
+                        billing_zip     (for call to payment processor)
+                        note            (if payments->{note} is blank, use this)
+                    },
+                    check_number
+                    payments: [ 
+                        [trans_id, amt], 
+                        [...]
+                    ], 
+                }/, type => 'hash'
+            },
+            {
+                desc => q/Last user transaction ID.  This is the actor.usr.last_xact_id value/, 
+                type => 'string'
+            }
+        ],
+        "return" => {
+            "desc" =>
+                q{Array of payment IDs on success, event on failure.  Event possibilities include:
+                BAD_PARAMS
+                    Bad parameters were given to this API method itself.
+                    See note field.
+                INVALID_USER_XACT_ID
+                    The last user transaction ID does not match the ID in the database.  This means
+                    the user object has been updated since the last retrieval.  The client should
+                    be instructed to reload the user object and related transactions before attempting
+                    another payment
+                REFUND_EXCEEDS_BALANCE
+                REFUND_EXCEEDS_DESK_PAYMENTS
+                CREDIT_PROCESSOR_NOT_SPECIFIED
+                    Evergreen has not been set up to process CC payments.
+                CREDIT_PROCESSOR_NOT_ALLOWED
+                    Evergreen has been incorrectly setup for CC payments.
+                CREDIT_PROCESSOR_NOT_ENABLED
+                    Evergreen has been set up for CC payments, but an admin
+                    has not explicitly enabled them.
+                CREDIT_PROCESSOR_BAD_PARAMS
+                    Evergreen has been incorrectly setup for CC payments;
+                    specifically, the login and/or password for the CC
+                    processor weren't provided.
+                CREDIT_PROCESSOR_INVALID_CC_NUMBER
+                    You have supplied a credit card number that Evergreen
+                    has judged to be invalid even before attempting to contact
+                    the payment processor.
+                CREDIT_PROCESSOR_DECLINED_TRANSACTION
+                    We contacted the CC processor to attempt the charge, but
+                    they declined it.
+                        The error_message field of the event payload will
+                        contain the payment processor's response.  This
+                        typically includes a message in plain English intended
+                        for human consumption.  In PayPal's case, the message
+                        is preceded by an integer, a colon, and a space, so
+                        a caller might take the 2nd match from /^(\d+: )?(.+)$/
+                        to present to the user.
+                        The payload also contains other fields from the payment
+                        processor, but these are generally not user-friendly
+                        strings.
+                CREDIT_PROCESSOR_SUCCESS_WO_RECORD
+                    A payment was processed successfully, but couldn't be
+                    recorded in Evergreen.  This is _bad bad bad_, as it means
+                    somebody made a payment but isn't getting credit for it.
+                    See errors in the system log if this happens.  Info from
+                    the credit card transaction will also be available in the
+                    event payload, although this probably won't be suitable for
+                    staff client/OPAC display.
+},
+            "type" => "number"
+        }
+    }
+);
+sub make_payments {
+    my($self, $client, $auth, $payments, $last_xact_id) = @_;
+
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+
+    my $type = $payments->{payment_type};
+    my $user_id = $payments->{userid};
+    my $credit = $payments->{patron_credit} || 0;
+    my $drawer = $e->requestor->wsid;
+    my $note = $payments->{note};
+    my $cc_args = $payments->{cc_args};
+    my $check_number = $payments->{check_number};
+    my $total_paid = 0;
+    my $this_ou = $e->requestor->ws_ou;
+    my %orgs;
+
+    # unless/until determined by payment processor API
+    my ($approval_code, $cc_processor, $cc_type) = (undef,undef,undef);
+
+    my $patron = $e->retrieve_actor_user($user_id) or return $e->die_event;
+
+    if($patron->last_xact_id ne $last_xact_id) {
+        $e->rollback;
+        return OpenILS::Event->new('INVALID_USER_XACT_ID');
+    }
+
+    # A user is allowed to make credit card payments on his/her own behalf
+    # All other scenarious require permission
+    unless($type eq 'credit_card_payment' and $user_id == $e->requestor->id) {
+        return $e->die_event unless $e->allowed('CREATE_PAYMENT', $patron->home_ou);
+    }
+
+    # first collect the transactions and make sure the transaction
+    # user matches the requested user
+    my %xacts;
+    for my $pay (@{$payments->{payments}}) {
+        my $xact_id = $pay->[0];
+        my $xact = $e->retrieve_money_billable_transaction_summary($xact_id)
+            or return $e->die_event;
+        
+        if($xact->usr != $user_id) {
+            $e->rollback;
+            return OpenILS::Event->new('BAD_PARAMS', note => q/user does not match transaction/);
+        }
+
+        $xacts{$xact_id} = $xact;
+    }
+
+    my @payment_objs;
+
+    for my $pay (@{$payments->{payments}}) {
+        my $transid = $pay->[0];
+        my $amount = $pay->[1];
+        $amount =~ s/\$//og; # just to be safe
+        my $trans = $xacts{$transid};
+
+        $total_paid += $amount;
+
+        $orgs{$U->xact_org($transid, $e)} = 1;
+
+        # A negative payment is a refund.  
+        if( $amount < 0 ) {
+
+            # Negative credit card payments are not allowed
+            if($type eq 'credit_card_payment') {
+                $e->rollback;
+                return OpenILS::Event->new(
+                    'BAD_PARAMS', 
+                    note => q/Negative credit card payments not allowed/
+                );
+            }
+
+            # If the refund causes the transaction balance to exceed 0 dollars, 
+            # we are in effect loaning the patron money.  This is not allowed.
+            if( ($trans->balance_owed - $amount) > 0 ) {
+                $e->rollback;
+                return OpenILS::Event->new('REFUND_EXCEEDS_BALANCE');
+            }
+
+            # Otherwise, make sure the refund does not exceed desk payments
+            # This is also not allowed
+            my $desk_total = 0;
+            my $desk_payments = $e->search_money_desk_payment({xact => $transid, voided => 'f'});
+            $desk_total += $_->amount for @$desk_payments;
+
+            if( (-$amount) > $desk_total ) {
+                $e->rollback;
+                return OpenILS::Event->new(
+                    'REFUND_EXCEEDS_DESK_PAYMENTS', 
+                    payload => { allowed_refund => $desk_total, submitted_refund => -$amount } );
+            }
+        }
+
+        my $payobj = "Fieldmapper::money::$type";
+        $payobj = $payobj->new;
+
+        $payobj->amount($amount);
+        $payobj->amount_collected($amount);
+        $payobj->xact($transid);
+        $payobj->note($note);
+        if ((not $payobj->note) and ($type eq 'credit_card_payment')) {
+            $payobj->note($cc_args->{note});
+        }
+
+        if ($payobj->has_field('accepting_usr')) { $payobj->accepting_usr($e->requestor->id); }
+        if ($payobj->has_field('cash_drawer')) { $payobj->cash_drawer($drawer); }
+        if ($payobj->has_field('cc_type')) { $payobj->cc_type($cc_args->{type}); }
+        if ($payobj->has_field('check_number')) { $payobj->check_number($check_number); }
+
+        # Store the last 4 digits of the CC number
+        if ($payobj->has_field('cc_number')) {
+            $payobj->cc_number(substr($cc_args->{number}, -4));
+        }
+        if ($payobj->has_field('expire_month')) { $payobj->expire_month($cc_args->{expire_month}); }
+        if ($payobj->has_field('expire_year')) { $payobj->expire_year($cc_args->{expire_year}); }
+        
+        # Note: It is important not to set approval_code
+        # on the fieldmapper object yet.
+
+        push(@payment_objs, $payobj);
+
+    } # all payment objects have been created and inserted. 
+
+    #### NO WRITES TO THE DB ABOVE THIS LINE -- THEY'LL ONLY BE DISCARDED  ###
+    $e->rollback;
+
+    # After we try to externally process a credit card (if desired), we'll
+    # open a new transaction.  We cannot leave one open while credit card
+    # processing might be happening, as it can easily time out the database
+    # transaction.
+
+    my $cc_payload;
+
+    if($type eq 'credit_card_payment') {
+        $approval_code = $cc_args->{approval_code};
+        # If an approval code was not given, we'll need
+        # to call to the payment processor ourselves.
+        if ($cc_args->{where_process} == 1) {
+            return OpenILS::Event->new('BAD_PARAMS', note => 'Need CC number')
+                if not $cc_args->{number};
+            my $response =
+                OpenILS::Application::Circ::CreditCard::process_payment({
+                    "desc" => $cc_args->{note},
+                    "amount" => $total_paid,
+                    "patron_id" => $user_id,
+                    "cc" => $cc_args->{number},
+                    "expiration" => sprintf(
+                        "%02d-%04d",
+                        $cc_args->{expire_month},
+                        $cc_args->{expire_year}
+                    ),
+                    "ou" => $this_ou,
+                    "first_name" => $cc_args->{billing_first},
+                    "last_name" => $cc_args->{billing_last},
+                    "address" => $cc_args->{billing_address},
+                    "city" => $cc_args->{billing_city},
+                    "state" => $cc_args->{billing_state},
+                    "zip" => $cc_args->{billing_zip},
+                });
+
+            if ($U->event_code($response)) { # non-success
+                $logger->info(
+                    "Credit card payment for user $user_id failed: " .
+                    $response->{"textcode"} . " " .
+                    $response->{"payload"}->{"error_message"}
+                );
+
+                return $response;
+            } else {
+                # We need to save this for later in case there's a failure on
+                # the EG side to store the processor's result.
+                $cc_payload = $response->{"payload"};
+
+                $approval_code = $cc_payload->{"authorization"};
+                $cc_type = $cc_payload->{"card_type"};
+                $cc_processor = $cc_payload->{"processor"};
+                $logger->info("Credit card payment for user $user_id succeeded");
+            }
+        } else {
+            return OpenILS::Event->new(
+                'BAD_PARAMS', note => 'Need approval code'
+            ) if not $cc_args->{approval_code};
+        }
+    }
+
+    ### RE-OPEN TRANSACTION HERE ###
+    $e->xact_begin;
+    my @payment_ids;
+
+    # create payment records
+    my $create_money_method = "create_money_" . $type;
+    for my $payment (@payment_objs) {
+        # update the transaction if it's done
+        my $amount = $payment->amount;
+        my $transid = $payment->xact;
+        my $trans = $xacts{$transid};
+        if( (my $cred = ($trans->balance_owed - $amount)) <= 0 ) {
+            # Any overpay on this transaction goes directly into patron
+            # credit making payment with existing patron credit.
+            $credit -= $amount if $type eq 'credit_payment';
+
+            $cred = -$cred;
+            $credit += $cred;
+            my $circ = $e->retrieve_action_circulation($transid);
+
+            if(!$circ || $circ->stop_fines) {
+                # If this is a circulation, we can't close the transaction
+                # unless stop_fines is set.
+                $trans = $e->retrieve_money_billable_transaction($transid);
+                $trans->xact_finish("now");
+                if (!$e->update_money_billable_transaction($trans)) {
+                    return _recording_failure(
+                        $e, "update_money_billable_transaction() failed",
+                        $payment, $cc_payload
+                    )
+                }
+            }
+        }
+
+        $payment->approval_code($approval_code) if $approval_code;
+        $payment->cc_type($cc_type) if $cc_type;
+        $payment->cc_processor($cc_processor) if $cc_processor;
+        $payment->cc_first_name($cc_args->{'billing_first'}) if $cc_args->{'billing_first'};
+        $payment->cc_last_name($cc_args->{'billing_last'}) if $cc_args->{'billing_last'};
+        if (!$e->$create_money_method($payment)) {
+            return _recording_failure(
+                $e, "$create_money_method failed", $payment, $cc_payload
+            );
+        }
+
+        push(@payment_ids, $payment->id);
+    }
+
+    my $evt = _update_patron_credit($e, $patron, $credit);
+    if ($evt) {
+        return _recording_failure(
+            $e, "_update_patron_credit() failed", undef, $cc_payload
+        );
+    }
+
+    for my $org_id (keys %orgs) {
+        # calculate penalties for each of the affected orgs
+        $evt = OpenILS::Utils::Penalty->calculate_penalties(
+            $e, $user_id, $org_id
+        );
+        if ($evt) {
+            return _recording_failure(
+                $e, "calculate_penalties() failed", undef, $cc_payload
+            );
+        }
+    }
+
+    # update the user to create a new last_xact_id
+    $e->update_actor_user($patron) or return $e->die_event;
+    $patron = $e->retrieve_actor_user($patron) or return $e->die_event;
+    $e->commit;
+
+    # update the cached user object if a user is making a payment toward 
+    # his/her own account
+    $U->simplereq('open-ils.auth', 'open-ils.auth.session.reset_timeout', $auth, 1)
+        if $user_id == $e->requestor->id;
+
+    return {last_xact_id => $patron->last_xact_id, payments => \@payment_ids};
+}
+
+sub _recording_failure {
+    my ($e, $msg, $payment, $payload) = @_;
+
+    if ($payload) { # If the payment processor already accepted a payment:
+        $logger->error($msg);
+        $logger->error("Payment processor payload: " . Dumper($payload));
+        # payment shouldn't contain CC number
+        $logger->error("Payment: " . Dumper($payment)) if $payment;
+
+        $e->rollback;
+
+        return new OpenILS::Event(
+            "CREDIT_PROCESSOR_SUCCESS_WO_RECORD",
+            "payload" => $payload
+        );
+    } else { # Otherwise, the problem is somewhat less severe:
+        $logger->warn($msg);
+        $logger->warn("Payment: " . Dumper($payment)) if $payment;
+        return $e->die_event;
+    }
+}
+
+sub _update_patron_credit {
+    my($e, $patron, $credit) = @_;
+    return undef if $credit == 0;
+    $patron->credit_forward_balance($patron->credit_forward_balance + $credit);
+    return OpenILS::Event->new('NEGATIVE_PATRON_BALANCE') if $patron->credit_forward_balance < 0;
+    $e->update_actor_user($patron) or return $e->die_event;
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+    method    => "retrieve_payments",
+    api_name    => "open-ils.circ.money.payment.retrieve.all_",
+    notes        => "Returns a list of payments attached to a given transaction"
+    );
+sub retrieve_payments {
+    my( $self, $client, $login, $transid ) = @_;
+
+    my( $staff, $evt ) =  
+        $apputils->checksesperm($login, 'VIEW_TRANSACTION');
+    return $evt if $evt;
+
+    # XXX the logic here is wrong.. we need to check the owner of the transaction
+    # to make sure the requestor has access
+
+    # XXX grab the view, for each object in the view, grab the real object
+
+    return $apputils->simplereq(
+        'open-ils.cstore',
+        'open-ils.cstore.direct.money.payment.search.atomic', { xact => $transid } );
+}
+
+
+__PACKAGE__->register_method(
+    method    => "retrieve_payments2",
+    authoritative => 1,
+    api_name    => "open-ils.circ.money.payment.retrieve.all",
+    notes        => "Returns a list of payments attached to a given transaction"
+    );
+    
+sub retrieve_payments2 {
+    my( $self, $client, $login, $transid ) = @_;
+
+    my $e = new_editor(authtoken=>$login);
+    return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('VIEW_TRANSACTION');
+
+    my @payments;
+    my $pmnts = $e->search_money_payment({ xact => $transid });
+    for( @$pmnts ) {
+        my $type = $_->payment_type;
+        my $meth = "retrieve_money_$type";
+        my $p = $e->$meth($_->id) or return $e->event;
+        $p->payment_type($type);
+        $p->cash_drawer($e->retrieve_actor_workstation($p->cash_drawer))
+            if $p->has_field('cash_drawer');
+        push( @payments, $p );
+    }
+
+    return \@payments;
+}
+
+__PACKAGE__->register_method(
+    method    => "format_payment_receipt",
+    api_name  => "open-ils.circ.money.payment_receipt.print",
+    signature => {
+        desc   => 'Returns a printable receipt for the specified payments',
+        params => [
+            { desc => 'Authentication token',  type => 'string'},
+            { desc => 'Payment ID or array of payment IDs', type => 'number' },
+        ],
+        return => {
+            desc => q/An action_trigger.event object or error event./,
+            type => 'object',
+        }
+    }
+);
+__PACKAGE__->register_method(
+    method    => "format_payment_receipt",
+    api_name  => "open-ils.circ.money.payment_receipt.email",
+    signature => {
+        desc   => 'Emails a receipt for the specified payments to the user associated with the first payment',
+        params => [
+            { desc => 'Authentication token',  type => 'string'},
+            { desc => 'Payment ID or array of payment IDs', type => 'number' },
+        ],
+        return => {
+            desc => q/Undefined on success, otherwise an error event./,
+            type => 'object',
+        }
+    }
+);
+
+sub format_payment_receipt {
+    my($self, $conn, $auth, $mp_id) = @_;
+
+    my $mp_ids;
+    if (ref $mp_id ne 'ARRAY') {
+        $mp_ids = [ $mp_id ];
+    } else {
+        $mp_ids = $mp_id;
+    }
+
+    my $for_print = ($self->api_name =~ /print/);
+    my $for_email = ($self->api_name =~ /email/);
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    my $payments = [];
+    for my $id (@$mp_ids) {
+
+        my $payment = $e->retrieve_money_payment([
+            $id,
+            {   flesh => 2,
+                flesh_fields => {
+                    mp => ['xact'],
+                    mbt => ['usr']
+                }
+            }
+        ]) or return OpenILS::Event->new('MP_NOT_FOUND');
+
+        return $e->event unless $e->allowed('VIEW_TRANSACTION', $payment->xact->usr->home_ou); 
+
+        push @$payments, $payment;
+    }
+
+    if ($for_print) {
+
+        return $U->fire_object_event(undef, 'money.format.payment_receipt.print', $payments, $$payments[0]->xact->usr->home_ou);
+
+    } elsif ($for_email) {
+
+        for my $p (@$payments) {
+            $U->create_events_for_hook('money.format.payment_receipt.email', $p, $p->xact->usr->home_ou, undef, undef, 1);
+        }
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method(
+    method    => "create_grocery_bill",
+    api_name    => "open-ils.circ.money.grocery.create",
+    notes        => <<"    NOTE");
+    Creates a new grocery transaction using the transaction object provided
+    PARAMS: (login_session, money.grocery (mg) object)
+    NOTE
+
+sub create_grocery_bill {
+    my( $self, $client, $login, $transaction ) = @_;
+
+    my( $staff, $evt ) = $apputils->checkses($login);
+    return $evt if $evt;
+    $evt = $apputils->check_perms($staff->id, 
+        $transaction->billing_location, 'CREATE_TRANSACTION' );
+    return $evt if $evt;
+
+
+    $logger->activity("Creating grocery bill " . Dumper($transaction) );
+
+    $transaction->clear_id;
+    my $session = $apputils->start_db_session;
+    my $transid = $session->request(
+        'open-ils.storage.direct.money.grocery.create', $transaction)->gather(1);
+
+    throw OpenSRF::EX ("Error creating new money.grocery") unless defined $transid;
+
+    $logger->debug("Created new grocery transaction $transid");
+    
+    $apputils->commit_db_session($session);
+
+    my $e = new_editor(xact=>1);
+    $evt = _check_open_xact($e, $transid);
+    return $evt if $evt;
+    $e->commit;
+
+    return $transid;
+}
+
+
+__PACKAGE__->register_method(
+    method => 'fetch_reservation',
+    api_name => 'open-ils.circ.booking.reservation.retrieve'
+);
+sub fetch_reservation {
+    my( $self, $conn, $auth, $id ) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('VIEW_TRANSACTION'); # eh.. basically the same permission
+    my $g = $e->retrieve_booking_reservation($id)
+        or return $e->event;
+    return $g;
+}
+
+__PACKAGE__->register_method(
+    method   => 'fetch_grocery',
+    api_name => 'open-ils.circ.money.grocery.retrieve'
+);
+sub fetch_grocery {
+    my( $self, $conn, $auth, $id ) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('VIEW_TRANSACTION'); # eh.. basically the same permission
+    my $g = $e->retrieve_money_grocery($id)
+        or return $e->event;
+    return $g;
+}
+
+
+__PACKAGE__->register_method(
+    method        => "billing_items",
+    api_name      => "open-ils.circ.money.billing.retrieve.all",
+    authoritative => 1,
+    signature     => {
+        desc   => 'Returns a list of billing items for the given transaction ID.  ' .
+                  'If the operator is not the owner of the transaction, the VIEW_TRANSACTION permission is required.',
+        params => [
+            { desc => 'Authentication token', type => 'string'},
+            { desc => 'Transaction ID',       type => 'number'}
+        ],
+        return => {
+            desc => 'Transaction object, event on error'
+        },
+    }
+);
+
+sub billing_items {
+    my( $self, $client, $login, $transid ) = @_;
+
+    my( $trans, $evt ) = $U->fetch_billable_xact($transid);
+    return $evt if $evt;
+
+    my $staff;
+    ($staff, $evt ) = $apputils->checkses($login);
+    return $evt if $evt;
+
+    if($staff->id ne $trans->usr) {
+        $evt = $U->check_perms($staff->id, $staff->home_ou, 'VIEW_TRANSACTION');
+        return $evt if $evt;
+    }
+    
+    return $apputils->simplereq( 'open-ils.cstore',
+        'open-ils.cstore.direct.money.billing.search.atomic', { xact => $transid } )
+}
+
+
+__PACKAGE__->register_method(
+    method   => "billing_items_create",
+    api_name => "open-ils.circ.money.billing.create",
+    notes    => <<"    NOTE");
+    Creates a new billing line item
+    PARAMS( login, bill_object (mb) )
+    NOTE
+
+sub billing_items_create {
+    my( $self, $client, $login, $billing ) = @_;
+
+    my $e = new_editor(authtoken => $login, xact => 1);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('CREATE_BILL');
+
+    my $xact = $e->retrieve_money_billable_transaction($billing->xact)
+        or return $e->die_event;
+
+    # if the transaction was closed, re-open it
+    if($xact->xact_finish) {
+        $xact->clear_xact_finish;
+        $e->update_money_billable_transaction($xact)
+            or return $e->die_event;
+    }
+
+    my $amt = $billing->amount;
+    $amt =~ s/\$//og;
+    $billing->amount($amt);
+
+    $e->create_money_billing($billing) or return $e->die_event;
+    my $evt = OpenILS::Utils::Penalty->calculate_penalties($e, $xact->usr, $U->xact_org($xact->id));
+    return $evt if $evt;
+    $e->commit;
+
+    return $billing->id;
+}
+
+
+__PACKAGE__->register_method(
+    method        =>    'void_bill',
+    api_name        => 'open-ils.circ.money.billing.void',
+    signature    => q/
+        Voids a bill
+        @param authtoken Login session key
+        @param billid Id for the bill to void.  This parameter may be repeated to reference other bills.
+        @return 1 on success, Event on error
+    /
+);
+sub void_bill {
+    my( $s, $c, $authtoken, @billids ) = @_;
+
+    my $e = new_editor( authtoken => $authtoken, xact => 1 );
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('VOID_BILLING');
+
+    my %users;
+    for my $billid (@billids) {
+
+        my $bill = $e->retrieve_money_billing($billid)
+            or return $e->die_event;
+
+        my $xact = $e->retrieve_money_billable_transaction($bill->xact)
+            or return $e->die_event;
+
+        if($U->is_true($bill->voided)) {
+            $e->rollback;
+            return OpenILS::Event->new('BILL_ALREADY_VOIDED', payload => $bill);
+        }
+
+        my $org = $U->xact_org($bill->xact, $e);
+        $users{$xact->usr} = {} unless $users{$xact->usr};
+        $users{$xact->usr}->{$org} = 1;
+
+        $bill->voided('t');
+        $bill->voider($e->requestor->id);
+        $bill->void_time('now');
+    
+        $e->update_money_billing($bill) or return $e->die_event;
+        my $evt = _check_open_xact($e, $bill->xact, $xact);
+        return $evt if $evt;
+    }
+
+    # calculate penalties for all user/org combinations
+    for my $user_id (keys %users) {
+        for my $org_id (keys %{$users{$user_id}}) {
+            OpenILS::Utils::Penalty->calculate_penalties($e, $user_id, $org_id);
+        }
+    }
+    $e->commit;
+    return 1;
+}
+
+
+__PACKAGE__->register_method(
+    method        =>    'edit_bill_note',
+    api_name        => 'open-ils.circ.money.billing.note.edit',
+    signature    => q/
+        Edits the note for a bill
+        @param authtoken Login session key
+        @param note The replacement note for the bills we're editing
+        @param billid Id for the bill to edit the note of.  This parameter may be repeated to reference other bills.
+        @return 1 on success, Event on error
+    /
+);
+sub edit_bill_note {
+    my( $s, $c, $authtoken, $note, @billids ) = @_;
+
+    my $e = new_editor( authtoken => $authtoken, xact => 1 );
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('UPDATE_BILL_NOTE');
+
+    for my $billid (@billids) {
+
+        my $bill = $e->retrieve_money_billing($billid)
+            or return $e->die_event;
+
+        $bill->note($note);
+        # FIXME: Does this get audited?  Need some way so that the original creator of the bill does not get credit/blame for the new note.
+    
+        $e->update_money_billing($bill) or return $e->die_event;
+    }
+    $e->commit;
+    return 1;
+}
+
+
+__PACKAGE__->register_method(
+    method        =>    'edit_payment_note',
+    api_name        => 'open-ils.circ.money.payment.note.edit',
+    signature    => q/
+        Edits the note for a payment
+        @param authtoken Login session key
+        @param note The replacement note for the payments we're editing
+        @param paymentid Id for the payment to edit the note of.  This parameter may be repeated to reference other payments.
+        @return 1 on success, Event on error
+    /
+);
+sub edit_payment_note {
+    my( $s, $c, $authtoken, $note, @paymentids ) = @_;
+
+    my $e = new_editor( authtoken => $authtoken, xact => 1 );
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('UPDATE_PAYMENT_NOTE');
+
+    for my $paymentid (@paymentids) {
+
+        my $payment = $e->retrieve_money_payment($paymentid)
+            or return $e->die_event;
+
+        $payment->note($note);
+        # FIXME: Does this get audited?  Need some way so that the original taker of the payment does not get credit/blame for the new note.
+    
+        $e->update_money_payment($payment) or return $e->die_event;
+    }
+
+    $e->commit;
+    return 1;
+}
+
+sub _check_open_xact {
+    my( $editor, $xactid, $xact ) = @_;
+
+    # Grab the transaction
+    $xact ||= $editor->retrieve_money_billable_transaction($xactid);
+    return $editor->event unless $xact;
+    $xactid ||= $xact->id;
+
+    # grab the summary and see how much is owed on this transaction
+    my ($summary) = $U->fetch_mbts($xactid, $editor);
+
+    # grab the circulation if it is a circ;
+    my $circ = $editor->retrieve_action_circulation($xactid);
+
+    # If nothing is owed on the transaction but it is still open
+    # and this transaction is not an open circulation, close it
+    if( 
+        ( $summary->balance_owed == 0 and ! $xact->xact_finish ) and
+        ( !$circ or $circ->stop_fines )) {
+
+        $logger->info("closing transaction ".$xact->id. ' becauase balance_owed == 0');
+        $xact->xact_finish('now');
+        $editor->update_money_billable_transaction($xact)
+            or return $editor->event;
+        return undef;
+    }
+
+    # If money is owed or a refund is due on the xact and xact_finish
+    # is set, clear it (to reopen the xact) and update
+    if( $summary->balance_owed != 0 and $xact->xact_finish ) {
+        $logger->info("re-opening transaction ".$xact->id. ' becauase balance_owed != 0');
+        $xact->clear_xact_finish;
+        $editor->update_money_billable_transaction($xact)
+            or return $editor->event;
+        return undef;
+    }
+    return undef;
+}
+
+
+__PACKAGE__->register_method (
+    method => 'fetch_mbts',
+    authoritative => 1,
+    api_name => 'open-ils.circ.money.billable_xact_summary.retrieve'
+);
+sub fetch_mbts {
+    my( $self, $conn, $auth, $id) = @_;
+
+    my $e = new_editor(xact => 1, authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    my ($mbts) = $U->fetch_mbts($id, $e);
+
+    my $user = $e->retrieve_actor_user($mbts->usr)
+        or return $e->die_event;
+
+    return $e->die_event unless $e->allowed('VIEW_TRANSACTION', $user->home_ou);
+    $e->rollback;
+    return $mbts
+}
+
+
+__PACKAGE__->register_method(
+    method => 'desk_payments',
+    api_name => 'open-ils.circ.money.org_unit.desk_payments'
+);
+sub desk_payments {
+    my( $self, $conn, $auth, $org, $start_date, $end_date ) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('VIEW_TRANSACTION', $org);
+    my $data = $U->storagereq(
+        'open-ils.storage.money.org_unit.desk_payments.atomic',
+        $org, $start_date, $end_date );
+
+    $_->workstation( $_->workstation->name ) for(@$data);
+    return $data;
+}
+
+
+__PACKAGE__->register_method(
+    method => 'user_payments',
+    api_name => 'open-ils.circ.money.org_unit.user_payments'
+);
+
+sub user_payments {
+    my( $self, $conn, $auth, $org, $start_date, $end_date ) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('VIEW_TRANSACTION', $org);
+    my $data = $U->storagereq(
+        'open-ils.storage.money.org_unit.user_payments.atomic',
+        $org, $start_date, $end_date );
+    for(@$data) {
+        $_->usr->card(
+            $e->retrieve_actor_card($_->usr->card)->barcode);
+        $_->usr->home_ou(
+            $e->retrieve_actor_org_unit($_->usr->home_ou)->shortname);
+    }
+    return $data;
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'retrieve_credit_payable_balance',
+    api_name  => 'open-ils.circ.credit.payable_balance.retrieve',
+    authoritative => 1,
+    signature => {
+        desc   => q/Returns the total amount the patron can pay via credit card/,
+        params => [
+            { desc => 'Authentication token', type => 'string' },
+            { desc => 'User id', type => 'number' }
+        ],
+        return => { desc => 'The ID of the new provider' }
+    }
+);
+
+sub retrieve_credit_payable_balance {
+    my ( $self, $conn, $auth, $user_id ) = @_;
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    my $user = $e->retrieve_actor_user($user_id) 
+        or return $e->event;
+
+    if($e->requestor->id != $user_id) {
+        return $e->event unless $e->allowed('VIEW_USER_TRANSACTIONS', $user->home_ou)
+    }
+
+    my $circ_orgs = $e->json_query({
+        "select" => {circ => ["circ_lib"]},
+        from     => "circ",
+        "where"  => {usr => $user_id, xact_finish => undef},
+        distinct => 1
+    });
+
+    my $groc_orgs = $e->json_query({
+        "select" => {mg => ["billing_location"]},
+        from     => "mg",
+        "where"  => {usr => $user_id, xact_finish => undef},
+        distinct => 1
+    });
+
+    my %hash;
+    for my $org ( @$circ_orgs, @$groc_orgs ) {
+        my $o = $org->{billing_location};
+        $o = $org->{circ_lib} unless $o;
+        next if $hash{$o};    # was $hash{$org}, but that doesn't make sense.  $org is a hashref and $o gets added in the next line.
+        $hash{$o} = $U->ou_ancestor_setting_value($o, 'credit.payments.allow', $e);
+    }
+
+    my @credit_orgs = map { $hash{$_} ? ($_) : () } keys %hash;
+    $logger->debug("credit: relevant orgs that allow credit payments => @credit_orgs");
+
+    my $xact_summaries =
+      OpenILS::Application::AppUtils->simplereq('open-ils.actor',
+        'open-ils.actor.user.transactions.have_charge', $auth, $user_id);
+
+    my $sum = 0.0;
+
+    for my $xact (@$xact_summaries) {
+
+        # make two lists and grab them in batch XXX
+        if ( $xact->xact_type eq 'circulation' ) {
+            my $circ = $e->retrieve_action_circulation($xact->id) or return $e->event;
+            next unless grep { $_ == $circ->circ_lib } @credit_orgs;
+
+        } elsif ($xact->xact_type eq 'grocery') {
+            my $bill = $e->retrieve_money_grocery($xact->id) or return $e->event;
+            next unless grep { $_ == $bill->billing_location } @credit_orgs;
+        } elsif ($xact->xact_type eq 'reservation') {
+            my $bill = $e->retrieve_booking_reservation($xact->id) or return $e->event;
+            next unless grep { $_ == $bill->pickup_lib } @credit_orgs;
+        }
+        $sum += $xact->balance_owed();
+    }
+
+    return $sum;
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/NonCat.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/NonCat.pm
new file mode 100644
index 0000000000..fd35b19ed8
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/NonCat.pm
@@ -0,0 +1,263 @@
+package OpenILS::Application::Circ::NonCat;
+use base 'OpenILS::Application';
+use strict; use warnings;
+use OpenSRF::EX qw(:try);
+use Data::Dumper;
+use DateTime;
+use DateTime::Format::ISO8601;
+use OpenSRF::Utils qw/:datetime/;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::Editor;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+$Data::Dumper::Indent = 0;
+
+my $U = "OpenILS::Application::AppUtils";
+my $_dt_parser = DateTime::Format::ISO8601->new;
+
+
+# returns ( $newid, $evt ).  If $evt, then there was an error
+sub create_non_cat_circ {
+	my( $staffid, $patronid, $circ_lib, $noncat_type, $circ_time, $editor ) = @_;
+
+	my( $id, $nct, $evt );
+	$circ_time ||= 'now';
+	my $circ = Fieldmapper::action::non_cataloged_circulation->new;
+
+	$logger->activity("Creating non-cataloged circulation for ".
+		"staff $staffid, patron $patronid, location $circ_lib, and non-cat type $noncat_type");
+
+	$circ->patron($patronid);
+	$circ->staff($staffid);
+	$circ->circ_lib($circ_lib);
+	$circ->item_type($noncat_type);
+	$circ->circ_time($circ_time);
+
+	if( $editor ) {
+		$evt = $editor->event unless
+			$circ = $editor->create_action_non_cataloged_circulation( $circ )
+
+
+	} else {
+		$id = $U->simplereq(
+			'open-ils.storage',
+			'open-ils.storage.direct.action.non_cataloged_circulation.create', $circ );
+		$evt = $U->DB_UPDATE_FAILED($circ) unless $id;
+		$circ->id($id);
+	}
+
+    if($circ) {
+        my $e = ($editor) ? $editor : new_editor();
+        $circ = noncat_due_date($e, $circ);
+    }
+
+	return( $circ, $evt );
+}
+
+
+__PACKAGE__->register_method(
+    method   => "create_noncat_type",
+    api_name => "open-ils.circ.non_cat_type.create",
+    notes    => q/
+		Creates a new non cataloged item type
+		@param authtoken The login session key
+		@param name The name of the new type
+		@param orgId The location where the type will live
+		@return The type object on success and the corresponding
+		event on failure
+	/
+);
+
+sub create_noncat_type {
+	my( $self, $client, $authtoken, $name, $orgId, $interval, $inhouse ) = @_;
+
+	my $e = new_editor(authtoken=>$authtoken, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('CREATE_NON_CAT_TYPE', $orgId);
+
+	# grab all of "my" non-cat types and see if one with 
+	# the requested name already exists
+	my $types = retrieve_noncat_types_all($self, $client, $orgId);
+	for(@$types) {
+		if( $_->name eq $name ) {
+			$e->rollback;
+			return OpenILS::Event->new('NON_CAT_TYPE_EXISTS', payload => $name);
+		}
+	}
+
+	my $type = Fieldmapper::config::non_cataloged_type->new;
+	$type->name($name);
+	$type->owning_lib($orgId);
+	$type->circ_duration($interval);
+	$type->in_house( ($inhouse) ? 't' : 'f' );
+
+	$e->create_config_non_cataloged_type($type) or return $e->die_event;
+	$e->commit;
+	return $type;
+}
+
+
+__PACKAGE__->register_method(
+    method   => "update_noncat_type",
+    api_name => "open-ils.circ.non_cat_type.update",
+    notes    => q/
+		Updates a non-cataloged type object
+		@param authtoken The login session key
+		@param type The updated type object
+		@return The result of the DB update call unless a preceeding event occurs, 
+			in which case the event will be returned
+	/
+);
+
+sub update_noncat_type {
+	my( $self, $client, $authtoken, $type ) = @_;
+	my $e = new_editor(xact=>1, authtoken=>$authtoken);
+	return $e->die_event unless $e->checkauth;
+
+	my $otype = $e->retrieve_config_non_cataloged_type($type->id) 
+		or return $e->die_event;
+
+	return $e->die_event unless 
+		$e->allowed('UPDATE_NON_CAT_TYPE', $otype->owning_lib);
+
+	$type->owning_lib($otype->owning_lib); # do not allow them to "move" the object
+
+	$e->update_config_non_cataloged_type($type) or return $e->die_event;
+	$e->commit;
+	return 1;
+}
+
+__PACKAGE__->register_method(
+    method    => "retrieve_noncat_types_all",
+    api_name  => "open-ils.circ.non_cat_types.retrieve.all",
+    signature => {
+        desc   => 'Retrieves the non-cat types at the requested location as well '
+                . 'as those above and below it in the org tree',
+        params => [
+            { name => 'orgId', desc => 'Org unit ID of the base location',   type => 'number' },
+            { name => 'depth', desc => 'Depth limit of the tree (optional)', type => 'number' }
+        ],
+        return => {
+            desc => 'Array of non-cat objects, event on error'
+        },
+    }
+);
+
+sub retrieve_noncat_types_all {
+    my( $self, $client, $orgId, $depth ) = @_;
+    my $meth = 'open-ils.storage.ranged.config.non_cataloged_type.retrieve.atomic';
+    my $svc  = 'open-ils.storage';
+    return $U->simplereq($svc, $meth, $orgId, $depth) if defined($depth);
+    return $U->simplereq($svc, $meth, $orgId);
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'fetch_noncat',
+    api_name  => 'open-ils.circ.non_cataloged_circulation.retrieve',
+    signature => {
+        desc   => 'Retrieve a circulation on a non cataloged item for a given Circ ID.  If the operator is not the '
+                . 'patron owner of the circ, the VIEW_CIRCULATIONS permission is required',
+        params => [
+            { desc => 'Authentication token', type => 'string' },
+            { desc => 'Circulation ID',       type => 'number' }
+        ],
+        return => {
+            desc => 'Circulation object, event on error',
+        },
+    }
+);
+
+sub fetch_noncat {
+	my( $self, $conn, $auth, $circid ) = @_;
+	my $e = new_editor( authtoken => $auth );
+	return $e->event unless $e->checkauth;
+	my $c = $e->retrieve_action_non_cataloged_circulation($circid)
+		or return $e->event;
+	if( $c->patron ne $e->requestor->id ) {
+		return $e->event unless $e->allowed('VIEW_CIRCULATIONS'); # XXX rely on editor perm
+	}
+    return noncat_due_date($e, $c);
+}
+
+sub noncat_due_date {
+    my($e, $circ) = @_;
+
+	my $otype = $e->retrieve_config_non_cataloged_type($circ->item_type) 
+		or return $e->die_event;
+
+	my $duedate = $_dt_parser->parse_datetime( cleanse_ISO8601($circ->circ_time) );
+	$duedate = $duedate
+		->add( seconds => interval_to_seconds($otype->circ_duration) )
+		->strftime('%FT%T%z');
+
+	my $offset = $U->storagereq(
+		'open-ils.storage.actor.org_unit.closed_date.overlap',
+		$circ->circ_lib,
+		$duedate
+	);
+
+	$duedate = $offset->{end} if ($offset);
+	$circ->duedate($duedate);
+
+	return $circ;
+}
+
+
+
+__PACKAGE__->register_method(
+    method        => 'fetch_open_noncats',
+    authoritative => 1,
+    api_name      => 'open-ils.circ.open_non_cataloged_circulation.user',
+    signature     => {
+        desca   => 'For a given user, returns an id-list of non-cataloged circulations that are considered open as of now.  ' .
+		           'A circ is open if circ time + circ duration (based on type) is > than now.  If trying to view the circs ' .
+                   'of another user, the VIEW_CIRCULATIONS permission is required',
+		params => [
+            { desc => 'Authentication token',                            type => 'string' },
+            { desc => 'UserID (optional: defaults to the session user)', type => 'number' }
+		],
+        return => {
+            desc => 'Array of non-cataloged circ IDs, event on error'
+        },
+    }
+);
+
+sub fetch_open_noncats {
+	my( $self, $conn, $auth, $userid ) = @_;
+	my $e = OpenILS::Utils::Editor->new( authtoken => $auth );
+	return $e->event unless $e->checkauth;
+	$userid ||= $e->requestor->id;
+	if( $e->requestor->id ne $userid ) {
+		return $e->event unless $e->allowed('VIEW_CIRCULATIONS'); # XXX rely on editor perm
+	}
+	return $e->request(
+		'open-ils.storage.action.open_non_cataloged_circulation.user', $userid );
+}
+
+
+__PACKAGE__->register_method(
+    method   => 'delete_noncat',
+    api_name => 'open-ils.circ.non_cataloged_type.delete',
+);
+sub delete_noncat {
+	my( $self, $conn, $auth, $typeid ) = @_;
+	my $e = new_editor(xact=>1, authtoken => $auth);
+	return $e->die_event unless $e->checkauth;
+
+	my $nc = $e->retrieve_config_non_cataloged_type($typeid)
+		or return $e->die_event;
+
+	$e->allowed('DELETE_NON_CAT_TYPE', $nc->owning_lib) # XXX rely on editor perm
+		or return $e->die_event;
+
+	#	XXX Add checks to see if this type is in use by a transaction
+
+	$e->delete_config_non_cataloged_type($nc) or return $e->die_event;
+	$e->commit;
+	return 1;
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/ScriptBuilder.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/ScriptBuilder.pm
new file mode 100644
index 0000000000..7589cab9ef
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/ScriptBuilder.pm
@@ -0,0 +1,435 @@
+package OpenILS::Application::Circ::ScriptBuilder;
+use strict; use warnings;
+use OpenILS::Utils::ScriptRunner;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenILS::Application::AppUtils;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenILS::Application::Circ::Holds;
+use DateTime::Format::ISO8601;
+use OpenSRF::Utils qw/:datetime/;
+use Scalar::Util qw/weaken/;
+my $U = "OpenILS::Application::AppUtils";
+use Data::Dumper;
+
+my $holdcode = "OpenILS::Application::Circ::Holds";
+
+my $evt = "environment";
+my %GROUP_SET;
+my $GROUP_TREE;
+my $ORG_TREE;
+my @ORG_LIST;
+my @OU_TYPES;
+
+
+# -----------------------------------------------------------------------
+# Possible Args:
+#  copy
+#  copy_id
+#  copy_barcode
+#
+#  patron
+#  patron_id
+#  patron_barcode
+#
+#  fetch_patron_circ_info - load info on items out, overdues, and fines.
+#
+#  _direct - this is a hash of key/value pairs to shove directly into the 
+#  script runner.  Use this to cover data not covered by this module
+# -----------------------------------------------------------------------
+sub build {
+	my( $class, $args ) = @_;
+
+	my $evt;
+	my @evts;
+
+	my $rollback;
+	my $editor = $$args{editor};
+
+	unless($editor) {
+		$editor = new_editor(xact => 1);
+		$rollback = 1;
+	}
+
+	$args->{_direct} = {} unless $args->{_direct};
+	#$args->{editor} = $editor;
+	
+	$evt = fetch_bib_data($editor, $args);
+	push(@evts, $evt) if $evt;
+	$evt = fetch_user_data($editor, $args);
+	push(@evts, $evt) if $evt;
+
+	if(@evts) {
+		my @e;
+		push( @e, $_->{textcode} ) for @evts;
+		$logger->info("script_builder: some events occurred: @e");
+		$logger->debug("script_builder: some events occurred: " . Dumper(\@evts));
+		$args->{_events} = \@evts;
+	}
+
+	my $r = build_runner($editor, $args);
+	$editor->rollback if $rollback;
+	return $r;
+}
+
+
+sub build_runner {
+	my $editor	= shift;
+	my $ctx		= shift;
+
+	my $runner = OpenILS::Utils::ScriptRunner->new;
+
+	my $gt = $GROUP_TREE;
+	$runner->insert( "$evt.groupTree",	$gt, 1);
+
+
+	$runner->insert( "$evt.patron",		$ctx->{patron}, 1);
+	$runner->insert( "$evt.copy",			$ctx->{copy}, 1);
+	$runner->insert( "$evt.volume",		$ctx->{volume}, 1);
+	$runner->insert( "$evt.title",		$ctx->{title}, 1);
+
+	if( ref $ctx->{requestor} ) {
+		$runner->insert( "$evt.requestor",	$ctx->{requestor}, 1);
+		if($ctx->{requestor}->ws_ou) {
+			$runner->insert( "$evt.location",	
+				$editor->retrieve_actor_org_unit($ctx->{requestor}->ws_ou), 1);
+		}
+	}
+
+	$runner->insert( "$evt.patronItemsOut", $ctx->{patronItemsOut}, 1 );
+	$runner->insert( "$evt.patronOverdueCount", $ctx->{patronOverdue}, 1 );
+	$runner->insert( "$evt.patronFines", $ctx->{patronFines}, 1 );
+
+	$runner->insert("$evt.$_", $ctx->{_direct}->{$_}, 1) for keys %{$ctx->{_direct}};
+
+	insert_org_methods( $editor, $runner );
+	insert_copy_methods( $editor, $ctx, $runner );
+   insert_user_funcs( $editor, $ctx, $runner );
+
+	return $runner;
+}
+
+sub fetch_bib_data {
+	my $e = shift;
+	my $ctx = shift;
+
+	my $flesh = { 
+		flesh => 2, 
+		flesh_fields => { 
+			acp => [ 'location', 'status', 'circ_lib', 'age_protect', 'call_number' ],
+			acn => [ 'record' ]
+		} 
+	};
+
+	if( $ctx->{copy} ) {
+		$ctx->{copy_id} = $ctx->{copy}->id 
+			unless $ctx->{copy_id} or $ctx->{copy_barcode};
+	}
+
+	my $copy;
+
+	if($ctx->{copy_id}) {
+		$copy = $e->retrieve_asset_copy(
+			[$ctx->{copy_id}, $flesh ]) or return $e->event;
+
+	} elsif( $ctx->{copy_barcode} ) {
+
+		$copy = $e->search_asset_copy(
+			[{barcode => $ctx->{copy_barcode}, deleted => 'f'}, $flesh ])->[0]
+			or return $e->event;
+	}
+
+	return undef unless $copy;
+
+	my $vol = $copy->call_number;
+	my $rec = $vol->record;
+	$ctx->{copy} = $copy;
+	$ctx->{volume} = $vol;
+	$copy->call_number($vol->id);
+	$ctx->{title} = $rec;
+	$vol->record($rec->id);
+
+	return undef;
+}
+
+
+
+sub fetch_user_data {
+	my( $e, $ctx ) = @_;
+
+	my $flesh = {
+		flesh => 2,
+		flesh_fields => {
+			au => [ qw/ profile home_ou card / ],
+			aou => [ 'ou_type' ],
+		}
+	};
+
+	if( $ctx->{patron} ) {
+		$ctx->{patron_id} = $ctx->{patron}->id unless $ctx->{patron_id};
+	}
+
+	my $patron;
+	
+	if( $ctx->{patron_id} ) {
+		$patron = $e->retrieve_actor_user([$ctx->{patron_id}, $flesh]);
+
+	} elsif( $ctx->{patron_barcode} ) {
+
+		my $card = $e->search_actor_card( 
+			{ barcode => $ctx->{patron_barcode} } )->[0] or return $e->event;
+
+		$patron = $e->search_actor_user( 
+			[{ card => $card->id }, $flesh ]
+			)->[0] or return $e->event;
+
+	} elsif( $ctx->{fetch_patron_by_circ_copy} ) {
+
+		if( my $copy = $ctx->{copy} ) {
+			my $circs = $e->search_action_circulation(
+				{ target_copy => $copy->id, checkin_time => undef });
+
+			if( my $circ = $circs->[0] ) {
+				$patron = $e->retrieve_actor_user([$circ->usr, $flesh])
+					or return $e->event;
+			}
+		}
+	}
+
+	return undef unless $ctx->{patron} = $patron;
+
+	flatten_groups($e);
+
+	$ctx->{requestor} = $ctx->{requestor} || $e->requestor;
+
+	if( $ctx->{fetch_patron_circ_info} ) {
+		my $circ_counts = $U->storagereq('open-ils.storage.actor.user.checked_out.count', $patron->id);
+
+		$ctx->{patronOverdue} = $circ_counts->{overdue}  + $circ_counts->{long_overdue};
+		my $out = $ctx->{patronOverdue} + $circ_counts->{out};
+
+		$ctx->{patronItemsOut} = $out 
+			unless( $ctx->{patronItemsOut} and $ctx->{patronItemsOut} > $out );
+
+		$logger->debug("script_builder: patron overdue count is " . $ctx->{patronOverdue});
+	}
+
+	if( $ctx->{fetch_patron_money_info} ) {
+		$ctx->{patronFines} = $U->patron_money_owed($patron->id);
+		$logger->debug("script_builder: patron fines determined to be ".$ctx->{patronFines});
+	}
+
+	unless( $ctx->{ignore_user_status} ) {
+		return OpenILS::Event->new('PATRON_INACTIVE')
+			unless $U->is_true($patron->active);
+	
+		return OpenILS::Event->new('PATRON_CARD_INACTIVE')
+			unless $U->is_true($patron->card->active);
+	
+		my $expire = DateTime::Format::ISO8601->new->parse_datetime(
+			cleanse_ISO8601($patron->expire_date));
+	
+		return OpenILS::Event->new('PATRON_ACCOUNT_EXPIRED')
+			if( CORE::time > $expire->epoch ) ;
+	}
+
+	return undef;
+}
+
+
+sub flatten_groups {
+	my $e = shift;
+	my $tree = shift;
+
+	if(!%GROUP_SET) {
+		$GROUP_TREE = $e->search_permission_grp_tree(
+			[
+				{ parent => undef }, 
+				{ 
+				flesh => 100,
+					flesh_fields => { pgt => ['children'] }
+				} 
+			]
+		)->[0];
+		$tree = $GROUP_TREE;
+	}
+
+	return undef unless $tree;
+	$GROUP_SET{$tree->id} = $tree;
+	if( $tree->children ) {
+		flatten_groups($e, $_) for @{$tree->children};
+	}
+}
+
+sub flatten_org_tree {
+	my $tree = shift;
+	return undef unless $tree;
+	push( @ORG_LIST, $tree );
+	if( $tree->children ) {
+		flatten_org_tree($_) for @{$tree->children};
+	}
+}
+
+
+
+sub insert_org_methods {
+	my ( $editor, $runner ) = @_;
+
+	if(!$ORG_TREE) {
+		$ORG_TREE = $editor->search_actor_org_unit(
+			[
+				{"parent_ou" => undef },
+				{
+					flesh				=> -1,
+					flesh_fields	=> { aou =>  ['children'] },
+					order_by			=> { aou => 'name'}
+				}
+			]
+		)->[0];
+		flatten_org_tree($ORG_TREE);
+	}
+
+	my $r = $runner;
+	weaken($r);
+
+	$r->insert(__OILS_FUNC_isOrgDescendent  => 
+		sub {
+			my( $write_key, $sname, $id ) = @_;
+			my ($parent)	= grep { $_->shortname eq $sname } @ORG_LIST;
+			my ($child)		= grep { $_->id == $id } @ORG_LIST;
+			my $val = is_org_descendent( $parent, $child );
+			$logger->debug("script_builder: is_org_desc $sname:$id returned val $val, writing to $write_key");
+			$r->insert($write_key, $val, 1) if $val;
+			return $val;
+		}
+	);
+
+	$r->insert(__OILS_FUNC_hasCommonAncestor  => 
+		sub {
+			my( $write_key, $orgid1, $orgid2, $depth ) = @_;
+			my $val = has_common_ancestor( $orgid1, $orgid2, $depth );
+			$logger->debug("script_builder: has_common_ancestor resturned $val");
+			$r->insert($write_key, $val, 1) if $val;
+			return $val;
+		}
+	);
+}
+
+
+sub is_org_descendent {
+	my( $parent, $child ) = @_;
+	return 0 unless $parent and $child;
+	$logger->debug("script_builder: is_org_desc checking parent=".$parent->id.", child=".$child->id);
+	do {
+		return 0 unless defined $child->parent_ou;
+		return 1 if $parent->id == $child->id;
+	} while( ($child) = grep { $_->id == $child->parent_ou } @ORG_LIST );
+	return 0;
+}
+
+sub has_common_ancestor {
+	my( $org1, $org2, $depth ) = @_;
+	return 0 unless $org1 and $org2;
+	$logger->debug("script_builder: has_common_ancestor checking orgs $org1 : $org2");
+
+	return 1 if $org1 == $org2;
+	($org1) = grep { $_->id == $org1 } @ORG_LIST;
+	($org2) = grep { $_->id == $org2 } @ORG_LIST;
+
+	my $p1 = find_parent_at_depth($org1, $depth);
+	my $p2 = find_parent_at_depth($org2, $depth);
+
+	return 1 if $p1->id == $p2->id;
+	return 0;
+}
+
+
+sub find_parent_at_depth {
+	my $org = shift;
+	my $depth = shift;
+	return undef unless $org and $depth;
+	fetch_ou_types();
+	do {
+		my ($t) = grep { $_->id == $org->ou_type } @OU_TYPES;
+		return $org if $t->depth == $depth;
+	} while( ($org) = grep { $_->id == $org->parent_ou } @ORG_LIST );
+	return undef;	
+}
+
+
+sub fetch_ou_types {
+	return if @OU_TYPES;
+	@OU_TYPES = @{new_editor()->retrieve_all_actor_org_unit_type()};
+}
+
+sub insert_copy_methods {
+	my( $e, $ctx,  $runner ) = @_;
+	my $reqr = $ctx->{requestor} || $e->requestor;
+	if( my $copy = $ctx->{copy} ) {
+		$runner->insert_method( 'environment.copy', '__OILS_FUNC_fetch_best_hold', sub {
+				my $key = shift;
+				$logger->debug("script_builder: searching for permitted hold for copy ".$copy->barcode);
+				my ($hold) = $holdcode->find_nearest_permitted_hold( $e, $copy, $reqr, 1 );  # do we need a new editor here since the xact may be dead??
+				$runner->insert( $key, $hold, 1 );
+			}
+		);
+	}
+}
+
+sub insert_user_funcs {
+   my( $e, $ctx, $runner ) = @_;
+
+   # tells how many holds a user has
+	$runner->insert(__OILS_FUNC_userHoldCount  => 
+		sub {
+			my( $write_key, $userid ) = @_;
+         my $val = $holdcode->__user_hold_count(new_editor(), $userid);
+         $logger->info("script_runner: user hold count is $val");
+			$runner->insert($write_key, $val, 1) if $val;
+			return $val;
+		}
+	);
+
+	$runner->insert(__OILS_FUNC_userCircsByCircmod  => 
+		sub {
+			my( $write_key, $userid ) = @_;
+            use OpenSRF::Utils::JSON;
+
+            # this bug ugly thing generates a count of checkouts by circ_modifier
+             my $query = {
+                "select" => {
+                    "acp" => ["circ_modifier"],
+                    "circ"=>[{
+                        "aggregate"=> OpenSRF::Utils::JSON->true,
+                        "transform"=>"count",
+                        "alias"=>"count",
+                        "column"=>"id"
+                    }],
+                },
+                "from"=>{"acp"=>{"circ"=>{"field"=>"target_copy","fkey"=>"id"}}},
+                "where"=>{
+                    "+circ"=>{
+                        "checkin_time"=>undef,
+                        "usr"=>$userid,
+                        "-or"=>[
+                            {"stop_fines"=>["MAXFINES","LONGOVERDUE"]},
+                            {"stop_fines"=>undef}
+                        ]
+                    }
+                }
+            };
+
+            my $mods = $e->json_query($query);
+            my $breakdown = {};
+            $breakdown->{$_->{circ_modifier}} = $_->{count} for @$mods;
+            $logger->info("script_runner: Loaded checkouts by circ_modifier breakdown:". 
+                OpenSRF::Utils::JSON->perl2JSON($breakdown));
+			$runner->insert($write_key, $breakdown, 1) if (keys %$breakdown);
+		}
+	);
+
+}
+
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/StatCat.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/StatCat.pm
new file mode 100644
index 0000000000..8ca8325755
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/StatCat.pm
@@ -0,0 +1,634 @@
+# ---------------------------------------------------------------
+# Copyright (C) 2006  Georgia Public Library Service 
+# Bill Erickson 
+
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# ---------------------------------------------------------------
+
+package OpenILS::Application::Circ::StatCat;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+use OpenSRF::Utils::Logger qw($logger);
+use OpenSRF::EX qw/:try/;
+use OpenILS::Application::AppUtils;
+my $apputils = "OpenILS::Application::AppUtils";
+my $U = $apputils;
+
+
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_stat_cat_list",
+	argc	=> 1,
+	api_name	=> "open-ils.circ.stat_cat.actor.retrieve.batch");
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_stat_cat_list",
+	argc	=> 1,
+	api_name	=> "open-ils.circ.stat_cat.asset.retrieve.batch");
+
+# retrieves all of the stat cats for a given org unit
+# if no orgid, user_session->home_ou is used
+
+sub retrieve_stat_cat_list {
+	my( $self, $client, $user_session, @sc ) = @_;
+
+	if (ref($sc[0])) {
+		@sc = @{$sc[0]};
+	}
+
+	my $method = "open-ils.storage.fleshed.actor.stat_cat.retrieve.batch.atomic"; 
+	if( $self->api_name =~ /asset/ ) {
+		$method = "open-ils.storage.fleshed.asset.stat_cat.retrieve.batch.atomic"; 
+	}
+
+	my($user_obj, $evt) = $apputils->checkses($user_session); 
+    return $evt if $evt;
+
+	my $cats = $apputils->simple_scalar_request(
+				"open-ils.storage", $method, @sc);
+
+	return [ sort { $a->name cmp $b->name } @$cats ];
+}
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_stat_cats",
+	api_name	=> "open-ils.circ.stat_cat.actor.retrieve.all");
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_stat_cats",
+	api_name	=> "open-ils.circ.stat_cat.asset.retrieve.all");
+
+# retrieves all of the stat cats for a given org unit
+# if no orgid, user_session->home_ou is used
+
+sub retrieve_stat_cats {
+	my( $self, $client, $user_session, $orgid ) = @_;
+
+	my $method = "open-ils.storage.ranged.fleshed.actor.stat_cat.all.atomic"; 
+	if( $self->api_name =~ /asset/ ) {
+		$method = "open-ils.storage.ranged.fleshed.asset.stat_cat.all.atomic"; 
+	}
+
+	my($user_obj, $evt) = $apputils->checkses($user_session); 
+    return $evt if $evt;
+
+	if(!$orgid) { $orgid = $user_obj->home_ou; }
+	my $cats = $apputils->simple_scalar_request(
+				"open-ils.storage", $method, $orgid );
+
+	return [ sort { $a->name cmp $b->name } @$cats ];
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_ranged_intersect_stat_cats",
+	api_name	=> "open-ils.circ.stat_cat.asset.multirange.intersect.retrieve");
+
+sub retrieve_ranged_intersect_stat_cats {
+	my( $self, $client, $user_session, $orglist ) = @_;
+
+	my($user_obj, $evt) = $apputils->checkses($user_session); 
+    return $evt if $evt;
+
+	if(!$orglist) { $orglist = [ $user_obj->home_ou ]; }
+
+	# uniquify, yay!
+	my %hash = map { ($_ => 1) } @$orglist;
+	$orglist = [ keys %hash ];
+
+	warn "range: @$orglist\n";
+
+	my	$method = "open-ils.storage.multiranged.intersect.fleshed.asset.stat_cat.all.atomic";
+	return $apputils->simple_scalar_request(
+				"open-ils.storage", $method, $orglist );
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_ranged_union_stat_cats",
+	api_name	=> "open-ils.circ.stat_cat.asset.multirange.union.retrieve");
+
+sub retrieve_ranged_union_stat_cats {
+	my( $self, $client, $user_session, $orglist ) = @_;
+
+	my	$method = "open-ils.storage.multiranged.union.fleshed.asset.stat_cat.all.atomic";
+	use Data::Dumper;
+	warn "Retrieving stat_cats with method $method and orgs " . Dumper($orglist) . "\n";
+
+	my($user_obj, $evt) = $apputils->checkses($user_session); 
+    return $evt if $evt;
+
+	if(!$orglist) { $orglist = [ $user_obj->home_ou ]; }
+
+	# uniquify, yay!
+	my %hash = map { ($_ => 1) } @$orglist;
+	$orglist = [ keys %hash ];
+
+	warn "range: @$orglist\n";
+
+	return $apputils->simple_scalar_request(
+				"open-ils.storage", $method, $orglist );
+}
+
+
+
+__PACKAGE__->register_method(
+	method	=> "stat_cat_create",
+	api_name	=> "open-ils.circ.stat_cat.asset.create");
+
+__PACKAGE__->register_method(
+	method	=> "stat_cat_create",
+	api_name	=> "open-ils.circ.stat_cat.actor.create");
+
+sub stat_cat_create {
+	my( $self, $client, $user_session, $stat_cat ) = @_;
+
+	my $method = "open-ils.storage.direct.actor.stat_cat.create";
+	my $entry_create = "open-ils.storage.direct.actor.stat_cat_entry.create";
+	my $perm = 'CREATE_PATRON_STAT_CAT';
+	my $eperm = 'CREATE_PATRON_STAT_CAT_ENTRY';
+
+	if($self->api_name =~ /asset/) {
+		$method = "open-ils.storage.direct.asset.stat_cat.create";
+		$entry_create = "open-ils.storage.direct.asset.stat_cat_entry.create";
+		$perm = 'CREATE_COPY_STAT_CAT_ENTRY';
+	}
+
+	#my $user_obj = $apputils->check_user_session($user_session); 
+	#my $orgid = $user_obj->home_ou();
+	my( $user_obj, $evt ) = $apputils->checkses($user_session);
+	return $evt if $evt;
+	$evt = $apputils->check_perms($user_obj->id, $stat_cat->owner, $perm);
+	return $evt if $evt;
+
+	if($stat_cat->entries) {
+		$evt = $apputils->check_perms($user_obj->id, $stat_cat->owner, $eperm);
+		return $evt if $evt;
+	}
+
+
+	my $session = $apputils->start_db_session();
+	my $newid = _create_stat_cat($session, $stat_cat, $method);
+
+	if( ref($stat_cat->entries) ) {
+		for my $entry (@{$stat_cat->entries}) {
+			$entry->stat_cat($newid);
+			_create_stat_entry($session, $entry, $entry_create);
+		}
+	}
+
+	$apputils->commit_db_session($session);
+
+	$logger->debug("Stat cat creation successful with id $newid");
+
+	my $orgid = $user_obj->home_ou;
+	if( $self->api_name =~ /asset/ ) {
+		return _flesh_asset_cat($newid, $orgid);
+	} else {
+		return _flesh_user_cat($newid, $orgid);
+	}
+}
+
+
+sub _flesh_user_cat {
+	my $id = shift;
+	my $orgid = shift;
+
+	my $session = OpenSRF::AppSession->create("open-ils.storage");
+	my $cat = $session->request(
+		"open-ils.storage.direct.actor.stat_cat.retrieve",
+		$id )->gather(1);
+
+	$cat->entries( 
+		$session->request(
+			"open-ils.storage.ranged.actor.stat_cat_entry.search.stat_cat.atomic",
+			$orgid, $id )->gather(1) );
+
+	return $cat;
+}
+
+
+sub _flesh_asset_cat {
+	my $id = shift;
+	my $orgid = shift;
+
+	my $session = OpenSRF::AppSession->create("open-ils.storage");
+	my $cat = $session->request(
+		"open-ils.storage.direct.asset.stat_cat.retrieve",
+		$id )->gather(1);
+
+	$cat->entries( 
+		$session->request(
+			"open-ils.storage.ranged.asset.stat_cat_entry.search.stat_cat.atomic",
+			$orgid,  $id )->gather(1) );
+
+	return $cat;
+
+}
+
+
+sub _create_stat_cat {
+	my( $session, $stat_cat, $method) = @_;
+	warn "Creating new stat cat with name " . $stat_cat->name . "\n";
+	$stat_cat->clear_id();
+	my $req = $session->request( $method, $stat_cat );
+	my $id = $req->gather(1);
+	if(!$id) {
+		throw OpenSRF::EX::ERROR 
+		("Error creating new statistical category"); }
+
+	warn "Stat cat create returned id $id\n";
+	return $id;
+}
+
+
+sub _create_stat_entry {
+	my( $session, $stat_entry, $method) = @_;
+
+	warn "Creating new stat entry with value " . $stat_entry->value . "\n";
+	$stat_entry->clear_id();
+
+	my $req = $session->request($method, $stat_entry);
+	my $id = $req->gather(1);
+
+	warn "Stat entry " . Dumper($stat_entry) . "\n";	
+	
+	if(!$id) {
+		throw OpenSRF::EX::ERROR 
+		("Error creating new stat cat entry"); }
+
+	warn "Stat cat entry create returned id $id\n";
+	return $id;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "update_stat_entry",
+	api_name	=> "open-ils.circ.stat_cat.actor.entry.update");
+
+__PACKAGE__->register_method(
+	method	=> "update_stat_entry",
+	api_name	=> "open-ils.circ.stat_cat.asset.entry.update");
+
+sub update_stat_entry {
+	my( $self, $client, $user_session, $entry ) = @_;
+
+
+	my $method = "open-ils.storage.direct.actor.stat_cat_entry.update";
+	my $perm = 'UPDATE_PATRON_STAT_CAT_ENTRY';
+	if($self->api_name =~ /asset/) {
+		$method = "open-ils.storage.direct.asset.stat_cat_entry.update";
+		$perm = 'UPDATE_COPY_STAT_CAT_ENTRY';
+	}
+
+	my( $user_obj, $evt )  = $apputils->checkses($user_session); 
+	return $evt if $evt;
+	$evt = $apputils->check_perms( $user_obj->id, $entry->owner, $perm );
+	return $evt if $evt;
+
+	my $session = $apputils->start_db_session();
+	my $req = $session->request($method, $entry); 
+	my $status = $req->gather(1);
+	$apputils->commit_db_session($session);
+	warn "stat cat entry with value " . $entry->value . " updated with status $status\n";
+	return 1;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "update_stat",
+	api_name	=> "open-ils.circ.stat_cat.actor.update");
+
+__PACKAGE__->register_method(
+	method	=> "update_stat",
+	api_name	=> "open-ils.circ.stat_cat.asset.update");
+
+sub update_stat {
+	my( $self, $client, $user_session, $cat ) = @_;
+
+	my $method = "open-ils.storage.direct.actor.stat_cat.update";
+	my $perm = 'UPDATE_PATRON_STAT_CAT';
+	if($self->api_name =~ /asset/) {
+		$method = "open-ils.storage.direct.asset.stat_cat.update";
+		$perm = 'UPDATE_COPY_STAT_CAT';
+	}
+
+	my( $user_obj, $evt )  = $apputils->checkses($user_session); 
+	return $evt if $evt;
+	$evt = $apputils->check_perms( $user_obj->id, $cat->owner, $perm );
+	return $evt if $evt;
+
+	my $session = $apputils->start_db_session();
+	my $req = $session->request($method, $cat); 
+	my $status = $req->gather(1);
+	$apputils->commit_db_session($session);
+	warn "stat cat with id " . $cat->id . " updated with status $status\n";
+	return 1;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "create_stat_entry",
+	api_name	=> "open-ils.circ.stat_cat.actor.entry.create");
+
+__PACKAGE__->register_method(
+	method	=> "create_stat_entry",
+	api_name	=> "open-ils.circ.stat_cat.asset.entry.create");
+
+sub create_stat_entry {
+	my( $self, $client, $user_session, $entry ) = @_;
+
+	my $method = "open-ils.storage.direct.actor.stat_cat_entry.create";
+	my $perm = 'CREATE_PATRON_STAT_CAT_ENTRY';
+	if($self->api_name =~ /asset/) {
+		$method = "open-ils.storage.direct.asset.stat_cat_entry.create";
+		$perm = 'CREATE_COPY_STAT_CAT_ENTRY';
+	}
+
+	my( $user_obj, $evt )  = $apputils->checkses($user_session); 
+	return $evt if $evt;
+	$evt = $apputils->check_perms( $user_obj->id, $entry->owner, $perm );
+	return $evt if $evt;
+
+	$entry->clear_id();
+	my $session = $apputils->start_db_session();
+	my $req = $session->request($method, $entry); 
+	my $status = $req->gather(1);
+	$apputils->commit_db_session($session);
+
+	$logger->info("created stat cat entry $status");
+	return $status;
+}
+
+
+
+__PACKAGE__->register_method(
+	method	=> "create_stat_map",
+	api_name	=> "open-ils.circ.stat_cat.actor.user_map.create");
+
+__PACKAGE__->register_method(
+	method	=> "create_stat_map",
+	api_name	=> "open-ils.circ.stat_cat.asset.copy_map.create");
+
+sub create_stat_map {
+	my( $self, $client, $user_session, $map ) = @_;
+
+
+	my ( $evt, $copy, $volume, $patron, $user_obj );
+
+	my $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.create";
+	my $ret = "open-ils.storage.direct.actor.stat_cat_entry_user_map.retrieve";
+	my $perm = 'CREATE_PATRON_STAT_CAT_ENTRY_MAP';
+	my $perm_org;
+
+	if($self->api_name =~ /asset/) {
+		$method = "open-ils.storage.direct.asset.stat_cat_entry_copy_map.create";
+		$ret = "open-ils.storage.direct.asset.stat_cat_entry_copy_map.retrieve";
+		$perm = 'CREATE_COPY_STAT_CAT_ENTRY_MAP';
+		( $copy, $evt ) = $apputils->fetch_copy($map->owning_copy);
+		return $evt if $evt;
+		( $volume, $evt ) = $apputils->fetch_callnumber($copy->call_number);
+		return $evt if $evt;
+		$perm_org = $volume->owning_lib;
+
+	} else {
+		($patron, $evt) = $apputils->fetch_user($map->target_usr);
+		return $evt if $evt;
+		$perm_org = $patron->home_ou;
+	}
+
+	( $user_obj, $evt )  = $apputils->checkses($user_session); 
+	return $evt if $evt;
+	$evt = $apputils->check_perms( $user_obj->id, $perm_org, $perm );
+	return $evt if $evt;
+
+	$logger->debug( $user_obj->id . " creating new stat cat map" );
+
+	$map->clear_id();
+
+	my $session = $apputils->start_db_session();
+	my $req = $session->request($method, $map); 
+	my $newid = $req->gather(1);
+	warn "Created new stat cat map with id $newid\n";
+	$apputils->commit_db_session($session);
+
+	return $apputils->simple_scalar_request( "open-ils.storage", $ret, $newid );
+
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "update_stat_map",
+	api_name	=> "open-ils.circ.stat_cat.actor.user_map.update");
+
+__PACKAGE__->register_method(
+	method	=> "update_stat_map",
+	api_name	=> "open-ils.circ.stat_cat.asset.copy_map.update");
+
+sub update_stat_map {
+	my( $self, $client, $user_session, $map ) = @_;
+
+	my ( $evt, $copy, $volume, $patron, $user_obj );
+
+	my $method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.update";
+	my $perm = 'UPDATE_PATRON_STAT_ENTRY_MAP';
+	my $perm_org;
+
+	if($self->api_name =~ /asset/) {
+		$method = "open-ils.storage.direct.asset.stat_cat_entry_copy_map.update";
+		$perm = 'UPDATE_COPY_STAT_ENTRY_MAP';
+		( $copy, $evt ) = $apputils->fetch_copy($map->owning_copy);
+		return $evt if $evt;
+		( $volume, $evt ) = $apputils->fetch_callnumber($copy->call_number);
+		return $evt if $evt;
+		$perm_org = $volume->owning_lib;
+
+	} else {
+		($patron, $evt) = $apputils->fetch_user($map->target_usr);
+		return $evt if $evt;
+		$perm_org = $patron->home_ou;
+	}
+
+
+	( $user_obj, $evt )  = $apputils->checkses($user_session); 
+	return $evt if $evt;
+	$evt = $apputils->check_perms( $user_obj->id, $perm_org, $perm );
+	return $evt if $evt;
+
+
+	my $session = $apputils->start_db_session();
+	my $req = $session->request($method, $map); 
+	my $newid = $req->gather(1);
+	warn "Updated new stat cat map with id $newid\n";
+	$apputils->commit_db_session($session);
+
+	return $newid;
+}
+
+
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_maps",
+	api_name	=> "open-ils.circ.stat_cat.actor.user_map.retrieve");
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_maps",
+	api_name	=> "open-ils.circ.stat_cat.asset.copy_map.retrieve");
+
+sub retrieve_maps {
+	my( $self, $client, $user_session, $target ) = @_;
+
+
+	my( $user_obj, $evt ) = $apputils->checkses($user_session); 
+	return $evt if $evt;
+
+	my	$method = "open-ils.storage.direct.asset.stat_cat_entry_copy_map.search.owning_copy.atomic";
+	if($self->api_name =~ /actor/ ) {
+		if(!$target) { $target = $user_obj->id; }
+		$method = "open-ils.storage.direct.actor.stat_cat_entry_user_map.search.target_usr.atomic";
+	}
+
+	return $apputils->simple_scalar_request("open-ils.storage", $method, $target);
+}
+
+
+
+
+__PACKAGE__->register_method(
+	method	=> "delete_stats",
+	api_name	=> "open-ils.circ.stat_cat.actor.delete");
+
+__PACKAGE__->register_method(
+	method	=> "delete_stats",
+	api_name	=> "open-ils.circ.stat_cat.asset.delete");
+
+sub delete_stats {
+	my( $self, $client, $user_session, $target ) = @_;
+	
+	my $cat;
+
+	my $type = "actor";
+	my $perm = 'DELETE_PATRON_STAT_CAT';
+	if($self->api_name =~ /asset/) { 
+		$type = "asset"; 
+		$perm = 'DELETE_COPY_STAT_CAT';
+	}
+
+	my( $user_obj, $evt )  = $apputils->checkses($user_session); 
+	return $evt if $evt;
+
+	( $cat, $evt ) = $apputils->fetch_stat_cat( $type, $target );
+	return $evt if $evt;
+
+	$evt = $apputils->check_perms( $user_obj->id, $cat->owner, $perm );
+	return $evt if $evt;
+
+	my $session = OpenSRF::AppSession->create("open-ils.storage");
+	return _delete_stats($session, $target, $type);
+}
+
+sub _delete_stats {
+	my( $session, $stat, $type) = @_;
+
+	my	$method = "open-ils.storage.direct.asset.stat_cat.delete";
+	if($type =~ /actor/ ) {
+		$method = "open-ils.storage.direct.actor.stat_cat.delete";
+	}
+	return $session->request($method, $stat)->gather(1);
+}
+
+
+
+__PACKAGE__->register_method(
+	method	=> "delete_entry",
+	api_name	=> "open-ils.circ.stat_cat.actor.entry.delete");
+
+__PACKAGE__->register_method(
+	method	=> "delete_entry",
+	api_name	=> "open-ils.circ.stat_cat.asset.entry.delete");
+
+sub delete_entry {
+	my( $self, $client, $user_session, $target ) = @_;
+
+	my $type = "actor";
+	my $perm = 'DELETE_PATRON_STAT_CAT_ENTRY';
+	if($self->api_name =~ /asset/) { 
+		$type = "asset"; 
+		$perm = 'DELETE_COPY_STAT_CAT_ENTRY';
+	}
+
+	my $entry;
+	my( $user_obj, $evt )  = $apputils->checkses($user_session); 
+	return $evt if $evt;
+
+	( $entry, $evt ) = $apputils->fetch_stat_cat_entry( $type, $target );
+	return $evt if $evt;
+
+	$evt = $apputils->check_perms( $user_obj->id, $entry->owner, $perm );
+	return $evt if $evt;
+
+	my $session = OpenSRF::AppSession->create("open-ils.storage");
+	return _delete_entry($session, $target, $type);
+}
+
+sub _delete_entry {
+	my( $session, $stat_entry, $type) = @_;
+
+	my	$method = "open-ils.storage.direct.asset.stat_cat_entry.delete";
+	if($type =~ /actor/ ) {
+		$method = "open-ils.storage.direct.actor.stat_cat_entry.delete";
+	}
+
+	return $session->request($method, $stat_entry)->gather(1);
+}
+
+
+__PACKAGE__->register_method(
+	method => 'fetch_stats_by_copy',
+	api_name	=> 'open-ils.circ.asset.stat_cat_entries.fleshed.retrieve_by_copy',
+);
+
+
+sub fetch_stats_by_copy {
+	my( $self, $conn, $args ) = @_;
+
+	my @entries;
+
+	if( $$args{public} ) {
+		my $maps = $U->cstorereq(
+			'open-ils.cstore.direct.asset.stat_cat_entry_copy_map.search.atomic', { owning_copy => $$args{copyid} });
+
+
+		warn "here\n";
+		for my $map (@$maps) {
+
+			warn "map ".$map->id."\n";
+			warn "map ".$map->stat_cat_entry."\n";
+
+			my $entry = $U->cstorereq(
+				'open-ils.cstore.direct.asset.stat_cat_entry.retrieve', $map->stat_cat_entry);
+
+			warn "Found entry ".$entry->id."\n";
+
+			my $cat = $U->cstorereq(
+				'open-ils.cstore.direct.asset.stat_cat.retrieve', $entry->stat_cat );
+			$entry->stat_cat( $cat );
+			push( @entries, $entry );
+		}
+	}
+
+	return \@entries;
+}
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Survey.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Survey.pm
new file mode 100644
index 0000000000..9f75be3ddf
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Survey.pm
@@ -0,0 +1,424 @@
+# ---------------------------------------------------------------
+# Copyright (C) 2005  Georgia Public Library Service 
+# Bill Erickson 
+
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# ---------------------------------------------------------------
+
+package OpenILS::Application::Circ::Survey;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+use OpenSRF::EX qw/:try/;
+use OpenILS::Application::AppUtils;
+use Data::Dumper;
+use OpenILS::Event;
+use Time::HiRes qw(time);
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+
+my $apputils = "OpenILS::Application::AppUtils";
+
+# - creates a new survey
+# expects a survey complete with questions and answers
+__PACKAGE__->register_method(
+	method	=> "add_survey",
+	api_name	=> "open-ils.circ.survey.create");
+
+sub add_survey {
+	my( $self, $client, $user_session, $survey ) = @_;
+
+	my($user_obj, $evt) = $apputils->checkses($user_session); 
+    return $evt if $evt;
+
+	my $session = $apputils->start_db_session();
+	my $err = undef; my $id;
+
+
+	try {
+
+		$survey = _add_survey($session, $survey);
+		_add_questions($session, $survey);
+		$apputils->commit_db_session($session);
+
+	} catch Error with {
+		my $e = shift;
+		$err = "Error creating survey: $e\n";
+		$apputils->rollback_db_session($session);
+	};
+
+	if($err) { throw OpenSRF::EX::ERROR ($err); }
+
+	# re-retrieve the survey from the db and return it
+	return get_fleshed_survey($self, $client, $survey->id() );
+}
+
+
+sub _add_survey {
+	my($session, $survey) = @_;
+	my $req = $session->request(
+		"open-ils.storage.direct.action.survey.create",
+		$survey );
+
+	my $id = $req->gather(1);
+
+	if(!$id) { 
+		throw OpenSRF::EX::ERROR 
+			("Unable to create new survey " . $survey->name()); 
+	}
+
+	$survey->id($id);
+	return $survey;
+}
+
+sub _update_survey {
+	my($session, $survey) = @_;
+}
+
+sub _add_questions {
+	my($session, $survey) = @_;
+
+	# create new questions in the db
+	if( $survey->questions() ) {
+		for my $question (@{$survey->questions()}){
+	
+			$question->survey($survey->id());
+			my $virtual_id = $question->id();
+			$question->clear_id();
+
+	
+			my $req = $session->request(
+				'open-ils.storage.direct.action.survey_question.create',
+				$question );
+			my $new_id = $req->gather(1);
+	
+			if(!$new_id) {
+				throw OpenSRF::EX::ERROR
+					("Error creating new survey question " . $question->question() . "\n")
+			}
+	
+			# now update the responses to this question
+			if($question->answers()) {
+				for my $answer (@{$question->answers()}) {
+					$answer->question($new_id);
+					_add_answer($session,$answer);
+				}
+			}
+		}
+	}
+}
+
+
+sub _add_answer {
+	my($session, $answer) = @_;
+	$answer->clear_id();
+	my $req = $session->request(
+		"open-ils.storage.direct.action.survey_answer.create",
+		$answer );
+	my $id = $req->gather(1);
+	if(!$id) {
+		throw OpenSRF::EX::ERROR
+			("Error creating survey answer " . $answer->answer() );
+	}
+
+}
+
+
+
+# retrieve surveys for a specific org subtree.
+__PACKAGE__->register_method(
+	method	=> "get_required_surveys",
+	api_name	=> "open-ils.circ.survey.retrieve.required");
+
+sub get_required_surveys {
+	my( $self, $client, $user_session ) = @_;
+	
+
+	my ($user_obj, $evt) = $apputils->checkses($user_session); 
+    return $evt if $evt;
+
+	my $orgid = $user_obj->ws_ou() ? $user_obj->ws_ou() : $user_obj->home_ou();
+	my $surveys = $apputils->simple_scalar_request(
+		"open-ils.storage",
+		"open-ils.storage.action.survey.required.atomic",
+		$orgid );
+
+	my @fleshed;
+	for my $survey (@$surveys) {
+		push(@fleshed, get_fleshed_survey($self, $client, $survey));
+	}
+	return \@fleshed;
+
+}
+
+__PACKAGE__->register_method(
+	method	=> "get_survey_responses",
+	api_name	=> "open-ils.circ.survey.response.retrieve");
+
+sub get_survey_responses {
+	my( $self, $client, $user_session, $survey_id, $user_id ) = @_;
+	
+	if(!$user_id) {
+	    my ($user_obj, $evt) = $apputils->checkses($user_session); 
+        return $evt if $evt;
+		$user_id = $user_obj->id;
+	}
+
+	my $res = $apputils->simple_scalar_request(
+		"open-ils.cstore",
+		"open-ils.cstore.direct.action.survey_response.search.atomic",
+		{ usr => $user_id, survey => $survey_id } );
+
+	if( $res && ref($res) and $res->[0]) {
+		return [ sort { $a->id() <=> $b->id() } @$res ];
+	} 
+
+	return [];
+}
+
+__PACKAGE__->register_method(
+	method	=> "get_all_surveys",
+	api_name	=> "open-ils.circ.survey.retrieve.all");
+
+sub get_all_surveys {
+	my( $self, $client, $user_session ) = @_;
+	
+    my ($user_obj, $evt) = $apputils->checkses($user_session); 
+    return $evt if $evt;
+
+	my $orgid = $user_obj->ws_ou() ? $user_obj->ws_ou() : $user_obj->home_ou();
+	my $surveys = $apputils->simple_scalar_request(
+		"open-ils.storage",
+		"open-ils.storage.action.survey.all.atomic",
+		$orgid );
+
+	my @fleshed;
+	for my $survey (@$surveys) {
+		push(@fleshed, get_fleshed_survey($self, $client, $survey));
+	}
+	return \@fleshed;
+}
+
+
+
+
+__PACKAGE__->register_method(
+	method	=> "get_fleshed_survey",
+	api_name	=> "open-ils.circ.survey.fleshed.retrieve");
+
+sub get_fleshed_survey {
+	my( $self, $client, $survey_id ) = @_;
+
+	my $session = OpenSRF::AppSession->create("open-ils.storage");
+
+	my $survey;
+	if( ref($survey_id) and 
+			(ref($survey_id) =~ /^Fieldmapper/)) {
+		$survey = $survey_id;
+
+	} else {
+
+		my $sreq = $session->request(
+			"open-ils.storage.direct.action.survey.retrieve",
+			$survey_id );
+		$survey = $sreq->gather(1);
+		if(! $survey) { return undef; }
+	}
+
+	$survey->questions([]);
+	
+
+	my $qreq = $session->request(
+		"open-ils.storage.direct.action.survey_question.search.survey.atomic", 
+		$survey->id() );
+
+	my $questions = $qreq->gather(1); 
+
+	if($questions) {
+
+		for my $question (@$questions) {
+			next unless defined $question;
+	
+			# add this question to the survey
+			push( @{$survey->questions()}, $question );
+	
+
+			my $ans_req = $session->request(
+				"open-ils.storage.direct.action.survey_answer.search.question.atomic",
+				$question->id() );
+	
+			# add this array of answers to this question
+			$question->answers( $ans_req->gather(1) );
+	
+		}
+	}
+
+	$session->disconnect();
+	return $survey;
+
+}
+
+
+
+__PACKAGE__->register_method(
+	method	=> "submit_survey",
+	api_name	=> "open-ils.circ.survey.submit.session");
+
+__PACKAGE__->register_method(
+	method	=> "submit_survey",
+	api_name	=> "open-ils.circ.survey.submit.user_id");
+
+__PACKAGE__->register_method(
+	method	=> "submit_survey",
+	api_name	=> "open-ils.circ.survey.submit.anon");
+
+
+sub submit_survey {
+	my( $self, $client, $responses ) = @_;
+
+	if(!$responses) {
+		throw OpenSRF::EX::ERROR 
+			("No survey object sent in update");
+	}
+
+
+	if(!ref($responses)) { $responses = [$responses]; }
+
+	my $session = $apputils->start_db_session();
+
+	my $group_id = $session->request(
+		"open-ils.storage.action.survey_response.next_group_id")->gather(1);
+
+	my %already_seen;
+	for my $res (@$responses) {
+
+		my $id; 
+
+		if($self->api_name =~ /session/) {
+			if( ! ($id = $already_seen{$res->usr}) ) {
+                my ($user_obj, $evt) = $apputils->checkses($res->usr);
+                return $evt if $evt;
+				$id = $user_obj->id;
+				$already_seen{$res->usr} = $id;
+			}
+			$res->usr($id);
+		} elsif( $self->api_name =~ /anon/ ) {
+			$res->clear_usr();
+		}
+		
+		$res->response_group_id($group_id);
+		my $req = $session->request(
+			"open-ils.storage.direct.action.survey_response.create",
+			$res );
+		my $newid = $req->gather(1);
+
+		if(!$newid) {
+			throw OpenSRF::EX::ERROR
+				("Error creating new survey response");
+		}
+	}
+
+	$apputils->commit_db_session($session);
+
+	return 1;
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "get_random_survey",
+	api_name	=> "open-ils.circ.survey.retrieve.opac.random");
+
+sub get_random_survey {
+	my( $self, $client, $user_session ) = @_;
+	
+    my ($user_obj, $evt) = $apputils->checkses($user_session); 
+    return $evt if $evt;
+
+	my $surveys = $apputils->simple_scalar_request(
+		"open-ils.storage",
+		"open-ils.storage.action.survey.opac.atomic",
+		$user_obj->home_ou() );
+
+	my $random = int(rand(scalar(@$surveys)));
+	my $surv = $surveys->[$random];
+
+	return get_fleshed_survey($self, $client, $surv);
+
+}
+
+__PACKAGE__->register_method(
+	method	=> "get_random_survey_global",
+	api_name	=> "open-ils.circ.survey.retrieve.opac.random.global");
+
+sub get_random_survey_global {
+	my( $self, $client ) = @_;
+	
+	my $surveys = $apputils->simple_scalar_request(
+		"open-ils.storage",
+		"open-ils.storage.direct.action.survey.search.atomic",
+		# XXX grab the org tree to get the root id...
+		{ owner => 1, opac => 't' } );
+
+	my $random = int(rand(scalar(@$surveys)));
+	my $surv = $surveys->[$random];
+
+	return get_fleshed_survey($self, $client, $surv);
+
+}
+
+
+__PACKAGE__->register_method (
+	method		=> 'delete_survey',
+	api_name	=> 'open-ils.circ.survey.delete.cascade'
+);
+__PACKAGE__->register_method (
+	method		=> 'delete_survey',
+	api_name	=> 'open-ils.circ.survey.delete.cascade.override'
+);
+
+sub delete_survey {
+    my($self, $conn, $auth, $survey_id) = @_;
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+
+    my $survey = $e->retrieve_action_survey($survey_id) 
+        or return $e->die_event;
+    return $e->die_event unless $e->allowed('ADMIN_SURVEY', $survey->owner);
+
+    my $questions = $e->search_action_survey_question({survey => $survey_id});
+    my @answers;
+    push(@answers, @{$e->search_action_survey_answer({question => $_->id})}) for @$questions;
+    my $responses = $e->search_action_survey_response({survey => $survey_id});
+
+    return OpenILS::Event->new('SURVEY_RESPONSES_EXIST')
+        if @$responses and $self->api_name =! /override/;
+
+    for my $resp (@$responses) {
+        $e->delete_action_survey_response($resp) or return $e->die_event;
+    }
+
+    for my $ans (@answers) {
+        $e->delete_action_survey_answer($ans) or return $e->die_event;
+    }
+
+    for my $quest (@$questions) {
+        $e->delete_action_survey_question($quest) or return $e->die_event;
+    }
+
+    $e->delete_action_survey($survey) or return $e->die_event;
+
+    $e->commit;
+    return 1;
+}
+
+
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Transit.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Transit.pm
new file mode 100644
index 0000000000..aa3d0448ca
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Transit.pm
@@ -0,0 +1,377 @@
+package OpenILS::Application::Circ::Transit;
+use base 'OpenILS::Application';
+use strict; use warnings;
+use OpenSRF::EX qw(:try);
+use Data::Dumper;
+use OpenSRF::Utils;
+use OpenSRF::Utils::Cache;
+use Digest::MD5 qw(md5_hex);
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenILS::Application::AppUtils;
+use OpenILS::Application::Circ::Holds;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenSRF::AppSession;
+use OpenILS::Const qw/:const/;
+
+my $U							= "OpenILS::Application::AppUtils";
+my $holdcode				= "OpenILS::Application::Circ::Holds";
+$Data::Dumper::Indent	= 0;
+
+
+
+__PACKAGE__->register_method(
+	method	=> "copy_transit_receive",
+	api_name	=> "open-ils.circ.copy_transit.receive",
+	notes		=> q/
+		Closes out a copy transit
+		Requestor needs the COPY_TRANSIT_RECEIVE permission
+		@param authtoken The login session key
+		@param params An object of named params including
+			copyid - the id of the copy in quest
+			barcode - the barcode of the copy in question 
+				If copyid is not sent, this is used.
+		@return A ROUTE_ITEM if the copy is destined for a different location.
+			A SUCCESS event on success. Other events on error.
+	/);
+
+sub copy_transit_receive {
+	my( $self, $client, $authtoken, $params ) = @_;
+	my %params = %$params;
+	my( $evt, $copy, $requestor );
+	($requestor, $evt) = $U->checksesperm($authtoken, 'COPY_TRANSIT_RECEIVE');
+	return $evt if $evt;
+	($copy, $evt) = $U->fetch_copy($params{copyid});
+	($copy, $evt) = $U->fetch_copy_by_barcode($params{barcode}) unless $copy;
+	return $evt if $evt;
+	my $session = $U->start_db_session();
+	$evt = transit_receive( $self, $copy, $requestor, $session );
+	$U->commit_db_session($session) if $U->event_equals($evt,'SUCCESS');
+	return $evt;
+}
+
+# ------------------------------------------------------------------------------
+# If the transit destination is different than the requestor's lib,
+# a ROUTE_TO event is returned with the org set.
+# If 
+# ------------------------------------------------------------------------------
+sub transit_receive {
+	my ( $class, $copy, $requestor, $session ) = @_;
+	$U->logmark;
+
+	my( $transit, $evt );
+	my $copyid = $copy->id;
+
+	my $status_name = $U->copy_status_to_name($copy->status);
+	$logger->debug("Attempting transit receive on copy $copyid. Copy status is $status_name");
+
+	# fetch the transit
+	($transit, $evt) = $U->fetch_open_transit_by_copy($copyid);
+	return $evt if $evt;
+
+	if( $transit->dest != $requestor->home_ou ) {
+		$logger->activity("Fowarding transit on copy which is destined ".
+			"for a different location. copy=$copyid,current ".
+			"location=".$requestor->home_ou.",destination location=".$transit->dest);
+
+		return OpenILS::Event->new('ROUTE_ITEM', org => $transit->dest );
+	}
+
+	# The transit is received, set the receive time
+	$transit->dest_recv_time('now');
+	my $r = $session->request(
+		'open-ils.storage.direct.action.transit_copy.update', $transit )->gather(1);
+	return $U->DB_UPDATE_FAILED($transit) unless $r;
+
+	my $ishold	= 0;
+	my ($ht)		= $U->fetch_hold_transit( $transit->id );
+	if($ht) {
+		$logger->info("Hold transit found in transit receive...");
+		$ishold	= 1;
+	}
+
+	$logger->info("Recovering original copy status in transit: ".$transit->copy_status);
+	$copy->status( $transit->copy_status );
+	return $evt if ( $evt = 
+		$U->update_copy( copy => $copy, editor => $requestor->id, session => $session ));
+
+	return OpenILS::Event->new('SUCCESS', ishold => $ishold, 
+		payload => { transit => $transit, holdtransit => $ht } );
+}
+
+
+
+
+
+__PACKAGE__->register_method(
+	method	=> "copy_transit_create",
+	api_name	=> "open-ils.circ.copy_transit.create",
+	notes		=> q/
+		Creates a new copy transit.  Requestor must have the 
+		CREATE_COPY_TRANSIT permission.
+		@param authtoken The login session key
+		@param params A param object containing the following keys:
+			copyid		- the copy id
+			destination	- the id of the org destination.  If not defined,
+				defaults to the copy's circ_lib
+		@return SUCCESS event on success, other event on error
+	/);
+
+sub copy_transit_create {
+
+	my( $self, $client, $authtoken, $params ) = @_;
+	my %params = %$params;
+
+	my( $requestor, $evt ) = 
+		$U->checksesperm( $authtoken, 'CREATE_COPY_TRANSIT' );
+	return $evt if $evt;
+
+	my $copy;
+	($copy,$evt) = $U->fetch_copy($params{copyid});
+	return $evt if $evt;
+
+	my $session		= $params{session} || $U->start_db_session();
+	my $source		= $requestor->home_ou;
+	my $dest			= $params{destination} || $copy->circ_lib;
+	my $transit		= Fieldmapper::action::transit_copy->new;
+
+	$logger->activity("User ". $requestor->id ." creating a ".
+		" new copy transit for copy ".$copy->id." to org $dest");
+
+	$transit->source($source);
+	$transit->dest($dest);
+	$transit->target_copy($copy->id);
+	$transit->source_send_time("now");
+	$transit->copy_status($copy->status);
+	
+	$logger->debug("Creating new copy_transit in DB");
+
+	my $s = $session->request(
+		"open-ils.storage.direct.action.transit_copy.create", $transit )->gather(1);
+	return $U->DB_UPDATE_FAILED($transit) unless $s;
+	
+	my $stat = $U->copy_status_from_name('in transit');
+
+	$copy->status($stat->id); 
+	return $evt if ($evt = $U->update_copy(
+		copy => $copy, editor => $requestor->id, session => $session ));
+
+	$U->commit_db_session($session) unless $params{session};
+
+	return OpenILS::Event->new('SUCCESS', 
+		payload => { copy => $copy, transit => $transit } );
+}
+
+
+__PACKAGE__->register_method(
+	method => 'abort_transit',
+	api_name	=> 'open-ils.circ.transit.abort',
+	signature	=> q/
+		Deletes a cleans up a transit
+	/
+);
+
+sub abort_transit {
+	my( $self, $conn, $authtoken, $params ) = @_;
+
+	my $copyid		= $$params{copyid};
+	my $barcode		= $$params{barcode};
+	my $transitid	= $$params{transitid};
+
+	my $copy;
+	my $transit;
+	my $evt;
+
+	my $e = new_editor(xact => 1, authtoken => $authtoken);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('ABORT_TRANSIT');
+
+	# ---------------------------------------------------------------------
+	# Find the related copy and/or transit based on whatever data we have
+	if( $barcode ) {
+		$copy = $e->search_asset_copy({barcode=>$barcode, deleted => 'f'})->[0];
+		return $e->event unless $copy;
+
+	} elsif( $copyid ) {
+		$copy = $e->retrieve_asset_copy($copyid) or return $e->event;
+	}
+
+	if( $transitid ) {
+		$transit = $e->retrieve_action_transit_copy($transitid)
+			or return $e->event;
+
+	} elsif( $copy ) {
+
+		$transit = $e->search_action_transit_copy(
+			{ target_copy => $copy->id, dest_recv_time => undef })->[0];
+		return $e->event unless $transit;
+	}
+
+	if($transit and !$copy) {
+		$copy = $e->retrieve_asset_copy($transit->target_copy)
+			or return $e->event;
+	}
+	# ---------------------------------------------------------------------
+
+	return __abort_transit( $e, $transit, $copy );
+}
+
+
+
+sub __abort_transit {
+
+	my( $e, $transit, $copy, $no_reset_hold ) = @_;
+
+	my $evt;
+	my $hold;
+
+	if( $transit->copy_status == OILS_COPY_STATUS_LOST or
+		$transit->copy_status == OILS_COPY_STATUS_MISSING ) {
+		$e->rollback;
+		return OpenILS::Event->new('TRANSIT_ABORT_NOT_ALLOWED');
+	}
+
+
+	if( $transit->dest != $e->requestor->ws_ou 
+		and $transit->source != $e->requestor->ws_ou ) {
+		return $e->event unless $e->allowed('ABORT_REMOTE_TRANSIT', $e->requestor->ws_ou);
+	}
+
+	# recover the copy status
+	$copy->status( $transit->copy_status );
+	$copy->editor( $e->requestor->id );
+	$copy->edit_date('now');
+
+	my $holdtransit = $e->retrieve_action_hold_transit_copy($transit->id);
+
+	if( $holdtransit ) {
+		$logger->info("setting copy to reshelving on hold transit abort");
+		$copy->status( OILS_COPY_STATUS_RESHELVING );
+	}
+
+	return $e->event unless $e->delete_action_transit_copy($transit);
+	return $e->event unless $e->update_asset_copy($copy);
+
+	$e->commit;
+
+	# if this is a hold transit, un-capture/un-target the hold
+	if($holdtransit and !$no_reset_hold) {
+		$hold = $e->retrieve_action_hold_request($holdtransit->hold)
+			or return $e->event;
+		$evt = $holdcode->_reset_hold( $e->requestor, $hold );
+		return $evt if $evt;
+	}
+
+	return 1;
+}
+
+
+__PACKAGE__->register_method(
+	method		=> 'get_open_copy_transit',
+	api_name		=> 'open-ils.circ.open_copy_transit.retrieve',
+	signature	=> q/
+		Retrieves the open transit object for a given copy
+		@param auth The login session key
+		@param copyid The id of the copy
+		@return Transit object
+ /
+);
+
+sub get_open_copy_transit {
+	my( $self, $conn, $auth, $copyid ) = @_;	
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('VIEW_USER'); # XXX rely on editor perms
+	my $t = $e->search_action_transit_copy(
+		{ target_copy => $copyid, dest_recv_time => undef });
+	return $e->event unless @$t;
+	return $$t[0];
+}
+
+
+
+__PACKAGE__->register_method(
+	method => 'fetch_transit_by_copy',
+	api_name => 'open-ils.circ.fetch_transit_by_copy',
+);
+
+sub fetch_transit_by_copy {
+	my( $self, $conn, $auth, $copyid ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	my $t = $e->search_action_transit_copy(
+		{
+			target_copy => $copyid,
+			dest_recv_time => undef
+		}
+	)->[0];
+	return $e->event unless $t;
+	my $ht = $e->retrieve_action_hold_transit_copy($t->id);
+	return { atc => $t, ahtc => $ht };
+}
+
+
+
+__PACKAGE__->register_method(
+	method => 'transits_by_lib',
+	api_name => 'open-ils.circ.transit.retrieve_by_lib',
+);
+
+
+# start_date and end_date are optional endpoints for the transit creation date
+sub transits_by_lib {
+	my( $self, $conn, $auth, $orgid, $start_date, $end_date ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('VIEW_CIRCULATIONS'); # eh.. basically the same permission
+
+    my $order_by = {order_by => { atc => 'source_send_time' }};
+    my $search = { dest_recv_time => undef };
+
+    if($end_date) {
+        if($start_date) {
+            $search->{source_send_time} = {between => [$start_date, $end_date]};
+        } else {
+            $search->{source_send_time} = {'<=' => $end_date};
+        }
+    } elsif($start_date) {
+        $search->{source_send_time} = {'>=' => $start_date};
+    }
+
+    $search->{dest} = $orgid;
+
+	my $tos = $e->search_action_transit_copy([ $search, $order_by ], {idlist=>1});
+
+    delete $$search{dest};
+    $search->{source} = $orgid;
+
+	my $froms = $e->search_action_transit_copy([ $search, $order_by ], {idlist=>1});
+
+	return { from => $froms, to => $tos };
+}
+
+
+
+__PACKAGE__->register_method(
+	method => 'fetch_transit',
+	api_name => 'open-ils.circ.transit.retrieve',
+);
+sub fetch_transit {
+	my( $self, $conn, $auth, $transid ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('VIEW_CIRCULATIONS'); # eh.. basically the same permission
+
+	my $ht = $e->retrieve_action_hold_transit_copy($transid);
+	return $ht if $ht;
+
+	my $t = $e->retrieve_action_transit_copy($transid)
+		or return $e->event;
+	return $t;
+}
+
+	
+
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Collections.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Collections.pm
new file mode 100644
index 0000000000..03b6b681fc
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Collections.pm
@@ -0,0 +1,1059 @@
+package OpenILS::Application::Collections;
+use strict; use warnings;
+use OpenSRF::EX qw(:try);
+use OpenILS::Application::AppUtils;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenSRF::Utils qw/:datetime/;
+use OpenILS::Application;
+use OpenILS::Utils::Fieldmapper;
+use base 'OpenILS::Application';
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenILS::Event;
+use OpenILS::Const qw/:const/;
+my $U = "OpenILS::Application::AppUtils";
+
+
+# --------------------------------------------------------------
+# Loads the config info
+# --------------------------------------------------------------
+sub initialize { return 1; }
+
+__PACKAGE__->register_method(
+	method => 'user_from_bc',
+	api_name => 'open-ils.collections.user_id_from_barcode',
+);
+
+sub user_from_bc {
+	my( $self, $conn, $auth, $bc ) = @_;
+	my $e = new_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('VIEW_USER'); 
+	my $card = $e->search_actor_card({barcode=>$bc})->[0]
+		or return $e->event;
+	my $user = $e->retrieve_actor_user($card->usr)
+		or return $e->event;
+	return $user->id;	
+}
+
+
+__PACKAGE__->register_method(
+	method    => 'users_of_interest',
+	api_name  => 'open-ils.collections.users_of_interest.retrieve',
+	api_level => 1,
+	argc      => 4,
+    stream    => 1,
+	signature => { 
+		desc     => q/
+			Returns an array of user information objects that the system 
+			based on the search criteria provided.  If the total fines
+			a user owes reaches or exceeds "fine_level" on or befre "age"
+			and the fines were created at "location", the user will be 
+			included in the return set/,
+		            
+		params   => [
+			{	name => 'auth',
+				desc => 'The authentication token',
+				type => 'string' },
+
+			{	name => 'age',
+				desc => q/Number of days back to check/,
+				type => q/number/,
+			},
+
+			{	name => 'fine_level',
+				desc => q/The fine threshold at which users will be included in the search results /,
+				type => q/number/,
+			},
+			{	name => 'location',
+				desc => q/The short-name of the orginization unit (library) at which the fines were created.  
+							If a selected location has 'child' locations (e.g. a library region), the
+							child locations will be included in the search/,
+				type => q/string/,
+			},
+		],
+
+	  	'return' => { 
+			desc		=> q/An array of user information objects.  
+						usr : Array of user information objects containing id, dob, profile, and groups
+						threshold_amount : The total amount the patron owes that is at least as old
+							as the fine "age" and whose transaction was created at the searched location
+						last_pertinent_billing : The time of the last billing that relates to this query
+						/,
+			type		=> 'array',
+			example	=> {
+				usr	=> {
+					id			=> 'id',
+					dob		=> '1970-01-01',
+					profile	=> 'Patron',
+					groups	=> [ 'Patron', 'Staff' ],
+				},
+				threshold_amount => 99,
+			}
+		}
+	}
+);
+
+
+sub users_of_interest {
+    my( $self, $conn, $auth, $age, $fine_level, $location ) = @_;
+
+    return OpenILS::Event->new('BAD_PARAMS') 
+        unless ($auth and $age and $location);
+
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    my $org = $e->search_actor_org_unit({shortname => $location})
+        or return $e->event; $org = $org->[0];
+
+    # they need global perms to view users so no org is provided
+    return $e->event unless $e->allowed('VIEW_USER'); 
+
+    my $data = [];
+
+    my $ses = OpenSRF::AppSession->create('open-ils.storage');
+
+    my $start = time;
+    my $req = $ses->request(
+        'open-ils.storage.money.collections.users_of_interest', 
+        $age, $fine_level, $location);
+
+    # let the client know we're still here
+    $conn->status( new OpenSRF::DomainObject::oilsContinueStatus );
+
+    return process_users_of_interest_results(
+        $self, $conn, $e, $req, $start, $age, $fine_level, $location);
+}
+
+
+__PACKAGE__->register_method(
+	method    => 'users_of_interest_warning_penalty',
+	api_name  => 'open-ils.collections.users_of_interest.warning_penalty.retrieve',
+	api_level => 1,
+	argc      => 4,
+    stream    => 1,
+	signature => { 
+		desc     => q/
+			Returns an array of user information objects for users that have the
+            PATRON_EXCEEDS_COLLECTIONS_WARNING penalty applied, 
+			based on the search criteria provided./,
+		            
+		params   => [
+			{	name => 'auth',
+				desc => 'The authentication token',
+				type => 'string' 
+            }, {	
+                name => 'location',
+				desc => q/The short-name of the orginization unit (library) at which the penalty is applied.
+							If a selected location has 'child' locations (e.g. a library region), the
+							child locations will be included in the search/,
+				type => q/string/,
+			}, {	
+                name => 'min_age',
+				desc => q/Optional.  Minimum age of the penalty application/,
+				type => q/interval, e.g "30 days"/,
+			}, {	
+                name => 'max_age',
+				desc => q/Optional.  Maximum age of the penalty application/,
+				type => q/interval, e.g "90 days"/,
+			}
+		],
+
+	  	'return' => { 
+			desc		=> q/An array of user information objects.  
+						usr : Array of user information objects containing id, dob, profile, and groups
+						threshold_amount : The total amount the patron owes that is at least as old
+							as the fine "age" and whose transaction was created at the searched location
+						last_pertinent_billing : The time of the last billing that relates to this query
+						/,
+			type		=> 'array',
+			example	=> {
+				usr	=> {
+					id			=> 'id',
+					dob		=> '1970-01-01',
+					profile	=> 'Patron',
+					groups	=> [ 'Patron', 'Staff' ],
+				},
+				threshold_amount => 99, # TODO: still needed?
+			}
+		}
+	}
+);
+
+
+
+sub users_of_interest_warning_penalty {
+    my( $self, $conn, $auth, $location, $min_age, $max_age ) = @_;
+
+    return OpenILS::Event->new('BAD_PARAMS') unless ($auth and $location);
+
+    my $e = new_editor(authtoken => $auth);
+    return $e->event unless $e->checkauth;
+
+    my $org = $e->search_actor_org_unit({shortname => $location})
+        or return $e->event; $org = $org->[0];
+
+    # they need global perms to view users so no org is provided
+    return $e->event unless $e->allowed('VIEW_USER'); 
+
+    my $org_ids = $e->json_query({from => ['actor.org_unit_full_path', $org->id]});
+
+    my $ses = OpenSRF::AppSession->create('open-ils.cstore');
+
+    # max age == oldest 
+    my $max_set_date = DateTime->now->subtract(seconds => 
+        interval_to_seconds($max_age))->strftime( '%F %T%z' ) if $max_age;
+    my $min_set_date = DateTime->now->subtract(seconds => 
+        interval_to_seconds($min_age))->strftime( '%F %T%z' ) if $min_age;
+
+    my $start = time;
+    my $query = {
+        select => {ausp => ['usr']},
+        from => 'ausp',
+        where => {
+            standing_penalty => 4, # PATRON_EXCEEDS_COLLECTIONS_WARNING
+            org_unit => [ map {$_->{id}} @$org_ids ],
+            '-or' => [
+                {stop_date => undef},
+                {stop_date => {'>' => 'now'}}
+            ]
+        }
+    };
+
+    $query->{where}->{'-and'} = [] if $max_set_date or $min_set_date;
+    push(@{$query->{where}->{'-and'}}, {set_date => {'>' => $max_set_date}}) if $max_set_date;
+    push(@{$query->{where}->{'-and'}}, {set_date => {'<' => $min_set_date}}) if $min_set_date;
+
+    my $req = $ses->request('open-ils.cstore.json_query', $query);
+
+    # let the client know we're still here
+    $conn->status( new OpenSRF::DomainObject::oilsContinueStatus );
+
+    return process_users_of_interest_results(
+        $self, $conn, $e, $req, $start, $min_age, '', $location, $max_age);
+}
+
+
+
+
+sub process_users_of_interest_results {
+    my($self, $conn, $e, $req, $starttime, @params) = @_;
+
+   my $total;
+   while( my $resp = $req->recv(timeout => 7200) ) {
+
+        return $req->failed if $req->failed;
+        my $hash = $resp->content;
+        next unless $hash;
+
+        unless($total) {
+            $total = time - $starttime;
+            $logger->info("collections: request (@params) took $total seconds");
+        }
+
+        my $u = $e->retrieve_actor_user(
+            [
+	            $hash->{usr},
+	            {
+		            flesh				=> 1,
+		            flesh_fields	=> {au => ["groups","profile", "card"]},
+	            }
+            ]
+        ) or return $e->event;
+
+        $hash->{usr} = {
+            id			=> $u->id,
+            dob		=> $u->dob,
+            profile	=> $u->profile->name,
+            barcode	=> $u->card->barcode,
+            groups	=> [ map { $_->name } @{$u->groups} ],
+        };
+      
+        $conn->respond($hash);
+    }
+
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+	method    => 'users_owing_money',
+	api_name  => 'open-ils.collections.users_owing_money.retrieve',
+	api_level => 1,
+	argc      => 5,
+    stream    => 1,
+	signature => { 
+		desc     => q/
+			Returns an array of users that owe money during 
+			the given time frame at the location (or child locations)
+			provided/,
+		            
+		params   => [
+			{	name => 'auth',
+				desc => 'The authentication token',
+				type => 'string' },
+
+			{	name => 'start_date',
+				desc => 'The start of the time interval to check',
+				type => q/string (ISO 8601 timestamp.  E.g. 2006-06-24, 1994-11-05T08:15:30-05:00 /,
+			},
+
+			{	name => 'end_date',
+				desc => q/Then end date of the time interval to check/,
+				type => q/string (ISO 8601 timestamp.  E.g. 2006-06-24, 1994-11-05T08:15:30-05:00 /,
+			},
+			{	name => 'fine_level',
+				desc => q/The fine threshold at which users will be included in the search results /,
+				type => q/number/,
+			},
+			{	name => 'locations',
+				desc => q/  A list of one or more org-unit short names.
+							If a selected location has 'child' locations (e.g. a library region), the
+							child locations will be included in the search/,
+				type => q'string',
+			},
+		],
+	  	'return' => { 
+			desc		=> q/An array of user information objects/,
+			type		=> 'array',
+		}
+	}
+);
+
+
+sub users_owing_money {
+	my( $self, $conn, $auth, $start_date, $end_date, $fine_level, @locations ) = @_;
+
+	return OpenILS::Event->new('BAD_PARAMS') 
+		unless ($auth and $start_date and $end_date and @locations);
+
+	my $e = new_editor(authtoken => $auth);
+	return $e->event unless $e->checkauth;
+
+	# they need global perms to view users so no org is provided
+    return $e->event unless $e->allowed('VIEW_USER'); 
+
+    my $data = [];
+
+    my $ses = OpenSRF::AppSession->create('open-ils.storage');
+
+    my $start = time;
+    my $req = $ses->request(
+        'open-ils.storage.money.collections.users_owing_money',
+        $start_date, $end_date, $fine_level, @locations);
+
+    # let the client know we're still here
+    $conn->status( new OpenSRF::DomainObject::oilsContinueStatus );
+
+    return process_users_of_interest_results(
+        $self, $conn, $e, $req, $start, $start_date, $end_date, $fine_level, @locations);
+}
+
+
+
+__PACKAGE__->register_method(
+	method    => 'users_with_activity',
+	api_name  => 'open-ils.collections.users_with_activity.retrieve',
+	api_level => 1,
+	argc      => 4,
+    stream    => 1,
+	signature => { 
+		desc     => q/
+			Returns an array of users that are already in collections 
+			and had any type of billing or payment activity within
+			the given time frame at the location (or child locations)
+			provided/,
+		            
+		params   => [
+			{	name => 'auth',
+				desc => 'The authentication token',
+				type => 'string' },
+
+			{	name => 'start_date',
+				desc => 'The start of the time interval to check',
+				type => q/string (ISO 8601 timestamp.  E.g. 2006-06-24, 1994-11-05T08:15:30-05:00 /,
+			},
+
+			{	name => 'end_date',
+				desc => q/Then end date of the time interval to check/,
+				type => q/string (ISO 8601 timestamp.  E.g. 2006-06-24, 1994-11-05T08:15:30-05:00 /,
+			},
+			{	name => 'location',
+				desc => q/The short-name of the orginization unit (library) at which the activity occurred.
+							If a selected location has 'child' locations (e.g. a library region), the
+							child locations will be included in the search/,
+				type => q'string',
+			},
+		],
+
+	  	'return' => { 
+			desc		=> q/An array of user information objects/,
+			type		=> 'array',
+		}
+	}
+);
+
+sub users_with_activity {
+	my( $self, $conn, $auth, $start_date, $end_date, $location ) = @_;
+	return OpenILS::Event->new('BAD_PARAMS') 
+		unless ($auth and $start_date and $end_date and $location);
+
+	my $e = new_editor(authtoken => $auth);
+	return $e->event unless $e->checkauth;
+
+	my $org = $e->search_actor_org_unit({shortname => $location})
+		or return $e->event; $org = $org->[0];
+    return $e->event unless $e->allowed('VIEW_USER', $org->id);
+
+    my $ses = OpenSRF::AppSession->create('open-ils.storage');
+
+    my $start = time;
+    my $req = $ses->request(
+		'open-ils.storage.money.collections.users_with_activity.atomic', 
+		$start_date, $end_date, $location);
+
+    $conn->status( new OpenSRF::DomainObject::oilsContinueStatus );
+
+    my $total;
+    while( my $resp = $req->recv(timeout => 7200) ) {
+
+        unless($total) {
+            $total = time - $start;
+            $logger->info("collections: users_with_activity search ".
+                "($start_date, $end_date, $location) took $total seconds");
+        }
+
+        return $req->failed if $req->failed;
+        $conn->respond($resp->content);
+   }
+
+    return undef;
+}
+
+
+
+__PACKAGE__->register_method(
+	method    => 'put_into_collections',
+	api_name  => 'open-ils.collections.put_into_collections',
+	api_level => 1,
+	argc      => 3,
+	signature => { 
+		desc     => q/
+			Marks a user as being "in collections" at a given location
+			/,
+		            
+		params   => [
+			{	name => 'auth',
+				desc => 'The authentication token',
+				type => 'string' },
+
+			{	name => 'user_id',
+				desc => 'The id of the user to plact into collections',
+				type => 'number',
+			},
+
+			{	name => 'location',
+				desc => q/The short-name of the orginization unit (library) 
+					for which the user is being placed in collections/,
+				type => q'string',
+			},
+			{	name => 'fee_amount',
+				desc => q/
+					The amount of money that a patron should be fined.  
+					If this field is empty, no fine is created.
+				/,
+				type => 'string',
+			},
+			{	name => 'fee_note',
+				desc => q/
+					Custom note that is added to the the billing.  
+					This field is not required.
+					Note: fee_note is not the billing_type.  Billing_type type is
+					decided by the system. (e.g. "fee for collections").  
+					fee_note is purely used for any additional needed information
+					and is only visible to staff.
+				/,
+				type => 'string',
+			},
+		],
+
+	  	'return' => { 
+			desc		=> q/A SUCCESS event on success, error event on failure/,
+			type		=> 'object',
+		}
+	}
+);
+sub put_into_collections {
+	my( $self, $conn, $auth, $user_id, $location, $fee_amount, $fee_note ) = @_;
+
+	return OpenILS::Event->new('BAD_PARAMS') 
+		unless ($auth and $user_id and $location);
+
+	my $e = new_editor(authtoken => $auth, xact =>1);
+	return $e->event unless $e->checkauth;
+
+	my $org = $e->search_actor_org_unit({shortname => $location});
+	return $e->event unless $org = $org->[0];
+	return $e->event unless $e->allowed('money.collections_tracker.create', $org->id);
+
+	my $existing = $e->search_money_collections_tracker(
+		{
+			location		=> $org->id,
+			usr			=> $user_id,
+			collector	=> $e->requestor->id
+		},
+		{idlist => 1}
+	);
+
+	return OpenILS::Event->new('MONEY_COLLECTIONS_TRACKER_EXISTS') if @$existing;
+
+	$logger->info("collect: user ".$e->requestor->id. 
+		" putting user $user_id into collections for $location");
+
+	my $tracker = Fieldmapper::money::collections_tracker->new;
+
+	$tracker->usr($user_id);
+	$tracker->collector($e->requestor->id);
+	$tracker->location($org->id);
+	$tracker->enter_time('now');
+
+	$e->create_money_collections_tracker($tracker) 
+		or return $e->event;
+
+	if( $fee_amount ) {
+		my $evt = add_collections_fee($e, $user_id, $org, $fee_amount, $fee_note );
+		return $evt if $evt;
+	}
+
+	$e->commit;
+
+    my $pen = Fieldmapper::actor::user_standing_penalty->new;
+    $pen->org_unit($org->id);
+    $pen->usr($user_id);
+    $pen->standing_penalty(30); # PATRON_IN_COLLECTIONS
+    $pen->staff($e->requestor->id);
+    $pen->note($fee_note) if $fee_note;
+    $U->simplereq('open-ils.actor', 'open-ils.actor.user.penalty.apply', $auth, $pen);
+
+	return OpenILS::Event->new('SUCCESS');
+}
+
+sub add_collections_fee {
+	my( $e, $patron_id, $org, $fee_amount, $fee_note ) = @_;
+
+	$fee_note ||= "";
+
+	$logger->info("collect: adding fee to user $patron_id : $fee_amount : $fee_note");
+
+	my $xact = Fieldmapper::money::grocery->new;
+	$xact->usr($patron_id);
+	$xact->xact_start('now');
+	$xact->billing_location($org->id);
+
+	$xact = $e->create_money_grocery($xact) or return $e->event;
+
+	my $bill = Fieldmapper::money::billing->new;
+	$bill->note($fee_note);
+	$bill->xact($xact->id);
+	$bill->btype(2);
+	$bill->billing_type(OILS_BILLING_TYPE_COLLECTION_FEE);
+	$bill->amount($fee_amount);
+
+	$e->create_money_billing($bill) or return $e->event;
+	return undef;
+}
+
+
+
+
+__PACKAGE__->register_method(
+	method		=> 'remove_from_collections',
+	api_name		=> 'open-ils.collections.remove_from_collections',
+	signature	=> q/
+		Returns the users that are currently in collections and
+		had activity during the provided interval.  Dates are inclusive.
+		@param start_date The beginning of the activity interval
+		@param end_date The end of the activity interval
+		@param location The location at which the fines were created
+	/
+);
+
+
+__PACKAGE__->register_method(
+	method    => 'remove_from_collections',
+	api_name  => 'open-ils.collections.remove_from_collections',
+	api_level => 1,
+	argc      => 3,
+	signature => { 
+		desc     => q/
+			Removes a user from the collections table for the given location
+			/,
+		            
+		params   => [
+			{	name => 'auth',
+				desc => 'The authentication token',
+				type => 'string' },
+
+			{	name => 'user_id',
+				desc => 'The id of the user to plact into collections',
+				type => 'number',
+			},
+
+			{	name => 'location',
+				desc => q/The short-name of the orginization unit (library) 
+					for which the user is being removed from collections/,
+				type => q'string',
+			},
+		],
+
+	  	'return' => { 
+			desc		=> q/A SUCCESS event on success, error event on failure/,
+			type		=> 'object',
+		}
+	}
+);
+
+sub remove_from_collections {
+	my( $self, $conn, $auth, $user_id, $location ) = @_;
+
+	return OpenILS::Event->new('BAD_PARAMS') 
+		unless ($auth and $user_id and $location);
+
+	my $e = new_editor(authtoken => $auth, xact=>1);
+	return $e->event unless $e->checkauth;
+
+	my $org = $e->search_actor_org_unit({shortname => $location})
+		or return $e->event; $org = $org->[0];
+	return $e->event unless $e->allowed('money.collections_tracker.delete', $org->id);
+
+	my $tracker = $e->search_money_collections_tracker(
+		{ usr => $user_id, location => $org->id })
+		or return $e->event;
+
+	$e->delete_money_collections_tracker($tracker->[0])
+		or return $e->event;
+
+	$e->commit;
+	return OpenILS::Event->new('SUCCESS');
+}
+
+
+#__PACKAGE__->register_method(
+#	method		=> 'transaction_details',
+#	api_name		=> 'open-ils.collections.user_transaction_details.retrieve',
+#	signature	=> q/
+#	/
+#);
+
+
+__PACKAGE__->register_method(
+	method    => 'transaction_details',
+	api_name  => 'open-ils.collections.user_transaction_details.retrieve',
+	api_level => 1,
+	argc      => 5,
+	signature => { 
+		desc     => q/
+			Returns a list of fleshed user objects with transaction details
+			/,
+		            
+		params   => [
+			{	name => 'auth',
+				desc => 'The authentication token',
+				type => 'string' },
+
+			{	name => 'start_date',
+				desc => 'The start of the time interval to check',
+				type => q/string (ISO 8601 timestamp.  E.g. 2006-06-24, 1994-11-05T08:15:30-05:00 /,
+			},
+
+			{	name => 'end_date',
+				desc => q/Then end date of the time interval to check/,
+				type => q/string (ISO 8601 timestamp.  E.g. 2006-06-24, 1994-11-05T08:15:30-05:00 /,
+			},
+			{	name => 'location',
+				desc => q/The short-name of the orginization unit (library) at which the activity occurred.
+							If a selected location has 'child' locations (e.g. a library region), the
+							child locations will be included in the search/,
+				type => q'string',
+			},
+			{
+				name => 'user_list',
+				desc => 'An array of user ids',
+				type => 'array',
+			},
+		],
+
+	  	'return' => { 
+			desc		=> q/A list of objects.  Object keys include:
+				usr :
+				transactions : An object with keys :
+					circulations : Fleshed circulation objects
+					grocery : Fleshed 'grocery' transaction objects
+				/,
+			type		=> 'object'
+		}
+	}
+);
+
+sub transaction_details {
+	my( $self, $conn, $auth, $start_date, $end_date, $location, $user_list ) = @_;
+
+	return OpenILS::Event->new('BAD_PARAMS') 
+		unless ($auth and $start_date and $end_date and $location and $user_list);
+
+	my $e = new_editor(authtoken => $auth);
+	return $e->event unless $e->checkauth;
+
+	# they need global perms to view users so no org is provided
+	return $e->event unless $e->allowed('VIEW_USER'); 
+
+	my $org = $e->search_actor_org_unit({shortname => $location})
+		or return $e->event; $org = $org->[0];
+
+	# get a reference to the org inside of the tree
+	$org = $U->find_org($U->fetch_org_tree(), $org->id);
+
+	my @data;
+	for my $uid (@$user_list) {
+		my $blob = {};
+
+		$blob->{usr} = $e->retrieve_actor_user(
+			[
+				$uid,
+         	{
+            	"flesh"        => 1,
+            	"flesh_fields" =>  {
+               	"au" => [
+                  	"cards",
+                  	"card",
+                  	"standing_penalties",
+                  	"addresses",
+                  	"billing_address",
+                  	"mailing_address",
+                  	"stat_cat_entries"
+               	]
+            	}
+         	}
+			]
+		);
+
+		$blob->{transactions} = {
+			circulations	=> 
+				fetch_circ_xacts($e, $uid, $org, $start_date, $end_date),
+			grocery			=> 
+				fetch_grocery_xacts($e, $uid, $org, $start_date, $end_date),
+			reservations	=> 
+				fetch_reservation_xacts($e, $uid, $org, $start_date, $end_date)
+		};
+
+		# for each transaction, flesh the workstatoin on any attached payment
+		# and make the payment object a real object (e.g. cash payment), 
+		# not just a generic payment object
+		for my $xact ( 
+			@{$blob->{transactions}->{circulations}}, 
+			@{$blob->{transactions}->{reservations}}, 
+			@{$blob->{transactions}->{grocery}} ) {
+
+			my $ps;
+			if( $ps = $xact->payments and @$ps ) {
+				my @fleshed; my $evt;
+				for my $p (@$ps) {
+					($p, $evt) = flesh_payment($e,$p);
+					return $evt if $evt;
+					push(@fleshed, $p);
+				}
+				$xact->payments(\@fleshed);
+			}
+		}
+
+		push( @data, $blob );
+	}
+
+	return \@data;
+}
+
+sub flesh_payment {
+	my $e = shift;
+	my $p = shift;
+	my $type = $p->payment_type;
+	$logger->debug("collect: fleshing workstation on payment $type : ".$p->id);
+	my $meth = "retrieve_money_$type";
+	$p = $e->$meth($p->id) or return (undef, $e->event);
+	try {
+		$p->payment_type($type);
+		$p->cash_drawer(
+			$e->retrieve_actor_workstation(
+				[
+					$p->cash_drawer,
+					{
+						flesh => 1,
+						flesh_fields => { aws => [ 'owning_lib' ] }
+					}
+				]
+			)
+		);
+	} catch Error with {};
+	return ($p);
+}
+
+
+# --------------------------------------------------------------
+# Collect all open circs for the user 
+# For each circ, see if any billings or payments were created
+# during the given time period.  
+# --------------------------------------------------------------
+sub fetch_circ_xacts {
+	my $e				= shift;
+	my $uid			= shift;
+	my $org			= shift;
+	my $start_date = shift;
+	my $end_date	= shift;
+
+	my @circs;
+
+	# at the specified org and each descendent org, 
+	# fetch the open circs for this user
+	$U->walk_org_tree( $org, 
+		sub {
+			my $n = shift;
+			$logger->debug("collect: searching for open circs at " . $n->shortname);
+			push( @circs, 
+				@{
+					$e->search_action_circulation(
+						{
+							usr			=> $uid, 
+							circ_lib		=> $n->id,
+						}, 
+						{idlist => 1}
+					)
+				}
+			);
+		}
+	);
+
+
+	my @data;
+	my $active_ids = fetch_active($e, \@circs, $start_date, $end_date);
+
+	for my $cid (@$active_ids) {
+		push( @data, 
+			$e->retrieve_action_circulation(
+				[
+					$cid,
+					{
+						flesh => 1,
+						flesh_fields => { 
+							circ => [ "billings", "payments", "circ_lib", 'target_copy' ]
+						}
+					}
+				]
+			)
+		);
+	}
+
+	return \@data;
+}
+
+sub fetch_grocery_xacts {
+	my $e				= shift;
+	my $uid			= shift;
+	my $org			= shift;
+	my $start_date = shift;
+	my $end_date	= shift;
+
+	my @xacts;
+	$U->walk_org_tree( $org, 
+		sub {
+			my $n = shift;
+			$logger->debug("collect: searching for open grocery xacts at " . $n->shortname);
+			push( @xacts, 
+				@{
+					$e->search_money_grocery(
+						{
+							usr					=> $uid, 
+							billing_location	=> $n->id,
+						}, 
+						{idlist => 1}
+					)
+				}
+			);
+		}
+	);
+
+	my @data;
+	my $active_ids = fetch_active($e, \@xacts, $start_date, $end_date);
+
+	for my $id (@$active_ids) {
+		push( @data, 
+			$e->retrieve_money_grocery(
+				[
+					$id,
+					{
+						flesh => 1,
+						flesh_fields => { 
+							mg => [ "billings", "payments", "billing_location" ] }
+					}
+				]
+			)
+		);
+	}
+
+	return \@data;
+}
+
+sub fetch_reservation_xacts {
+	my $e				= shift;
+	my $uid			= shift;
+	my $org			= shift;
+	my $start_date = shift;
+	my $end_date	= shift;
+
+	my @xacts;
+	$U->walk_org_tree( $org, 
+		sub {
+			my $n = shift;
+			$logger->debug("collect: searching for open grocery xacts at " . $n->shortname);
+			push( @xacts, 
+				@{
+					$e->search_booking_reservation(
+						{
+							usr					=> $uid, 
+							pickup_lib      	=> $n->id,
+						}, 
+						{idlist => 1}
+					)
+				}
+			);
+		}
+	);
+
+	my @data;
+	my $active_ids = fetch_active($e, \@xacts, $start_date, $end_date);
+
+	for my $id (@$active_ids) {
+		push( @data, 
+			$e->retrieve_booking_reservation(
+				[
+					$id,
+					{
+						flesh => 1,
+						flesh_fields => { 
+							bresv => [ "billings", "payments", "pickup_lib" ] }
+					}
+				]
+			)
+		);
+	}
+
+	return \@data;
+}
+
+
+
+# --------------------------------------------------------------
+# Given a list of xact id's, this returns a list of id's that
+# had any activity within the given time span
+# --------------------------------------------------------------
+sub fetch_active {
+	my( $e, $ids, $start_date, $end_date ) = @_;
+
+	# use this..
+	# { payment_ts => { between => [ $start, $end ] } } ' ;) 
+
+	my @active;
+	for my $id (@$ids) {
+
+		# see if any billings were created in the given time range
+		my $bills = $e->search_money_billing (
+			{
+				xact			=> $id,
+				billing_ts	=> { between => [ $start_date, $end_date ] },
+			},
+			{idlist =>1}
+		);
+
+		my $payments = [];
+
+		if( !@$bills ) {
+
+			# see if any payments were created in the given range
+			$payments = $e->search_money_payment (
+				{
+					xact			=> $id,
+					payment_ts	=> { between => [ $start_date, $end_date ] },
+				},
+				{idlist =>1}
+			);
+		}
+
+
+		push( @active, $id ) if @$bills or @$payments;
+	}
+
+	return \@active;
+}
+
+
+__PACKAGE__->register_method(
+	method    => 'create_user_note',
+	api_name  => 'open-ils.collections.patron_note.create',
+	api_level => 1,
+	argc      => 4,
+	signature => { 
+		desc     => q/ Adds a note to a patron's account /,
+		params   => [
+			{	name => 'auth',
+				desc => 'The authentication token',
+				type => 'string' },
+
+			{	name => 'user_barcode',
+				desc => q/The patron's barcode/,
+				type => q/string/,
+			},
+			{	name => 'title',
+				desc => q/The title of the note/,
+				type => q/string/,
+			},
+
+			{	name => 'note',
+				desc => q/The text of the note/,
+				type => q/string/,
+			},
+		],
+
+	  	'return' => { 
+			desc		=> q/
+				Returns SUCCESS event on success, error event otherwise.
+				/,
+			type		=> 'object'
+		}
+	}
+);
+
+
+sub create_user_note {
+	my( $self, $conn, $auth, $user_barcode, $title, $note_txt ) = @_;
+
+	my $e = new_editor(authtoken=>$auth, xact=>1);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('UPDATE_USER'); # XXX Makre more specific perm for this
+
+	return $e->event unless 
+		my $card = $e->search_actor_card({barcode=>$user_barcode})->[0];
+
+	my $note = Fieldmapper::actor::usr_note->new;
+	$note->usr($card->usr);
+	$note->title($title);
+	$note->creator($e->requestor->id);
+	$note->create_date('now');
+	$note->pub('f');
+	$note->value($note_txt);
+
+	$e->create_actor_usr_note($note) or return $e->event;
+	$e->commit;
+	return OpenILS::Event->new('SUCCESS');
+}
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Fielder.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Fielder.pm
new file mode 100644
index 0000000000..38a56c55b5
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Fielder.pm
@@ -0,0 +1,153 @@
+# vim:et:ts=4:sw=4:
+
+package OpenILS::Application::Fielder;
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+
+use Unicode::Normalize;
+use OpenSRF::EX qw/:try/;
+
+use OpenSRF::AppSession;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Cache;
+use OpenSRF::Utils::Logger qw/:level/;
+
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::JSON;
+
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+
+use Digest::MD5 qw(md5_hex);
+
+use XML::LibXML;
+use XML::LibXML::XPathContext;
+use XML::LibXSLT;
+
+our %namespace_map = (
+    oils_persist=> {ns => 'http://open-ils.org/spec/opensrf/IDL/persistence/v1'},
+    oils_obj    => {ns => 'http://open-ils.org/spec/opensrf/IDL/objects/v1'},
+    idl         => {ns => 'http://opensrf.org/spec/IDL/base/v1'},
+    reporter    => {ns => 'http://open-ils.org/spec/opensrf/IDL/reporter/v1'},
+    perm        => {ns => 'http://open-ils.org/spec/opensrf/IDL/permacrud/v1'},
+);
+
+
+my $log = 'OpenSRF::Utils::Logger';
+
+my $cache;
+my $cache_timeout;
+my $parser = XML::LibXML->new();
+my $xslt = XML::LibXSLT->new();
+
+my $xpc = XML::LibXML::XPathContext->new();
+$xpc->registerNs($_, $namespace_map{$_}{ns}) for ( keys %namespace_map );
+
+my $idl;
+
+sub initialize {
+
+    my $conf = OpenSRF::Utils::SettingsClient->new;
+    my $idl_file = $conf->config_value( 'IDL' );
+
+    $idl = $parser->parse_file( $idl_file );
+
+    $log->debug( 'IDL XML file loaded' );
+
+    $cache_timeout = $conf->config_value(
+            "apps", "open-ils.fielder", "app_settings", "cache_timeout" ) || 300;
+
+    generate_methods();
+
+}
+sub child_init {
+    $cache = OpenSRF::Utils::Cache->new('global');
+}
+
+sub fielder_fetch {
+    my $self = shift;
+    my $client = shift;
+    my $obj = shift;
+
+    my $query = $obj->{query};
+    my $nocache = $obj->{cache} ? 0 : 1;
+    my $fields = $obj->{fields};
+    my $distinct = $obj->{distinct} ? 1 : 0;
+
+    return undef unless $query;
+
+    my $obj_class = $self->{class_hint};
+    my $fm_class = $self->{class_name};
+
+    if (!$fields) {
+        $fields = [ $fm_class->real_fields ];
+    }
+
+    $fields = [$fields] if (!ref($fields));
+
+    my $qstring = OpenSRF::Utils::JSON->perl2JSON( $query );
+    my $fstring = OpenSRF::Utils::JSON->perl2JSON( [ sort { $a cmp $b } @$fields ] );
+
+    $log->debug( 'Query Class: '. $obj_class );
+    $log->debug( 'Field list: '. $fstring );
+    $log->debug( 'Query: '. $qstring );
+
+    my ($key,$res);
+    unless ($nocache) {
+        $key = 'open-ils.fielder_' . md5_hex(
+            $self->api_name . 
+            $qstring .
+            $fstring .
+            $distinct .
+            $obj_class
+        );
+
+        $res = $cache->get_cache( $key );
+
+        if ($res) {
+            $client->respond($_) for (@$res);
+            return undef;
+        }
+    }
+
+    $res = new_editor()->json_query({
+        select  => { $obj_class => $fields },
+        from    => $obj_class,
+        where   => $query,
+        distinct=> $distinct
+    });
+
+    for my $value (@$res) {
+        $client->respond($value);
+    }
+
+    $client->respond_complete();
+
+    $cache->put_cache( $key => $res => $cache_timeout ) unless ($nocache);
+    return undef;
+}
+
+sub generate_methods {
+    try {
+        for my $class_node ( $xpc->findnodes( '//idl:class[@oils_persist:field_safe="true"]', $idl->documentElement ) ) {
+            my $hint = $class_node->getAttribute('id');
+            my $fm = $class_node->getAttributeNS('http://open-ils.org/spec/opensrf/IDL/objects/v1','fieldmapper');
+            $log->debug("Fielder class_node $hint");
+        
+            __PACKAGE__->register_method(
+                method          => 'fielder_fetch',
+                api_name        => 'open-ils.fielder.' . $hint,
+                class_hint      => $hint,
+                class_name      => "Fieldmapper::$fm",
+                stream          => 1,
+                argc            => 1
+            );
+        }
+    } catch Error with {
+        my $e = shift;
+        $log->error("error generating Fielder methods: $e");
+    };
+}
+
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Ingest.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Ingest.pm
new file mode 100644
index 0000000000..765000ce31
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Ingest.pm
@@ -0,0 +1,1453 @@
+package OpenILS::Application::Ingest;
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+
+use Unicode::Normalize;
+use OpenSRF::EX qw/:try/;
+
+use OpenSRF::AppSession;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Logger qw/:level/;
+
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::ScriptRunner;
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::JSON;
+
+use OpenILS::Utils::Fieldmapper;
+
+use XML::LibXML;
+use XML::LibXSLT;
+use Time::HiRes qw(time);
+
+our %supported_formats = (
+    mods33    => {ns => 'http://www.loc.gov/mods/v3'},
+    mods32    => {ns => 'http://www.loc.gov/mods/v3'},
+    mods3    => {ns => 'http://www.loc.gov/mods/v3'},
+    mods    => {ns => 'http://www.loc.gov/mods/'},
+    marcxml    => {ns => 'http://www.loc.gov/MARC21/slim'},
+    srw_dc    => {ns => 'info:srw/schema/1/dc-schema'},
+    oai_dc    => {ns => 'http://www.openarchives.org/OAI/2.0/oai_dc/'},
+    rdf_dc    => {ns => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'},
+    atom    => {ns => 'http://www.w3.org/2005/Atom'},
+    rss091    => {ns => 'http://my.netscape.com/rdf/simple/0.9/'},
+    rss092    => {ns => ''},
+    rss093    => {ns => ''},
+    rss094    => {ns => ''},
+    rss10    => {ns => 'http://purl.org/rss/1.0/'},
+    rss11    => {ns => 'http://purl.org/net/rss1.1#'},
+    rss2    => {ns => ''},
+);
+
+
+my $log = 'OpenSRF::Utils::Logger';
+
+my  $parser = XML::LibXML->new();
+my  $xslt = XML::LibXSLT->new();
+
+my  $mods_sheet;
+my  $mads_sheet;
+my  $xpathset = {};
+sub initialize {}
+sub child_init {}
+
+sub post_init {
+
+    unless (keys %$xpathset) {
+        $log->debug("Running post_init", DEBUG);
+
+        my $xsldir = OpenSRF::Utils::SettingsClient->new->config_value(dirs => 'xsl');
+
+        unless ($supported_formats{mods}{xslt}) {
+            $log->debug("Loading MODS XSLT", DEBUG);
+             my $xslt_doc = $parser->parse_file( $xsldir . "/MARC21slim2MODS.xsl");
+            $supported_formats{mods}{xslt} = $xslt->parse_stylesheet( $xslt_doc );
+        }
+
+        unless ($supported_formats{mods3}{xslt}) {
+            $log->debug("Loading MODS v3 XSLT", DEBUG);
+             my $xslt_doc = $parser->parse_file( $xsldir . "/MARC21slim2MODS3.xsl");
+            $supported_formats{mods3}{xslt} = $xslt->parse_stylesheet( $xslt_doc );
+        }
+
+        unless ($supported_formats{mods32}{xslt}) {
+            $log->debug("Loading MODS v32 XSLT", DEBUG);
+             my $xslt_doc = $parser->parse_file( $xsldir . "/MARC21slim2MODS32.xsl");
+            $supported_formats{mods32}{xslt} = $xslt->parse_stylesheet( $xslt_doc );
+        }
+
+        unless ($supported_formats{mods33}{xslt}) {
+            $log->debug("Loading MODS v33 XSLT", DEBUG);
+             my $xslt_doc = $parser->parse_file( $xsldir . "/MARC21slim2MODS33.xsl");
+            $supported_formats{mods33}{xslt} = $xslt->parse_stylesheet( $xslt_doc );
+        }
+
+        my $req = OpenSRF::AppSession
+                ->create('open-ils.cstore')
+                
+                # XXX testing new metabib field use for faceting
+                #->request( 'open-ils.cstore.direct.config.metabib_field.search.atomic', { id => { '!=' => undef } } )
+                ->request( 'open-ils.cstore.direct.config.metabib_field.search.atomic', { search_field => 't' } )
+
+                ->gather(1);
+
+        if (ref $req and @$req) {
+            for my $f (@$req) {
+                $xpathset->{ $f->field_class }->{ $f->name }->{xpath} = $f->xpath;
+                $xpathset->{ $f->field_class }->{ $f->name }->{id} = $f->id;
+                $xpathset->{ $f->field_class }->{ $f->name }->{format} = $f->format;
+                $log->debug("Loaded XPath from DB: ".$f->field_class." => ".$f->name." : ".$f->xpath, DEBUG);
+            }
+        }
+    }
+}
+
+# --------------------------------------------------------------------------------
+# Biblio ingest
+
+package OpenILS::Application::Ingest::Biblio;
+use base qw/OpenILS::Application::Ingest/;
+use Unicode::Normalize;
+
+sub rw_biblio_ingest_single_object {
+    my $self = shift;
+    my $client = shift;
+    my $bib = shift;
+
+    my ($blob) = $self->method_lookup("open-ils.ingest.full.biblio.object.readonly")->run($bib);
+    return undef unless ($blob);
+
+    $bib->fingerprint( $blob->{fingerprint}->{fingerprint} );
+    $bib->quality( $blob->{fingerprint}->{quality} );
+
+    my $cstore = OpenSRF::AppSession->connect('open-ils.cstore');
+
+    my $xact = $cstore->request('open-ils.cstore.transaction.begin')->gather(1);
+    my $tmp;
+
+    # update uri stuff ...
+
+    # gather URI call numbers for this record
+    my $uri_cns = $u->{call_number} = $cstore->request(
+        'open-ils.cstore.direct.asset.call_number.id_list.atomic' => { record => $bib->id, label => '##URI##' }
+    )->gather(1);
+
+    if (@$uri_cns) {
+        # gather the maps for those call numbers
+        my $uri_maps = $u->{call_number} = $cstore->request(
+            'open-ils.cstore.direct.asset.uri_call_number_map.id_list.atomic' => { call_number => $uri_cns }
+        )->gather(1);
+    
+        # delete the old maps
+        $cstore->request( 'open-ils.cstore.direct.asset.uri_call_number_map.delete' => $_ )->gather(1) for (@$uri_maps);
+    
+        # and delete the call numbers if there are no more URIs
+        if (!@{ $blob->{uri} }) {
+            $cstore->request( 'open-ils.cstore.direct.asset.call_number.delete' => $_ )->gather(1) for (@$uri_cns);
+        }
+    }
+
+    # now, add CNs, URIs and maps
+    my %new_cns_by_owner;
+    my %new_uris_by_owner;
+    for my $u ( @{ $blob->{uri} } ) {
+
+        my $owner = $u->{call_number}->owning_lib;
+
+        if ($u->{call_number}->isnew) {
+            if ($new_cns_by_owner{$owner}) {
+                $u->{call_number} = $new_cns_by_owner{$owner};
+            } else {
+                $u->{call_number}->clear_id;
+                $u->{call_number} = $new_cns_by_owner{$owner} = $cstore->request(
+                    'open-ils.cstore.direct.asset.call_number.create' => $u->{call_number}
+                )->gather(1);
+            }
+        }
+
+        if ($u->{uri}->isnew) {
+            if ($new_uris_by_owner{$owner}) {
+                $u->{uri} = $new_uris_by_owner{$owner};
+            } else {
+                $u->{uri} = $new_uris_by_owner{$owner} = $cstore->request(
+                    'open-ils.cstore.direct.asset.uri.create' => $u->{uri}
+                )->gather(1);
+            }
+        }
+
+        # Check for an existing CN-URI map
+        $tmp = $cstore->request(
+            'open-ils.cstore.direct.asset.uri_call_number_map.id_list',
+            { call_number => $u->{call_number}->id, uri => $u->{uri}->id }
+        )->gather(1);
+
+        next if ($tmp);
+
+        my $umap = Fieldmapper::asset::uri_call_number_map->new;
+        $umap->uri($u->{uri}->id);
+        $umap->call_number($u->{call_number}->id);
+
+        $cstore->request( 'open-ils.cstore.direct.asset.uri_call_number_map.create' => $umap )->gather(1);
+    }
+
+    # update full_rec stuff ...
+    $tmp = $cstore->request(
+        'open-ils.cstore.direct.metabib.full_rec.id_list.atomic',
+        { record => $bib->id }
+    )->gather(1);
+
+    $cstore->request( 'open-ils.cstore.direct.metabib.full_rec.delete' => $_ )->gather(1) for (@$tmp);
+    $cstore->request( 'open-ils.cstore.direct.metabib.full_rec.create' => $_ )->gather(1) for (@{ $blob->{full_rec} });
+
+    # update rec_descriptor stuff ...
+    $tmp = $cstore->request(
+        'open-ils.cstore.direct.metabib.record_descriptor.id_list.atomic',
+        { record => $bib->id }
+    )->gather(1);
+
+    $cstore->request( 'open-ils.cstore.direct.metabib.record_descriptor.delete' => $_ )->gather(1) for (@$tmp);
+    $cstore->request( 'open-ils.cstore.direct.metabib.record_descriptor.create' => $blob->{descriptor} )->gather(1);
+
+    # deal with classed fields...
+    for my $class ( qw/title author subject keyword series identifier/ ) {
+        $tmp = $cstore->request(
+            "open-ils.cstore.direct.metabib.${class}_field_entry.id_list.atomic",
+            { source => $bib->id }
+        )->gather(1);
+
+        $cstore->request( "open-ils.cstore.direct.metabib.${class}_field_entry.delete" => $_ )->gather(1) for (@$tmp);
+    }
+    for my $obj ( @{ $blob->{field_entries} } ) {
+        my $class = $obj->class_name;
+        $class =~ s/^Fieldmapper:://o;
+        $class =~ s/::/./go;
+        $cstore->request( "open-ils.cstore.direct.$class.create" => $obj )->gather(1);
+    }
+
+    # update MR map ...
+
+    $tmp = $cstore->request(
+        'open-ils.cstore.direct.metabib.metarecord_source_map.search.atomic',
+        { source => $bib->id }
+    )->gather(1);
+
+    $cstore->request( 'open-ils.cstore.direct.metabib.metarecord_source_map.delete' => $_->id )->gather(1) for (@$tmp);
+
+    # get the old MRs
+    my $old_mrs = $cstore->request(
+        'open-ils.cstore.direct.metabib.metarecord.search.atomic' => { id => [map { $_->metarecord } @$tmp] }
+    )->gather(1) if (@$tmp);
+
+    $old_mrs = [] if (!ref($old_mrs));
+
+    my $mr;
+    for my $m (@$old_mrs) {
+        if ($m->fingerprint eq $bib->fingerprint) {
+            $mr = $m;
+        } else {
+            my $others = $cstore->request(
+                'open-ils.cstore.direct.metabib.metarecord_source_map.id_list.atomic' => { metarecord => $m->id }
+            )->gather(1);
+
+            if (!@$others) {
+                $cstore->request(
+                    'open-ils.cstore.direct.metabib.metarecord.delete' => $m->id
+                )->gather(1);
+            }
+
+            $m->isdeleted(1);
+        }
+    }
+
+    my $holds;
+    if (!$mr) {
+        # Get the matchin MR, if any.
+        $mr = $cstore->request(
+            'open-ils.cstore.direct.metabib.metarecord.search',
+            { fingerprint => $bib->fingerprint }
+        )->gather(1);
+
+        $holds = $cstore->request(
+            'open-ils.cstore.direct.action.hold_request.search.atomic',
+            { hold_type => 'M', target => [ map { $_->id } grep { $_->isdeleted } @$old_mrs ] }
+        )->gather(1) if (@$old_mrs);
+
+        if ($mr) {
+            for my $h (@$holds) {
+                $h->target($mr);
+                $cstore->request( 'open-ils.cstore.direct.action.hold_request.update' => $h )->gather(1);
+                $h->ischanged(1);
+            }
+        }
+    }
+
+    if (!$mr) {
+        $mr = new Fieldmapper::metabib::metarecord;
+        $mr->fingerprint( $bib->fingerprint );
+        $mr->master_record( $bib->id );
+        $mr->id(
+            $cstore->request(
+                "open-ils.cstore.direct.metabib.metarecord.create",
+                $mr => { quiet => 'true' }
+            )->gather(1)
+        );
+
+        for my $h (grep { !$_->ischanged } @$holds) {
+            $h->target($mr);
+            $cstore->request( 'open-ils.cstore.direct.action.hold_request.update' => $h )->gather(1);
+        }
+    } else {
+        my $mrm = $cstore->request(
+            'open-ils.cstore.direct.metabib.metarecord_source_map.search.atomic',
+            { metarecord => $mr->id }
+        )->gather(1);
+
+        if (@$mrm) {
+            my $best = $cstore->request(
+                "open-ils.cstore.direct.biblio.record_entry.search",
+                { id => [ map { $_->source } @$mrm ] },
+                { 'select'    => { bre => [ qw/id quality/ ] },
+                  order_by    => { bre => "quality desc" },
+                  limit        => 1,
+                }
+            )->gather(1);
+
+            if ($best->quality > $bib->quality) {
+                $mr->master_record($best->id);
+            } else {
+                $mr->master_record($bib->id);
+            }
+        } else {
+            $mr->master_record($bib->id);
+        }
+
+        $mr->clear_mods;
+
+        $cstore->request( 'open-ils.cstore.direct.metabib.metarecord.update' => $mr )->gather(1);
+    }
+
+    my $mrm = new Fieldmapper::metabib::metarecord_source_map;
+    $mrm->source($bib->id);
+    $mrm->metarecord($mr->id);
+
+    $cstore->request( 'open-ils.cstore.direct.metabib.metarecord_source_map.create' => $mrm )->gather(1);
+    $cstore->request( 'open-ils.cstore.direct.biblio.record_entry.update' => $bib )->gather(1);
+
+    $cstore->request( 'open-ils.cstore.json_query.atomic' => { from => [ 'reporter.simple_rec_update', $bib->id ] } )->gather(1);
+
+    $cstore->request( 'open-ils.cstore.transaction.commit' )->gather(1) || return undef;;
+    $cstore->disconnect;
+
+    return $bib->id;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.biblio.object",
+    method        => "rw_biblio_ingest_single_object",
+    api_level    => 1,
+    argc        => 1,
+);                      
+
+sub rw_biblio_ingest_single_record {
+    my $self = shift;
+    my $client = shift;
+    my $rec = shift;
+
+    OpenILS::Application::Ingest->post_init();
+    my $cstore = OpenSRF::AppSession->connect( 'open-ils.cstore' );
+    $cstore->request('open-ils.cstore.transaction.begin')->gather(1);
+
+    my $r = $cstore->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve' => $rec )->gather(1);
+
+    $cstore->request('open-ils.cstore.transaction.rollback')->gather(1);
+    $cstore->disconnect;
+
+    return undef unless ($r and @$r);
+
+    return ($self->method_lookup("open-ils.ingest.full.biblio.object")->run($r))[0];
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.biblio.record",
+    method        => "rw_biblio_ingest_single_record",
+    api_level    => 1,
+    argc        => 1,
+);                      
+
+sub rw_biblio_ingest_record_list {
+    my $self = shift;
+    my $client = shift;
+    my @rec = ref($_[0]) ? @{ $_[0] } : @_ ;
+
+    OpenILS::Application::Ingest->post_init();
+    my $cstore = OpenSRF::AppSession->connect( 'open-ils.cstore' );
+    $cstore->request('open-ils.cstore.transaction.begin')->gather(1);
+
+    my $r = $cstore->request( 'open-ils.cstore.direct.biblio.record_entry.search.atomic' => { id => \@rec } )->gather(1);
+
+    $cstore->request('open-ils.cstore.transaction.rollback')->gather(1);
+    $cstore->disconnect;
+
+    return undef unless ($r and @$r);
+
+    my $count = 0;
+    for (@$r) {
+        if (($self->method_lookup("open-ils.ingest.full.biblio.object")->run($_))[0]) {
+            $count++
+        }
+    }
+    return $count;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.biblio.record_list",
+    method        => "rw_biblio_ingest_record_list",
+    api_level    => 1,
+    argc        => 1,
+);                      
+
+sub ro_biblio_ingest_single_object {
+    my $self = shift;
+    my $client = shift;
+    my $bib = shift;
+    my $xml = OpenILS::Application::AppUtils->entityize($bib->marc);
+    my $max_cn = shift;
+    my $max_uri = shift;
+
+    my $cstore = OpenSRF::AppSession->connect( 'open-ils.cstore' );
+
+    if (!$max_cn) {
+        my $cn = $cstore->request( 'open-ils.cstore.direct.asset.call_number.search' => { id => { '!=' => undef } }, { limit => 1, order_by => { acn => 'id desc' } } )->gather(1);
+        $max_cn = int($cn->id) + 1000;
+    }
+
+    if (!$max_uri) {
+        my $cn = $cstore->request( 'open-ils.cstore.direct.asset.call_number.search' => { id => { '!=' => undef } }, { limit => 1, order_by => { acn => 'id desc' } } )->gather(1);
+        $max_uri = int($cn->id) + 1000;
+    }
+
+    $cstore->disconnect;
+
+    my $document = $parser->parse_string($xml);
+
+    my @uris = $self->method_lookup("open-ils.ingest.856_uri.object")->run($bib, $max_cn, $max_uri);
+    my @mfr = $self->method_lookup("open-ils.ingest.flat_marc.biblio.xml")->run($document);
+    my @mXfe = $self->method_lookup("open-ils.ingest.extract.field_entry.all.xml")->run($document);
+    my ($fp) = $self->method_lookup("open-ils.ingest.fingerprint.xml")->run($xml);
+    my ($rd) = $self->method_lookup("open-ils.ingest.descriptor.xml")->run($xml);
+
+    $_->source($bib->id) for (@mXfe);
+    $_->record($bib->id) for (@mfr);
+    $rd->record($bib->id) if ($rd);
+
+    return { full_rec => \@mfr, field_entries => \@mXfe, fingerprint => $fp, descriptor => $rd, uri => \@uris };
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.biblio.object.readonly",
+    method        => "ro_biblio_ingest_single_object",
+    api_level    => 1,
+    argc        => 1,
+);                      
+
+sub ro_biblio_ingest_single_xml {
+    my $self = shift;
+    my $client = shift;
+    my $xml = OpenILS::Application::AppUtils->entityize(shift);
+
+    my $document = $parser->parse_string($xml);
+
+    my @mfr = $self->method_lookup("open-ils.ingest.flat_marc.biblio.xml")->run($document);
+    my @mXfe = $self->method_lookup("open-ils.ingest.extract.field_entry.all.xml")->run($document);
+    my ($fp) = $self->method_lookup("open-ils.ingest.fingerprint.xml")->run($xml);
+    my ($rd) = $self->method_lookup("open-ils.ingest.descriptor.xml")->run($xml);
+
+    return { full_rec => \@mfr, field_entries => \@mXfe, fingerprint => $fp, descriptor => $rd };
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.biblio.xml.readonly",
+    method        => "ro_biblio_ingest_single_xml",
+    api_level    => 1,
+    argc        => 1,
+);                      
+
+sub ro_biblio_ingest_single_record {
+    my $self = shift;
+    my $client = shift;
+    my $rec = shift;
+
+    OpenILS::Application::Ingest->post_init();
+    my $r = OpenSRF::AppSession
+            ->create('open-ils.cstore')
+            ->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve' => $rec )
+            ->gather(1);
+
+    return undef unless ($r and @$r);
+
+    my ($res) = $self->method_lookup("open-ils.ingest.full.biblio.xml.readonly")->run($r->marc);
+
+    $_->source($rec) for (@{$res->{field_entries}});
+    $_->record($rec) for (@{$res->{full_rec}});
+    $res->{descriptor}->record($rec);
+
+    return $res;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.biblio.record.readonly",
+    method        => "ro_biblio_ingest_single_record",
+    api_level    => 1,
+    argc        => 1,
+);                      
+
+sub ro_biblio_ingest_stream_record {
+    my $self = shift;
+    my $client = shift;
+
+    OpenILS::Application::Ingest->post_init();
+
+    my $ses = OpenSRF::AppSession->create('open-ils.cstore');
+
+    while (my ($resp) = $client->recv( count => 1, timeout => 5 )) {
+    
+        my $rec = $resp->content;
+        last unless (defined $rec);
+
+        $log->debug("Running open-ils.ingest.full.biblio.record.readonly ...");
+        my ($res) = $self->method_lookup("open-ils.ingest.full.biblio.record.readonly")->run($rec);
+
+        $_->source($rec) for (@{$res->{field_entries}});
+        $_->record($rec) for (@{$res->{full_rec}});
+
+        $client->respond( $res );
+    }
+
+    return undef;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.biblio.record_stream.readonly",
+    method        => "ro_biblio_ingest_stream_record",
+    api_level    => 1,
+    stream        => 1,
+);                      
+
+sub ro_biblio_ingest_stream_xml {
+    my $self = shift;
+    my $client = shift;
+
+    OpenILS::Application::Ingest->post_init();
+
+    my $ses = OpenSRF::AppSession->create('open-ils.cstore');
+
+    while (my ($resp) = $client->recv( count => 1, timeout => 5 )) {
+    
+        my $xml = $resp->content;
+        last unless (defined $xml);
+
+        $log->debug("Running open-ils.ingest.full.biblio.xml.readonly ...");
+        my ($res) = $self->method_lookup("open-ils.ingest.full.biblio.xml.readonly")->run($xml);
+
+        $client->respond( $res );
+    }
+
+    return undef;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.biblio.xml_stream.readonly",
+    method        => "ro_biblio_ingest_stream_xml",
+    api_level    => 1,
+    stream        => 1,
+);                      
+
+sub rw_biblio_ingest_stream_import {
+    my $self = shift;
+    my $client = shift;
+
+    OpenILS::Application::Ingest->post_init();
+
+    my $ses = OpenSRF::AppSession->create('open-ils.cstore');
+
+    while (my ($resp) = $client->recv( count => 1, timeout => 5 )) {
+    
+        my $bib = $resp->content;
+        last unless (defined $bib);
+
+        $log->debug("Running open-ils.ingest.full.biblio.xml.readonly ...");
+        my ($res) = $self->method_lookup("open-ils.ingest.full.biblio.xml.readonly")->run($bib->marc);
+
+        $_->source($bib->id) for (@{$res->{field_entries}});
+        $_->record($bib->id) for (@{$res->{full_rec}});
+
+        $client->respond( $res );
+    }
+
+    return undef;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.biblio.bib_stream.import",
+    method        => "rw_biblio_ingest_stream_import",
+    api_level    => 1,
+    stream        => 1,
+);                      
+
+
+# --------------------------------------------------------------------------------
+# Authority ingest
+
+package OpenILS::Application::Ingest::Authority;
+use base qw/OpenILS::Application::Ingest/;
+use Unicode::Normalize;
+
+sub rw_authority_ingest_single_object {
+    my $self = shift;
+    my $client = shift;
+    my $auth = shift;
+
+    my ($blob) = $self->method_lookup("open-ils.ingest.full.authority.object.readonly")->run($auth);
+    return undef unless ($blob);
+
+    my $cstore = OpenSRF::AppSession->connect('open-ils.cstore');
+
+    my $xact = $cstore->request('open-ils.cstore.transaction.begin')->gather(1);
+    my $tmp;
+
+    # update full_rec stuff ...
+    $tmp = $cstore->request(
+        'open-ils.cstore.direct.authority.full_rec.id_list.atomic',
+        { record => $auth->id }
+    )->gather(1);
+
+    $cstore->request( 'open-ils.cstore.direct.authority.full_rec.delete' => $_ )->gather(1) for (@$tmp);
+    $cstore->request( 'open-ils.cstore.direct.authority.full_rec.create' => $_ )->gather(1) for (@{ $blob->{full_rec} });
+
+    # XXX when we start extracting authority descriptors and adding sources ...
+    #
+    # update rec_descriptor stuff ...
+    #$tmp = $cstore->request(
+    #    'open-ils.cstore.direct.authority.record_descriptor.id_list.atomic',
+    #    { record => $auth->id }
+    #)->gather(1);
+    #
+    #$cstore->request( 'open-ils.cstore.direct.authority.record_descriptor.delete' => $_ )->gather(1) for (@$tmp);
+    #$cstore->request( 'open-ils.cstore.direct.authority.record_descriptor.create' => $blob->{descriptor} )->gather(1);
+    #$cstore->request( 'open-ils.cstore.direct.authority.record_entry.update' => $auth )->gather(1);
+
+    $cstore->request( 'open-ils.cstore.transaction.commit' )->gather(1) || return undef;;
+    $cstore->disconnect;
+
+    return $auth->id;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.authority.object",
+    method        => "rw_authority_ingest_single_object",
+    api_level    => 1,
+    argc        => 1,
+);                      
+
+sub rw_authority_ingest_single_record {
+    my $self = shift;
+    my $client = shift;
+    my $rec = shift;
+
+    OpenILS::Application::Ingest->post_init();
+    my $cstore = OpenSRF::AppSession->connect( 'open-ils.cstore' );
+    $cstore->request('open-ils.cstore.transaction.begin')->gather(1);
+
+    my $r = $cstore->request( 'open-ils.cstore.direct.authority.record_entry.retrieve' => $rec )->gather(1);
+
+    $cstore->request('open-ils.cstore.transaction.rollback')->gather(1);
+    $cstore->disconnect;
+
+    return undef unless ($r and @$r);
+
+    return ($self->method_lookup("open-ils.ingest.full.authority.object")->run($r))[0];
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.authority.record",
+    method        => "rw_authority_ingest_single_record",
+    api_level    => 1,
+    argc        => 1,
+);                      
+
+sub ro_authority_ingest_single_object {
+    my $self = shift;
+    my $client = shift;
+    my $bib = shift;
+    my $xml = OpenILS::Application::AppUtils->entityize($bib->marc);
+
+    my $document = $parser->parse_string($xml);
+
+    my @mfr = $self->method_lookup("open-ils.ingest.flat_marc.authority.xml")->run($document);
+
+    $_->record($bib->id) for (@mfr);
+
+    return { full_rec => \@mfr };
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.authority.object.readonly",
+    method        => "ro_authority_ingest_single_object",
+    api_level    => 1,
+    argc        => 1,
+);                      
+
+sub ro_authority_ingest_single_xml {
+    my $self = shift;
+    my $client = shift;
+    my $xml = OpenILS::Application::AppUtils->entityize(shift);
+
+    my $document = $parser->parse_string($xml);
+
+    my @mfr = $self->method_lookup("open-ils.ingest.flat_marc.authority.xml")->run($document);
+
+    return { full_rec => \@mfr };
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.authority.xml.readonly",
+    method        => "ro_authority_ingest_single_xml",
+    api_level    => 1,
+    argc        => 1,
+);                      
+
+sub ro_authority_ingest_single_record {
+    my $self = shift;
+    my $client = shift;
+    my $rec = shift;
+
+    OpenILS::Application::Ingest->post_init();
+    my $r = OpenSRF::AppSession
+            ->create('open-ils.cstore')
+            ->request( 'open-ils.cstore.direct.authority.record_entry.retrieve' => $rec )
+            ->gather(1);
+
+    return undef unless ($r and @$r);
+
+    my ($res) = $self->method_lookup("open-ils.ingest.full.authority.xml.readonly")->run($r->marc);
+
+    $_->record($rec) for (@{$res->{full_rec}});
+    $res->{descriptor}->record($rec);
+
+    return $res;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.authority.record.readonly",
+    method        => "ro_authority_ingest_single_record",
+    api_level    => 1,
+    argc        => 1,
+);                      
+
+sub ro_authority_ingest_stream_record {
+    my $self = shift;
+    my $client = shift;
+
+    OpenILS::Application::Ingest->post_init();
+
+    my $ses = OpenSRF::AppSession->create('open-ils.cstore');
+
+    while (my ($resp) = $client->recv( count => 1, timeout => 5 )) {
+    
+        my $rec = $resp->content;
+        last unless (defined $rec);
+
+        $log->debug("Running open-ils.ingest.full.authority.record.readonly ...");
+        my ($res) = $self->method_lookup("open-ils.ingest.full.authority.record.readonly")->run($rec);
+
+        $_->record($rec) for (@{$res->{full_rec}});
+
+        $client->respond( $res );
+    }
+
+    return undef;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.authority.record_stream.readonly",
+    method        => "ro_authority_ingest_stream_record",
+    api_level    => 1,
+    stream        => 1,
+);                      
+
+sub ro_authority_ingest_stream_xml {
+    my $self = shift;
+    my $client = shift;
+
+    OpenILS::Application::Ingest->post_init();
+
+    my $ses = OpenSRF::AppSession->create('open-ils.cstore');
+
+    while (my ($resp) = $client->recv( count => 1, timeout => 5 )) {
+    
+        my $xml = $resp->content;
+        last unless (defined $xml);
+
+        $log->debug("Running open-ils.ingest.full.authority.xml.readonly ...");
+        my ($res) = $self->method_lookup("open-ils.ingest.full.authority.xml.readonly")->run($xml);
+
+        $client->respond( $res );
+    }
+
+    return undef;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.authority.xml_stream.readonly",
+    method        => "ro_authority_ingest_stream_xml",
+    api_level    => 1,
+    stream        => 1,
+);                      
+
+sub rw_authority_ingest_stream_import {
+    my $self = shift;
+    my $client = shift;
+
+    OpenILS::Application::Ingest->post_init();
+
+    my $ses = OpenSRF::AppSession->create('open-ils.cstore');
+
+    while (my ($resp) = $client->recv( count => 1, timeout => 5 )) {
+    
+        my $bib = $resp->content;
+        last unless (defined $bib);
+
+        $log->debug("Running open-ils.ingest.full.authority.xml.readonly ...");
+        my ($res) = $self->method_lookup("open-ils.ingest.full.authority.xml.readonly")->run($bib->marc);
+
+        $_->record($bib->id) for (@{$res->{full_rec}});
+
+        $client->respond( $res );
+    }
+
+    return undef;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.full.authority.bib_stream.import",
+    method        => "rw_authority_ingest_stream_import",
+    api_level    => 1,
+    stream        => 1,
+);                      
+
+# --------------------------------------------------------------------------------
+# MARC index extraction
+
+package OpenILS::Application::Ingest::XPATH;
+use base qw/OpenILS::Application::Ingest/;
+use Unicode::Normalize;
+
+# give this an XML documentElement and an XPATH expression
+sub xpath_to_string {
+    my $xml = shift;
+    my $xpath = shift;
+    my $ns_uri = shift;
+    my $ns_prefix = shift;
+    my $unique = shift;
+
+    $xml->setNamespace( $ns_uri, $ns_prefix, 1 ) if ($ns_uri && $ns_prefix);
+
+    my $string = "";
+
+    # grab the set of matching nodes
+    my @nodes = $xml->findnodes( $xpath );
+    for my $value (@nodes) {
+
+        # grab all children of the node
+        my @children = $value->childNodes();
+        for my $child (@children) {
+
+            # add the childs content to the growing buffer
+            my $content = quotemeta($child->textContent);
+            next if ($unique && $string =~ /$content/);  # uniquify the values
+            $string .= $child->textContent . " ";
+        }
+        if( ! @children ) {
+            $string .= $value->textContent . " ";
+        }
+    }
+
+    $string =~ s/(\w+)\/(\w+)/$1 $2/sgo;
+    # Split date ranges and ISSNs on the hyphen
+    $string =~ s/(\d{4})-(\d{3,4}x?)/ $1 $2 /goi;
+
+    return NFD($string);
+}
+
+sub class_index_string_xml {
+    my $self = shift;
+    my $client = shift;
+    my $xml = shift;
+    my @classes = @_;
+
+    OpenILS::Application::Ingest->post_init();
+    $xml = $parser->parse_string(OpenILS::Application::AppUtils->entityize($xml)) unless (ref $xml);
+
+    my %transform_cache;
+    
+    for my $class (@classes) {
+        my $class_constructor = "Fieldmapper::metabib::${class}_field_entry";
+        for my $type ( keys %{ $xpathset->{$class} } ) {
+
+            my $def = $xpathset->{$class}->{$type};
+            my $sf = $OpenILS::Application::Ingest::supported_formats{$def->{format}};
+
+            my $document = $xml;
+
+            if ($sf->{xslt}) {
+                $document = $transform_cache{$def->{format}} || $sf->{xslt}->transform($xml);
+                $transform_cache{$def->{format}} = $document;
+            }
+
+            my $value =  xpath_to_string(
+                    $document->documentElement    => $def->{xpath},
+                    $sf->{ns}            => $def->{format},
+                    1
+            );
+
+            next unless $value;
+
+            $value = NFD($value);
+            $value =~ s/\pM+//sgo;
+            $value =~ s/\pC+//sgo;
+            $value =~ s/\W+$//sgo;
+
+            # hack to normalize ratio-like strings
+            while ($term =~ /\b\d{1}:[, ]?\d+(?:[ ,]\d+[^:])+/o) {
+                $term = $` . join ('', split(/[, ]/, $&)) . $';
+            }
+
+            $value =~ s/\b\.+\b//sgo;
+            $value = lc($value);
+
+            my $fm = $class_constructor->new;
+            $fm->value( $value );
+            $fm->field( $xpathset->{$class}->{$type}->{id} );
+            $client->respond($fm);
+        }
+    }
+    return undef;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.field_entry.class.xml",
+    method        => "class_index_string_xml",
+    api_level    => 1,
+    argc        => 2,
+    stream        => 1,
+);                      
+
+sub class_index_string_record {
+    my $self = shift;
+    my $client = shift;
+    my $rec = shift;
+    my @classes = shift;
+
+    OpenILS::Application::Ingest->post_init();
+    my $r = OpenSRF::AppSession
+            ->create('open-ils.cstore')
+            ->request( 'open-ils.cstore.direct.authority.record_entry.retrieve' => $rec )
+            ->gather(1);
+
+    return undef unless ($r and @$r);
+
+    for my $fm ($self->method_lookup("open-ils.ingest.field_entry.class.xml")->run($r->marc, @classes)) {
+        $fm->source($rec);
+        $client->respond($fm);
+    }
+    return undef;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.field_entry.class.record",
+    method        => "class_index_string_record",
+    api_level    => 1,
+    argc        => 2,
+    stream        => 1,
+);                      
+
+sub all_index_string_xml {
+    my $self = shift;
+    my $client = shift;
+    my $xml = shift;
+
+    for my $fm ($self->method_lookup("open-ils.ingest.field_entry.class.xml")->run($xml, keys(%$xpathset))) {
+        $client->respond($fm);
+    }
+    return undef;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.extract.field_entry.all.xml",
+    method        => "all_index_string_xml",
+    api_level    => 1,
+    argc        => 1,
+    stream        => 1,
+);                      
+
+sub all_index_string_record {
+    my $self = shift;
+    my $client = shift;
+    my $rec = shift;
+
+    OpenILS::Application::Ingest->post_init();
+    my $r = OpenSRF::AppSession
+            ->create('open-ils.cstore')
+            ->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve' => $rec )
+            ->gather(1);
+
+    return undef unless ($r and @$r);
+
+    for my $fm ($self->method_lookup("open-ils.ingest.field_entry.class.xml")->run($r->marc, keys(%$xpathset))) {
+        $fm->source($rec);
+        $client->respond($fm);
+    }
+    return undef;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.extract.field_entry.all.record",
+    method        => "all_index_string_record",
+    api_level    => 1,
+    argc        => 1,
+    stream        => 1,
+);                      
+
+# --------------------------------------------------------------------------------
+# Flat MARC
+
+package OpenILS::Application::Ingest::FlatMARC;
+use base qw/OpenILS::Application::Ingest/;
+use Unicode::Normalize;
+
+
+sub _marcxml_to_full_rows {
+
+    my $marcxml = shift;
+    my $xmltype = shift || 'metabib';
+
+    my $type = "Fieldmapper::${xmltype}::full_rec";
+
+    my @ns_list;
+    
+    my ($root) = $marcxml->findnodes('//*[local-name()="record"]');
+
+    for my $tagline ( @{$root->getChildrenByTagName("leader")} ) {
+        next unless $tagline;
+        _special_tag_to_full_rows($type, $tagline, \@ns_list, 'LDR');
+    }
+
+    for my $tagline ( @{$root->getChildrenByTagName("controlfield")} ) {
+        next unless $tagline;
+        _special_tag_to_full_rows($type, $tagline, \@ns_list, $tagline->getAttribute( "tag" ));
+    }
+
+    for my $tagline ( @{$root->getChildrenByTagName("datafield")} ) {
+        next unless $tagline;
+        _data_tag_to_full_rows($type, $tagline, \@ns_list, $tagline->getAttribute( "tag" ));
+
+        if ($xmltype eq 'metabib' and $tag eq '245') {
+            _data_tag_to_full_rows($type, $tagline, \@ns_list, 'tnf');
+        }
+    }
+
+    $log->debug("Returning ".scalar(@ns_list)." Fieldmapper nodes from $xmltype xml");
+    return @ns_list;
+}
+
+=head2 _special_tag_to_full_rows
+
+Converts a leader or control field to a set of normalized values
+
+=cut
+
+sub _special_tag_to_full_rows {
+    my $type = shift;
+    my $tagline = shift;
+    my $ns_list = shift;
+    my $tagname = shift;
+
+    my $ns = $type->new;
+
+    $ns->tag( $tagname );
+    my $val = $tagline->textContent;
+    $val = NFD($val);
+    $val =~ s/\pM+//sgo;
+    $val =~ s/\pC+//sgo;
+    $val =~ s/\W+$//sgo;
+    $ns->value( $val );
+
+    push @$ns_list, $ns;
+}
+
+=head2 _data_tag_to_full_rows
+
+Converts a data field to a set of normalized values
+
+=cut
+
+sub _data_tag_to_full_rows {
+    my $type = shift;
+    my $tagline = shift;
+    my $ns_list = shift;
+    my $tag = shift;
+
+    my $ind1 = $tagline->getAttribute( "ind1" );
+    my $ind2 = $tagline->getAttribute( "ind2" );
+
+    for my $data ( @{$tagline->getChildrenByTagName('subfield')} ) {
+        next unless $data;
+
+        my $ns = $type->new;
+
+        $ns->tag( $tag );
+        $ns->ind1( $ind1 );
+        $ns->ind2( $ind2 );
+        $ns->subfield( $data->getAttribute( "code" ) );
+        my $val = $data->textContent;
+        $val = NFD($val);
+        $val =~ s/\pM+//sgo;
+        $val =~ s/\pC+//sgo;
+        $val =~ s/\W+$//sgo;
+        # Split date ranges and ISSNs on the hyphen
+        $val =~ s/(\d{4})-(\d{3,4}x?)/ $1 $2 /goi;
+        $val =~ s/(\w+)\/(\w+)/$1 $2/sgo;
+        $ns->value( lc($val) );
+
+        push @$ns_list, $ns;
+    }
+}
+
+sub flat_marc_xml {
+    my $self = shift;
+    my $client = shift;
+    my $xml = shift;
+
+    $log->debug("processing [$xml]");
+
+    $xml = $parser->parse_string(OpenILS::Application::AppUtils->entityize($xml)) unless (ref $xml);
+
+    my $type = 'metabib';
+    $type = 'authority' if ($self->api_name =~ /authority/o);
+
+    OpenILS::Application::Ingest->post_init();
+
+    $client->respond($_) for (_marcxml_to_full_rows($xml, $type));
+    return undef;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.flat_marc.authority.xml",
+    method        => "flat_marc_xml",
+    api_level    => 1,
+    argc        => 1,
+    stream        => 1,
+);                      
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.flat_marc.biblio.xml",
+    method        => "flat_marc_xml",
+    api_level    => 1,
+    argc        => 1,
+    stream        => 1,
+);                      
+
+sub flat_marc_record {
+    my $self = shift;
+    my $client = shift;
+    my $rec = shift;
+
+    my $type = 'biblio';
+    $type = 'authority' if ($self->api_name =~ /authority/o);
+
+    OpenILS::Application::Ingest->post_init();
+    my $r = OpenSRF::AppSession
+            ->create('open-ils.cstore')
+            ->request( "open-ils.cstore.direct.${type}.record_entry.retrieve" => $rec )
+            ->gather(1);
+
+
+    return undef unless ($r and $r->marc);
+
+    my @rows = $self->method_lookup("open-ils.ingest.flat_marc.$type.xml")->run($r->marc);
+    for my $row (@rows) {
+        $client->respond($row);
+        $log->debug(OpenSRF::Utils::JSON->perl2JSON($row), DEBUG);
+    }
+    return undef;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.flat_marc.biblio.record_entry",
+    method        => "flat_marc_record",
+    api_level    => 1,
+    argc        => 1,
+    stream        => 1,
+);                      
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.flat_marc.authority.record_entry",
+    method        => "flat_marc_record",
+    api_level    => 1,
+    argc        => 1,
+    stream        => 1,
+);                      
+
+# --------------------------------------------------------------------------------
+# URI extraction
+
+package OpenILS::Application::Ingest::Biblio::URI;
+use base qw/OpenILS::Application::Ingest/;
+use Unicode::Normalize;
+use OpenSRF::EX qw/:try/;
+
+
+sub _extract_856_uris {
+
+    my $rec   = shift;
+    my $max_cn = shift;
+    my $max_uri = shift;
+    my @objects;
+    
+    my $recid = $rec->id;
+    my $marcxml = $rec->marc;
+
+    my $document = $parser->parse_string($marcxml);
+    my @nodes = $document->findnodes('//*[local-name()="datafield" and @tag="856" and (@ind1="4" or @ind1="1") and (@ind2="0" or @ind2="1")]');
+
+    my $cstore = OpenSRF::AppSession->connect('open-ils.cstore');
+
+    my %cn_cache;
+
+    for my $node (@nodes) {
+        # first, is there a URI?
+        my $href = $node->findvalue('*[local-name()="subfield" and @code="u"]/text()');
+        next unless ($href);
+
+        # now, find the best possible label
+        my $label = $node->findvalue('*[local-name()="subfield" and @code="y"]/text()');
+        $label ||= $node->findvalue('*[local-name()="subfield" and @code="3"]/text()');
+        $label ||= $href;
+
+        # look for use info
+        my $use = $node->findvalue('*[local-name()="subfield" and @code="z"]/text()');
+        $use ||= $node->findvalue('*[local-name()="subfield" and @code="2"]/text()');
+        $use ||= $node->findvalue('*[local-name()="subfield" and @code="n"]/text()');
+
+        # moving on to the URI owner
+        my $owner = $node->findvalue('*[local-name()="subfield" and @code="9"]/text()'); # Evergreen special sauce
+        $owner ||= $node->findvalue('*[local-name()="subfield" and @code="w"]/text()');
+        $owner ||= $node->findvalue('*[local-name()="subfield" and @code="n"]/text()');
+
+        $owner =~ s/^.*?\((\w+)\).*$/$1/o; # unwrap first paren-enclosed string and then ...
+
+        # no owner? skip it :(
+        next unless ($owner);
+
+        my $org = $cstore
+            ->request( 'open-ils.cstore.direct.actor.org_unit.search' => { shortname => $owner} )
+            ->gather(1);
+
+        next unless ($org);
+
+        # now we can construct the uri object
+        my $uri = $cstore
+            ->request( 'open-ils.cstore.direct.asset.uri.search' => { label => $label, href => $href, use_restriction => $use, active => 't' } )
+            ->gather(1);
+
+        if (!$uri) {
+            $uri = Fieldmapper::asset::uri->new;
+            $uri->isnew( 1 );
+            $uri->id( $$max_uri++ );
+            $uri->label($label);
+            $uri->href($href);
+            $uri->active('t');
+            $uri->use_restriction($use);
+        }
+
+        # see if we need to create a call number
+        my $cn = $cn_cache{$org->id};
+        $cn = $cn->clone if ($cn);
+        $cn->clear_isnew if ($cn);
+
+        $cn ||= $cstore
+            ->request( 'open-ils.cstore.direct.asset.call_number.search' => { owning_lib => $org->id, record => $recid, label => '##URI##' } )
+            ->gather(1);
+
+        if (!$cn) {
+            $cn = Fieldmapper::asset::call_number->new;
+            $cn->isnew( 1 );
+            $cn->deleted('f');
+            $cn->id( $$max_cn++ );
+            $cn->owning_lib( $org->id );
+            $cn->record( $recid );
+            $cn->create_date( 'now' );
+            $cn->creator( $rec->creator );
+            $cn->editor( $rec->editor );
+            $cn->edit_date( 'now' );
+            $cn->label( '##URI##' );
+        }
+
+        $cn_cache{$org->id} = $cn;
+
+        push @objects, { uri => $uri, call_number => $cn };
+    }
+
+    $log->debug("Returning ".scalar(@objects)." URI nodes for record $recid");
+    $cstore->disconnect;
+    return @objects;
+}
+
+sub get_uris_record {
+    my $self = shift;
+    my $client = shift;
+    my $rec = shift;
+
+    OpenILS::Application::Ingest->post_init();
+    my $r = OpenSRF::AppSession
+            ->create('open-ils.cstore')
+            ->request( "open-ils.cstore.direct.biblio.record_entry.retrieve" => $rec )
+            ->gather(1);
+
+    return undef unless ($r and $r->marc);
+
+    $client->respond($_) for (_extract_856_uris($r));
+    return undef;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.856_uri.record",
+    method        => "get_uris_record",
+    api_level    => 1,
+    argc        => 1,
+    stream        => 1,
+);                      
+
+sub get_uris_object {
+    my $self = shift;
+    my $client = shift;
+    my $obj = shift;
+    my $max_cn = shift;
+    my $max_uri = shift;
+
+    return undef unless ($obj and $obj->marc);
+
+    $client->respond($_) for (_extract_856_uris($obj, \$max_cn, \$max_uri));
+    return undef;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.856_uri.object",
+    method        => "get_uris_object",
+    api_level    => 1,
+    argc        => 1,
+    stream        => 1,
+);                      
+
+
+# --------------------------------------------------------------------------------
+# Fingerprinting
+
+package OpenILS::Application::Ingest::Biblio::Fingerprint;
+use base qw/OpenILS::Application::Ingest/;
+use Unicode::Normalize;
+use OpenSRF::EX qw/:try/;
+
+sub biblio_fingerprint_record {
+    my $self = shift;
+    my $client = shift;
+    my $rec = shift;
+
+    OpenILS::Application::Ingest->post_init();
+
+    my $r = OpenSRF::AppSession
+            ->create('open-ils.cstore')
+            ->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve' => $rec )
+            ->gather(1);
+
+    return undef unless ($r and $r->marc);
+
+    my ($fp) = $self->method_lookup('open-ils.ingest.fingerprint.xml')->run($r->marc);
+    $log->debug("Returning [$fp] as fingerprint for record $rec", INFO);
+    $fp->{quality} = int($fp->{quality});
+    return $fp;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.fingerprint.record",
+    method        => "biblio_fingerprint_record",
+    api_level    => 1,
+    argc        => 1,
+);                      
+
+our $fp_script;
+sub biblio_fingerprint {
+    my $self = shift;
+    my $client = shift;
+    my $xml = OpenILS::Application::AppUtils->entityize(shift);
+
+    $log->internal("Got MARC [$xml]");
+
+    if(!$fp_script) {
+        my @pfx = ( "apps", "open-ils.ingest","app_settings" );
+        my $conf = OpenSRF::Utils::SettingsClient->new;
+
+        my $libs        = $conf->config_value(@pfx, 'script_path');
+        my $script_file = $conf->config_value(@pfx, 'scripts', 'biblio_fingerprint');
+        my $script_libs = (ref($libs)) ? $libs : [$libs];
+
+        $log->debug("Loading script $script_file for biblio fingerprinting...");
+        
+        $fp_script = new OpenILS::Utils::ScriptRunner
+            ( file        => $script_file,
+              paths        => $script_libs,
+              reset_count    => 100 );
+    }
+
+    $fp_script->insert('environment' => {marc => $xml} => 1);
+
+    my $res = $fp_script->run || ($log->error( "Fingerprint script died!  $@" ) && return undef);
+    $log->debug("Script for biblio fingerprinting completed successfully...");
+
+    return $res;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.fingerprint.xml",
+    method        => "biblio_fingerprint",
+    api_level    => 1,
+    argc        => 1,
+);                      
+
+our $rd_script;
+sub biblio_descriptor {
+    my $self = shift;
+    my $client = shift;
+    my $xml = OpenILS::Application::AppUtils->entityize(shift);
+
+    $log->internal("Got MARC [$xml]");
+
+    if(!$rd_script) {
+        my @pfx = ( "apps", "open-ils.ingest","app_settings" );
+        my $conf = OpenSRF::Utils::SettingsClient->new;
+
+        my $libs        = $conf->config_value(@pfx, 'script_path');
+        my $script_file = $conf->config_value(@pfx, 'scripts', 'biblio_descriptor');
+        my $script_libs = (ref($libs)) ? $libs : [$libs];
+
+        $log->debug("Loading script $script_file for biblio descriptor extraction...");
+        
+        $rd_script = new OpenILS::Utils::ScriptRunner
+            ( file        => $script_file,
+              paths        => $script_libs,
+              reset_count    => 100 );
+    }
+
+    $log->debug("Setting up environment for descriptor extraction script...");
+    $rd_script->insert('environment.marc' => $xml => 1);
+    $log->debug("Environment building complete...");
+
+    my $res = $rd_script->run || ($log->error( "Descriptor script died!  $@" ) && return undef);
+    $log->debug("Script for biblio descriptor extraction completed successfully");
+
+    my $d1 = $res->date1;
+    if ($d1 && $d1 ne '    ') {
+        $d1 =~ tr/ux/00/;
+        $res->date1( $d1 );
+    }
+
+    my $d2 = $res->date2;
+    if ($d2 && $d2 ne '    ') {
+        $d2 =~ tr/ux/99/;
+        $res->date2( $d2 );
+    }
+
+    return $res;
+}
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.ingest.descriptor.xml",
+    method        => "biblio_descriptor",
+    api_level    => 1,
+    argc        => 1,
+);                      
+
+
+1;
+
+# vim:et:ts=4:sw=4:
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Penalty.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Penalty.pm
new file mode 100644
index 0000000000..48a893e48d
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Penalty.pm
@@ -0,0 +1,41 @@
+package OpenILS::Application::Penalty;
+use strict; use warnings;
+use OpenSRF::EX qw(:try);
+use OpenILS::Application;
+use OpenILS::Utils::Penalty;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use base 'OpenILS::Application';
+
+__PACKAGE__->register_method (
+	method	 => 'patron_penalty',
+	api_name	 => 'open-ils.penalty.patron_penalty.calculate',
+	signature => q/
+		Calculates the patron's standing penalties
+		@param args An object of named params including:
+			patronid The id of the patron
+			update True if this call should update the database
+			background True if this call should return immediately,
+				then go on to process the penalties.  This flag
+				works only in conjunction with the 'update' flag.
+		@return An object with keys 'fatal_penalties' and 
+		'info_penalties' who are themeselves arrays of 0 or 
+		more penalties.  Returns event on error.
+	/
+);
+
+# --------------------------------------------------------------
+# if $args->{background} is true, immediately respond complete 
+# to the caller, then finish the calculation
+# --------------------------------------------------------------
+sub patron_penalty {
+	my( $self, $conn, $args ) = @_;
+	$conn->respond_complete(1) if $$args{background};
+    my $e = new_editor(xact => 1);
+    OpenILS::Utils::Penalty->calculate_penalties($e, $args->{patronid}, $args->{context_org});
+    my $p = OpenILS::Utils::Penalty->retrieve_penalties($e, $args->{patronid}, $args->{context_org});
+    $e->commit;
+    return $p
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/PermaCrud.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/PermaCrud.pm
new file mode 100644
index 0000000000..0d1e7646e7
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/PermaCrud.pm
@@ -0,0 +1,281 @@
+# vim:et:ts=4:sw=4:
+
+package OpenILS::Application::PermaCrud;
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+use Unicode::Normalize;
+use OpenSRF::EX qw/:try/;
+
+use OpenSRF::AppSession;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Logger qw/:level/;
+
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::JSON;
+
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+
+use XML::LibXML;
+use XML::LibXML::XPathContext;
+use XML::LibXSLT;
+use OpenILS::Event;
+
+our %namespace_map = (
+    oils_persist=> {ns => 'http://open-ils.org/spec/opensrf/IDL/persistence/v1'},
+    oils_obj    => {ns => 'http://open-ils.org/spec/opensrf/IDL/objects/v1'},
+    idl         => {ns => 'http://opensrf.org/spec/IDL/base/v1'},
+    reporter    => {ns => 'http://open-ils.org/spec/opensrf/IDL/reporter/v1'},
+    perm        => {ns => 'http://open-ils.org/spec/opensrf/IDL/permacrud/v1'},
+);
+
+
+my $log = 'OpenSRF::Utils::Logger';
+
+my $parser = XML::LibXML->new();
+my $xslt = XML::LibXSLT->new();
+
+my $xpc = XML::LibXML::XPathContext->new();
+$xpc->registerNs($_, $namespace_map{$_}{ns}) for ( keys %namespace_map );
+
+my $idl;
+
+sub initialize {
+
+    my $conf = OpenSRF::Utils::SettingsClient->new;
+    my $idl_file = $conf->config_value( 'IDL' );
+
+    $idl = $parser->parse_file( $idl_file );
+
+    $log->debug( 'IDL XML file loaded' );
+
+    generate_methods();
+
+}
+sub child_init {}
+
+sub CRUD_action_object_permcheck {
+    my $self = shift;
+    my $client = shift;
+    my $auth = shift;
+    my $obj = shift;
+
+    my $e = shift || new_editor(authtoken => $auth, xact => 1);
+    return $e->event unless $e->checkauth;
+
+    if (ref($obj) && $obj->json_hint ne $self->{class_hint}) {
+        throw OpenSRF::DomainObject::oilsException->new(
+            statusCode => 500,
+            status => "Class missmatch: $self->{class_hint} method called with " . $obj->json_hint,
+        );
+    }
+
+    my $class_node;
+    my $error = '';
+    try {
+        ($class_node) = $xpc->findnodes( "//idl:class[\@id='$self->{class_hint}']", $idl->documentElement );
+    } catch Error with {
+        $error = shift;
+        $log->error("Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]");
+        throw OpenSRF::DomainObject::oilsException->new(
+            statusCode => 500,
+            status => "Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]"
+        );
+    };
+
+    if (!$class_node) {
+        $log->error("Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]");
+        throw OpenSRF::DomainObject::oilsException->new(
+            statusCode => 500,
+            status => "Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]"
+        );
+    }
+
+    my $action_node;
+    try {
+        ($action_node) = $xpc->findnodes( "perm:permacrud/perm:actions/perm:$self->{action}", $class_node );
+    } catch Error with {
+        $error = shift;
+        $log->error("Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]");
+        throw OpenSRF::DomainObject::oilsException->new(
+            statusCode => 500,
+            status => "Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]"
+        );
+    };
+
+    if (!$action_node) {
+        $log->error("Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]");
+        throw OpenSRF::DomainObject::oilsException->new(
+            statusCode => 500,
+            status => "Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]"
+        );
+    }
+
+    my $all_perms = $action_node->getAttribute( 'all_perms' );
+
+    my $fm_class = $xpc->findvalue( '@oils_obj:fieldmapper', $class_node );
+    if (!ref($obj)) {
+        my $retrieve_method = 'retrieve_' . $fm_class;
+        $retrieve_method =~ s/::/_/go;
+        $obj = $e->$retrieve_method( $obj ) or return $e->die_event;
+    }
+
+    (my $o_type = $fm_class) =~ s/::/./go;
+
+    my $perm_field_value = $action_node->getAttribute('permission');
+
+    if ($perm_field_value) {
+        my @perms = split ' ', $perm_field_value;
+
+        my @context_ous;
+        if ($action_node->getAttribute('global_required')) {
+            push @context_ous, $e->search_actor_org_unit( { parent_ou => undef } )->[0]->id;
+
+        } else {
+            my $context_field_value = $action_node->getAttribute('context_field');
+
+            if ($context_field_value) {
+                push @context_ous, $obj->$_ for ( split ' ', $context_field_value );
+            } else {  
+                for my $context_node ( $xpc->findnodes( "perm:context", $action_node ) ) {
+                    my $context_field = $context_node->getAttribute('field');
+                    my $link_field = $context_node->getAttribute('link');
+
+                    if ($link_field) {
+
+                        my ($link_node) = $xpc->findnodes( "idl:links/idl:link[\@field='$link_field']", $class_node );
+                        my $link_class_hint = $link_node->getAttribute('class');
+                        my $remote_field = $link_node->getAttribute('key');
+
+                        my ($remote_class_node) = $xpc->findnodes( "//idl:class[\@id='$link_class_hint']", $idl->documentElement );
+                        my $search_method = 'search_' . $xpc->findvalue( '@oils_obj:fieldmapper', $remote_class_node );
+                        $search_method =~ s/::/_/go;
+
+                        for my $remote_object ( @{$e->$search_method( { $remote_field => $obj->$link_field } )} ) {
+                            push @context_ous, $remote_object->$context_field;
+                        }
+                    } else {
+                        push @context_ous, $obj->$_ for ( split ' ', $context_field );
+                    }
+                }
+            }
+        }
+
+        my $pok = 0;
+        for my $perm (@perms) {
+            if (@context_ous) {
+                for my $c_ou (@context_ous) {
+                    if ($e->allowed($perm => $c_ou => $obj)) {
+                        $pok++;
+                        last;
+                    }
+                }
+            } else {
+                $pok++ if ($e->allowed($perm => undef => $obj));
+            }
+        }
+
+        if ((lc($all_perms) eq 'true' && @perms != $pok) or !$pok) {
+	        return OpenILS::Event->new('PERM_FAILURE', 
+                ilsperm => "", # XXX add logic to report which perm failed
+                ilspermloc => "",
+                payload => "Perm failure -- action: $self->{action}, object type: $self->{json_hint}",
+            );
+        }
+    }
+
+    if ($self->{action} eq 'retrieve') {
+        $e->rollback;
+        return $obj;
+    }
+
+    $o_type =~ s/\./_/og;
+    my $method = $self->{action} . "_$o_type";
+    my $val = $e->$method($obj) or return $e->die_event;
+    $e->commit;
+
+    return $val;
+}
+
+sub search_permacrud {
+    my $self = shift;
+    my $client = shift;
+    my $auth = shift;
+    my @args = @_;
+
+    if (@args > 1) {
+        delete $args[1]{flesh};
+        delete $args[1]{flesh_fields};
+    }
+
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->event unless $e->checkauth;
+ 
+    my $class_node;
+    try {
+        ($class_node) = $xpc->findnodes( "//idl:class[\@id='$self->{class_hint}']", $idl->documentElement );
+    } catch Error with {
+        my $error = shift;
+        $log->error("Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]");
+        throw OpenSRF::DomainObject::oilsException->new(
+            statusCode => 500,
+            status => "Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]"
+        );
+    };
+
+    my $search_method = 'search_' . $xpc->findvalue( '@oils_obj:fieldmapper', $class_node );
+    $search_method =~ s/::/_/go;
+
+    $log->debug("Calling CStoreEditor search method: $search_method");
+
+    my $obj_list = $e->$search_method( \@args );
+
+    my $retriever = $self->method_lookup( $self->{retriever} );
+    for my $o ( @$obj_list ) {
+        try {
+            ($o) = $retriever->run( $auth, $o, $e );
+            $client->respond( $o ) if ($o);
+        };
+    }
+
+    return undef;
+}
+
+sub generate_methods {
+    try {
+        for my $class_node ( $xpc->findnodes( '//idl:class[perm:permacrud]', $idl->documentElement ) ) {
+            my $hint = $class_node->getAttribute('id');
+            $log->debug("permacrud class_node $hint");
+        
+            for my $action_node ( $xpc->findnodes( "perm:permacrud/perm:actions/perm:*", $class_node ) ) {
+                (my $method = $action_node->localname) =~ s/^.+:(.+)$/$1/o;
+                $log->internal("permacrud method = $method");
+        
+                __PACKAGE__->register_method(
+                    method          => 'CRUD_action_object_permcheck',
+                    api_name        => 'open-ils.permacrud.' . $method . '.' . $hint,
+                    class_hint      => $hint,
+                    action          => $method,
+                );
+        
+                if ($method eq 'retrieve') {
+                    __PACKAGE__->register_method(
+                        method          => 'search_permacrud',
+                        api_name        => 'open-ils.permacrud.search.' . $hint,
+                        class_hint      => $hint,
+                        retriever       => 'open-ils.permacrud.retrieve.' . $hint,
+                        stream          => 1
+                    );
+                }
+            }
+        }
+    } catch Error with {
+        my $e = shift;
+        $log->error("error generating permacrud methods: $e");
+    };
+}
+
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Proxy.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Proxy.pm
new file mode 100644
index 0000000000..c355c0e753
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Proxy.pm
@@ -0,0 +1,53 @@
+package OpenILS::Application::Proxy;
+use strict; use warnings;
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+use OpenSRF::EX qw(:try);
+
+
+__PACKAGE__->register_method(
+	method	=> "proxy",
+	api_name	=> "open-ils.proxy.proxy",
+	stream	=> 1,
+);
+
+
+sub proxy {
+	my($self, $client, $user_session, 
+			$server, $method, @params) = @_;
+
+	warn "$user_session - $server - $method\n";
+
+	throw OpenSRF::EX::ERROR ("Not enough args to proxy")
+		unless ($user_session and $server and $method);
+
+
+	my $session = OpenSRF::AppSession->create($server);
+	my $request = $session->request( $method, @params );
+	if(!$request) {
+		throw OpenSRF::EX::ERROR 
+			("No request built on call to session->request( $method, @params )");
+	}
+	
+	$request->wait_complete;
+
+	if( $request->failed() ) { 
+
+		throw OpenSRF::EX::ERROR
+			($request->failed()->stringify());
+
+	} else {
+
+		while( my $response = $request->recv ) {
+			$client->respond( $response->content );
+		}
+	}
+
+	$request->finish();
+	$session->finish();
+	$session->disconnect();
+
+	return undef;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Reporter.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Reporter.pm
new file mode 100644
index 0000000000..1cd1e2ee72
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Reporter.pm
@@ -0,0 +1,626 @@
+package OpenILS::Application::Reporter;
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Application::AppUtils;
+my $U = "OpenILS::Application::AppUtils";
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.folder.create',
+	method => 'create_folder'
+);
+
+sub create_folder {
+	my( $self, $conn, $auth, $type, $folder ) = @_;
+
+	my $e = new_rstore_editor(xact=>1, authtoken=>$auth);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+
+	return 0 if $folder->owner ne $e->requestor->id;
+
+	$folder->owner($e->requestor->id);
+	my $meth = "create_reporter_${type}_folder";
+	$e->$meth($folder) or return $e->die_event;
+	$e->commit;
+
+	return $folder->id;
+}
+
+
+__PACKAGE__->register_method(
+    api_name => 'open-ils.reporter.report.exists',
+    method => 'report_exists',
+    notes => q/
+        Returns 1 if a report with the given name and folder already exists.
+    /
+);
+
+sub report_exists {
+    my( $self, $conn, $auth, $report ) = @_;
+
+    my $e = new_rstore_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('RUN_REPORTS');
+
+    my $existing = $e->search_reporter_report(
+        {folder=>$report->folder, name=>$report->name});
+    return 1 if @$existing;
+    return 0;
+}
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.folder.visible.retrieve',
+	method => 'retrieve_visible_folders'
+);
+
+sub retrieve_visible_folders {
+	my( $self, $conn, $auth, $type ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('RUN_REPORTS');
+
+	my $class = 'rrf';
+	$class = 'rtf' if $type eq 'template';
+	$class = 'rof' if $type eq 'output';
+	my $flesh = {flesh => 1,flesh_fields => { $class => ['owner', 'share_with']}};
+
+	my $meth = "search_reporter_${type}_folder";
+	my $fs = $e->$meth( [{ owner => $e->requestor->id }, $flesh] );
+
+	my @orgs;
+	my $o = $U->storagereq(
+		'open-ils.storage.actor.org_unit.full_path.atomic', $e->requestor->ws_ou);
+	push( @orgs, $_->id ) for @$o;
+
+	my $fs2 = $e->$meth(
+		[
+			{
+				shared => 't', 
+				share_with => \@orgs, 
+				owner => { '!=' => $e->requestor->id } 
+			}, 
+			$flesh
+		]
+	);
+	push( @$fs, @$fs2);
+	return $fs;
+}
+
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.folder_data.retrieve',
+	method => 'retrieve_folder_data'
+);
+
+sub retrieve_folder_data {
+	my( $self, $conn, $auth, $type, $folderid, $limit ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('RUN_REPORTS');
+	my $meth = "search_reporter_${type}";
+	my $class = 'rr';
+	$class = 'rt' if $type eq 'template';
+	my $flesh = {
+		flesh => 1,
+		flesh_fields => { $class => ['owner']}, 
+		order_by => { $class => 'create_time DESC'} 
+	};
+	$flesh->{limit} = $limit if $limit;
+	return $e->$meth([{ folder => $folderid }, $flesh]); 
+}
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.schedule.retrieve_by_folder',
+	method => 'retrieve_schedules');
+sub retrieve_schedules {
+	my( $self, $conn, $auth, $folderId, $limit, $complete ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('RUN_REPORTS');
+
+	my $search = { folder => $folderId };
+	my $query = [
+		{ folder => $folderId },
+		{ 
+			order_by => { rs => 'run_time DESC' } ,
+			flesh => 1,
+			flesh_fields => { rs => ['report'] }
+		}
+	];
+
+	$query->[1]->{limit} = $limit if $limit;
+	$query->[0]->{complete_time} = undef unless $complete;
+	$query->[0]->{complete_time} = { '!=' => undef } if $complete;
+
+	return $e->search_reporter_schedule($query);
+}
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.schedule.retrieve',
+	method => 'retrieve_schedules');
+sub retrieve_schedule {
+	my( $self, $conn, $auth, $sched_id ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('RUN_REPORTS');
+	my $s = $e->retrieve_reporter_schedule($sched_id)
+		or return $e->event;
+	return $s;
+}
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.template.create',
+	method => 'create_template');
+sub create_template {
+	my( $self, $conn, $auth, $template ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+	$template->owner($e->requestor->id);
+
+	my $existing = $e->search_reporter_template( {owner=>$template->owner, 
+			folder=>$template->folder, name=>$template->name},{idlist=>1});
+	return OpenILS::Event->new('REPORT_TEMPLATE_EXISTS') if @$existing;
+
+	my $tmpl = $e->create_reporter_template($template)
+		or return $e->die_event;
+	$e->commit;
+	return $tmpl;
+}
+
+
+
+	
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.report.create',
+	method => 'create_report');
+sub create_report {
+	my( $self, $conn, $auth, $report, $schedule ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+	$report->owner($e->requestor->id);
+
+	my $existing = $e->search_reporter_report( {owner=>$report->owner, 
+			folder=>$report->folder, name=>$report->name},{idlist=>1});
+	return OpenILS::Event->new('REPORT_REPORT_EXISTS') if @$existing;
+
+	my $rpt = $e->create_reporter_report($report)
+		or return $e->die_event;
+	$schedule->report($rpt->id);
+	$schedule->runner($e->requestor->id);
+	$e->create_reporter_schedule($schedule) or return $e->die_event;
+	$e->commit;
+	return $rpt;
+}
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.schedule.create',
+	method => 'create_schedule');
+sub create_schedule {
+	my( $self, $conn, $auth, $schedule ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+	my $sched = $e->create_reporter_schedule($schedule)
+		or return $e->die_event;
+	$e->commit;
+	return $sched;
+}
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.template.retrieve',
+	method => 'retrieve_template');
+sub retrieve_template {
+	my( $self, $conn, $auth, $id ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('RUN_REPORTS');
+	my $t = $e->retrieve_reporter_template($id) 
+		or return $e->event;
+	return $t;
+}
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.report.retrieve',
+	method => 'retrieve_report');
+sub retrieve_report {
+	my( $self, $conn, $auth, $id ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('RUN_REPORTS');
+	my $r = $e->retrieve_reporter_report($id) 
+		or return $e->event;
+	return $r;
+}
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.template.update',
+	method => 'update_template');
+sub update_template {
+	my( $self, $conn, $auth, $tmpl ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+	my $t = $e->retrieve_reporter_template($tmpl->id)
+		or return $e->die_event;
+	return 0 if $t->owner ne $e->requestor->id;
+	$e->update_reporter_template($tmpl)
+		or return $e->die_event;
+	$e->commit;
+	return 1;
+}
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.report.update',
+	method => 'update_report');
+sub update_report {
+	my( $self, $conn, $auth, $report ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+	my $r = $e->retrieve_reporter_report($report->id)
+		or return $e->die_event;
+	if( $r->owner ne $e->requestor->id ) {
+		$e->rollback;
+		return 0;
+	}
+	$e->update_reporter_report($report)
+		or return $e->die_event;
+	$e->commit;
+	return 1;
+}
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.schedule.update',
+	method => 'update_schedule');
+sub update_schedule {
+	my( $self, $conn, $auth, $schedule ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+	my $s = $e->retrieve_reporter_schedule($schedule->id)
+		or return $e->die_event;
+	my $r = $e->retrieve_reporter_report($s->report)
+		or return $e->die_event;
+	if( $r->owner ne $e->requestor->id ) {
+		$e->rollback;
+		return 0;
+	}
+	$e->update_reporter_schedule($schedule)
+		or return $e->die_event;
+	$e->commit;
+	return 1;
+}
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.folder.update',
+	method => 'update_folder');
+sub update_folder {
+	my( $self, $conn, $auth, $type, $folder ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+	my $meth = "retrieve_reporter_${type}_folder";
+	my $f = $e->$meth($folder->id) or return $e->die_event;
+	return 0 if $f->owner ne $e->requestor->id;
+	$meth = "update_reporter_${type}_folder";
+	$e->$meth($folder) or return $e->die_event;
+	$e->commit;
+	return 1;
+}
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.folder.delete',
+	method => 'delete_folder');
+sub delete_folder {
+	my( $self, $conn, $auth, $type, $folderId ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+	my $meth = "retrieve_reporter_${type}_folder";
+	my $f = $e->$meth($folderId) or return $e->die_event;
+	return 0 if $f->owner ne $e->requestor->id;
+	$meth = "delete_reporter_${type}_folder";
+	$e->$meth($f) or return $e->die_event;
+	$e->commit;
+	return 1;
+}
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.template.delete',
+	method => 'delete_template');
+sub delete_template {
+	my( $self, $conn, $auth, $templateId ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+
+	my $t = $e->retrieve_reporter_template($templateId)
+		or return $e->die_event;
+	return 0 if $t->owner ne $e->requestor->id;
+	$e->delete_reporter_template($t) or return $e->die_event;
+	$e->commit;
+	return 1;
+}
+
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.template.delete.cascade',
+	method => 'cascade_delete_template');
+
+#__PACKAGE__->register_method(
+#	api_name => 'open-ils.reporter.template.delete.cascade.force',
+#	method => 'cascade_delete_template');
+
+sub cascade_delete_template {
+	my( $self, $conn, $auth, $templateId ) = @_;
+
+	my $e = new_rstore_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+
+    my $ret = cascade_delete_template_impl(
+        $e, $e->requestor->id, $templateId, ($self->api_name =~ /force/o) );
+    return $ret if ref $ret; # some fatal event occurred
+
+    $e->rollback if $ret == 0;
+    $e->commit if $ret > 0;
+    return $ret;
+}
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.report.delete.cascade',
+	method => 'cascade_delete_report');
+
+#__PACKAGE__->register_method(
+#	api_name => 'open-ils.reporter.report.delete.cascade.force',
+#	method => 'cascade_delete_report');
+
+sub cascade_delete_report {
+	my( $self, $conn, $auth, $reportId ) = @_;
+
+	my $e = new_rstore_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+
+    my $ret = cascade_delete_report_impl($e, $e->requestor->id, $reportId);
+    return $ret if ref $ret; # some fatal event occurred
+
+    $e->rollback if $ret == 0;
+    $e->commit if $ret > 0;
+    return $ret;
+}
+
+
+# performs a cascading template delete
+# returns 2 if all data was deleted
+# returns 1 if some data was deleted
+# returns 0 if no data was deleted
+# returns event on error
+sub cascade_delete_template_impl {
+    my( $e, $owner, $templateId ) = @_;
+
+    # fetch the template to delete
+    my $template = $e->search_reporter_template(
+        {id=>$templateId, owner=>$owner})->[0] or return 0;
+
+    # fetch he attached report IDs for this  owner
+    my $reports = $e->search_reporter_report(
+        {template=>$templateId, owner=>$owner},{idlist=>1});
+
+    # delete the attached reports
+    my $all_rpts_deleted = 1;
+    for my $r (@$reports) {
+        my $evt = cascade_delete_report_impl($e, $owner, $r);
+        return $evt if ref $evt;
+        $all_rpts_deleted = 0 unless $evt == 2;
+    }
+
+    # fetch all reports attached to this template that
+    # do not belong to $owner.  If there are any, we can't 
+    # delete the template
+    my $alt_reports = $e->search_reporter_report(
+        {template=>$templateId, owner=>{"!=" => $owner}},{idlist=>1});
+
+    # all_rpts_deleted will be false if a report has an 
+    # attached scheduled owned by a different user
+    return 1 if @$alt_reports or not $all_rpts_deleted;
+
+    $e->delete_reporter_template($template) 
+        or return $e->die_event;
+    return 2;
+}
+
+# performs a cascading report delete
+# returns 2 if all data was deleted
+# returns 1 if some data was deleted
+# returns 0 if no data was deleted
+# returns event on error
+sub cascade_delete_report_impl {
+    my( $e, $owner, $reportId ) = @_;
+
+    # fetch the report to delete
+    my $report = $e->search_reporter_report(
+        {id=>$reportId, owner=>$owner})->[0] or return 0;
+
+    # fetch the attached schedule IDs for this owner
+    my $scheds = $e->search_reporter_schedule(
+        {report=>$reportId, runner=>$owner},{idlist=>1});
+
+    # delete the attached schedules
+    for my $sched (@$scheds) {
+        my $evt = delete_schedule_impl($e, $sched);
+        return $evt if $evt;
+    }
+
+    # fetch all schedules attached to this report that
+    # do not belong to $owner.  If there are any, we can't 
+    # delete the report
+    my $alt_scheds = $e->search_reporter_schedule(
+        {report=>$reportId, runner=>{"!=" => $owner}},{idlist=>1});
+
+    return 1 if @$alt_scheds;
+
+    $e->delete_reporter_report($report) 
+        or return $e->die_event;
+
+    return 2;
+}
+
+
+# deletes the requested schedule
+# returns undef on success, event on error
+sub delete_schedule_impl {
+    my( $e, $schedId ) = @_;
+    my $s = $e->retrieve_reporter_schedule($schedId)
+        or return $e->die_event;
+    $e->delete_reporter_schedule($s) or return $e->die_event;
+    return undef;
+}
+
+
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.report.delete',
+	method => 'delete_report');
+sub delete_report {
+	my( $self, $conn, $auth, $reportId ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+
+	my $t = $e->retrieve_reporter_report($reportId)
+		or return $e->die_event;
+	return 0 if $t->owner ne $e->requestor->id;
+	$e->delete_reporter_report($t) or return $e->die_event;
+	$e->commit;
+	return 1;
+}
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.schedule.delete',
+	method => 'delete_schedule');
+sub delete_schedule {
+	my( $self, $conn, $auth, $scheduleId ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth, xact=>1);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+
+	my $t = $e->retrieve_reporter_schedule($scheduleId)
+		or return $e->die_event;
+	return 0 if $t->runner ne $e->requestor->id;
+	$e->delete_reporter_schedule($t) or return $e->die_event;
+	$e->commit;
+	return 1;
+}
+
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.template_has_reports',
+	method => 'has_reports');
+sub has_reports {
+	my( $self, $conn, $auth, $templateId ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+	my $rpts = $e->search_reporter_report({template=>$templateId},{idlist=>1});
+	return 1 if @$rpts;
+	return 0;
+}
+
+__PACKAGE__->register_method(
+	api_name => 'open-ils.reporter.report_has_output',
+	method => 'has_output');
+sub has_output {
+	my( $self, $conn, $auth, $reportId ) = @_;
+	my $e = new_rstore_editor(authtoken=>$auth);
+	return $e->die_event unless $e->checkauth;
+	return $e->die_event unless $e->allowed('RUN_REPORTS');
+	my $outs = $e->search_reporter_schedule({report=>$reportId},{idlist=>1});
+	return 1 if @$outs;
+	return 0;
+}
+
+
+
+__PACKAGE__->register_method(
+	method => 'org_full_path',
+	api_name => 'open-ils.reporter.org_unit.full_path');
+
+sub org_full_path {
+	my( $self, $conn, $orgid ) = @_;
+	return $U->storagereq(
+		'open-ils.storage.actor.org_unit.full_path.atomic', $orgid );
+}
+
+
+
+
+__PACKAGE__->register_method(
+	method => 'magic_fetch_all',
+	api_name => 'open-ils.reporter.magic_fetch');
+sub magic_fetch_all {
+	my( $self, $conn, $auth, $args ) = @_;
+	my $e = new_editor(authtoken => $auth);
+	return $e->event unless $e->checkauth;
+	return $e->event unless $e->allowed('RUN_REPORTS');
+
+	my $hint = $$args{hint};
+	my $org_col = $$args{org_column};
+	my $orgs = $$args{org};
+
+#	if ($orgs && !$$args{no_fetch}) {
+#		($orgs) = $self
+#				->method_lookup( 'open-ils.reporter.org_unit.full_path' )
+#				->run( @$orgs );
+#		$orgs = [ map {$_->id} @$orgs ];
+#	}
+
+	# Find the class the iplements the given hint
+	my ($class) = grep { 
+		$Fieldmapper::fieldmap->{$_}{hint} eq $hint } Fieldmapper->classes;
+
+	return undef unless $class->Selector;
+
+	$class =~ s/Fieldmapper:://og;
+	$class =~ s/::/_/og;
+	
+	my $method;
+	my $margs;
+
+	if( $org_col ) {
+		$method = "search_$class";
+		$margs = { $org_col => $orgs };
+	} else {
+		$method = "retrieve_all_$class";
+	}
+
+	$logger->info("reporter.magic_fetch => $method");
+
+	return $e->$method($margs);
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/ResolverResolver.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/ResolverResolver.pm
new file mode 100644
index 0000000000..3463c1e9ef
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/ResolverResolver.pm
@@ -0,0 +1,304 @@
+#!/usr/bin/perl
+
+# Copyright (C) 2009-2010 Dan Scott 
+
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+
+=head1 NAME
+
+OpenILS::Application::ResolverResolver - retrieves holdings from OpenURL resolvers
+
+=head1 SYNOPSIS
+
+Via srfsh:
+  request open-ils.resolver open-ils.resolver.resolve_holdings "issn", "0022-362X"
+or:
+  request open-ils.resolver open-ils.resolver.resolve_holdings.raw "issn", "0022-362X"
+
+Via Perl:
+  my $session = OpenSRF::AppSession->create("open-ils.resolver");
+  my $request = $session->request("open-ils.resolver.resolve_holdings", [ "issn", "0022-362X" ] )->gather();
+  $session->disconnect();
+
+  # $request is a reference to the list of hashes
+
+=head1 DESCRIPTION
+
+OpenILS::Application::ResolverResolver caches responses from OpenURL resolvers
+to requests for full-text holdings. Currently integration with SFX is supported.
+
+Each org_unit can specify a different base URL as the third argument to
+resolve_holdings(). Eventually org_units will have org_unit settings to hold
+their resolver type and base URL.
+
+=head1 AUTHOR
+
+Dan Scott, dscott@laurentian.ca
+
+=cut
+
+package OpenILS::Application::ResolverResolver;
+
+use strict;
+use warnings;
+use LWP::UserAgent;
+use XML::LibXML;
+
+# All OpenSRF applications must be based on OpenSRF::Application or
+# a subclass thereof.  Makes sense, eh?
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+
+# This is the client class, used for connecting to open-ils.storage
+use OpenSRF::AppSession;
+
+# This is an extension of Error.pm that supplies some error types to throw
+use OpenSRF::EX qw(:try);
+
+# This is a helper class for querying the OpenSRF Settings application ...
+use OpenSRF::Utils::SettingsClient;
+
+# ... and here we have the built in logging helper ...
+use OpenSRF::Utils::Logger qw($logger);
+
+# ... and this manages cached results for us ...
+use OpenSRF::Utils::Cache;
+
+# ... and this gives us access to the Fieldmapper
+use OpenILS::Utils::Fieldmapper;
+
+my $prefix = "open-ils.resolver_"; # Prefix for caching values
+my $cache;
+my $cache_timeout;
+my $default_url_base;              # Default resolver location
+
+our ($ua, $parser);
+
+
+sub initialize {
+    $cache = OpenSRF::Utils::Cache->new('global');
+    my $sclient = OpenSRF::Utils::SettingsClient->new();
+    $cache_timeout = $sclient->config_value(
+        "apps", "open-ils.resolver", "app_settings", "cache_timeout" ) || 300;
+    $default_url_base = $sclient->config_value(
+        "apps", "open-ils.resolver", "app_settings", "default_url_base");
+}
+
+sub child_init {
+    # We need a User Agent to speak to the SFX beast
+    $ua = new LWP::UserAgent;
+    $ua->agent('SameOrigin/1.0');
+
+    # SFX returns XML to us; let us parse
+    $parser = new XML::LibXML;
+}
+
+sub resolve_holdings {
+    my $self = shift;
+    my $conn = shift;
+    my $id_type = shift;      # keep it simple for now, either 'issn' or 'isbn'
+    my $id_value = shift;     # the normalized ISSN or ISBN
+    my $url_base = shift || $default_url_base; 
+
+    # We'll use this in our cache key
+    my $method = $self->api_name;
+
+    # We might want to return raw JSON for speedier responses
+    my $format = 'fieldmapper';
+    if ($self->api_name =~ /raw$/) {
+        $format = 'raw';
+    }
+
+    # Big ugly SFX OpenURL request
+    my $url_args = '?url_ver=Z39.88-2004&url_ctx_fmt=infofi/fmt:kev:mtx:ctx&'
+        . 'ctx_enc=UTF-8&ctx_ver=Z39.88-2004&rfr_id=info:sid/conifer&'
+        . 'sfx.ignore_date_threshold=1&'
+        . 'sfx.response_type=multi_obj_detailed_xml&__service_type=getFullTxt';
+
+    if ($id_type eq 'issn') {
+        $url_args .= "&rft.issn=$id_value";
+    } elsif ($id_type eq 'isbn') {
+        $url_args .= "&rft.isbn=$id_value";
+    }
+    
+    my $ckey = $prefix . $method . $url_base . $id_type . $id_value;
+
+    # Check the cache to see if we've already looked this up
+    # If we have, shortcut our return value
+    my $result = $cache->get_cache($ckey) || undef;
+    if ($result) {
+        $logger->info("Resolver found a cache hit");    
+        return $result;
+    }
+
+    # Otherwise, let's go and grab the info from the SFX server
+    my $req = HTTP::Request->new('GET', "$url_base$url_args");
+
+    # Let's see what we we're trying to request
+    $logger->info("Resolving the following request: $url_base$url_args");
+
+    my $res = $ua->request($req);
+
+    my $xml = $res->content;
+    my $parsed_sfx = $parser->parse_string($xml);
+
+    my (@targets) = $parsed_sfx->findnodes('//target');
+
+    my @sfx_result;
+    foreach my $target (@targets) {
+        if ($format eq 'raw') {
+            push @sfx_result, {
+                public_name => $target->findvalue('./target_public_name'),
+                target_url => $target->findvalue('.//target_url'),
+                target_coverage => $target->findvalue('.//coverage_statement'),
+                target_embargo => $target->findvalue('.//embargo_statement'),
+            };
+        } else {
+            my $rhr = Fieldmapper::resolver::holdings_record->new;
+            $rhr->public_name($target->findvalue('./target_public_name'));
+            $rhr->target_url($target->findvalue('.//target_url'));
+            $rhr->target_coverage($target->findvalue('.//coverage_statement'));
+            $rhr->target_embargo($target->findvalue('.//embargo_statement'));
+            push @sfx_result, $rhr;
+        }
+    }
+
+    # Stuff this into the cache
+    $cache->put_cache($ckey, \@sfx_result, $cache_timeout);
+    
+    # Don't return the list unless it contains results
+    if (scalar(@sfx_result)) {
+        return \@sfx_result;
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method(
+    method    => 'resolve_holdings',
+    api_name  => 'open-ils.resolver.resolve_holdings',
+    api_level => 1,
+    argc      => 3,
+    signature => {
+        desc     => <<"         DESC",
+Returns a list of "rhr" objects representing the full-text holdings for a given ISBN or ISSN
+         DESC
+        'params' => [ {
+                name => 'id_type',
+                desc => 'The type of identifier ("issn" or "isbn")',
+                type => 'string' 
+            }, {
+                name => 'id_value',
+                desc => 'The identifier value',
+                type => 'string'
+            }, {
+                 name => 'url_base',
+                 desc => 'The base URL for the resolver and instance',
+                 type => 'string'
+            },
+        ],
+        'return' => {
+            desc => 'Returns a list of "rhr" objects representing the full-text holdings for a given ISBN or ISSN',
+            type => 'array'
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => 'resolve_holdings',
+    api_name  => 'open-ils.resolver.resolve_holdings.raw',
+    api_level => 1,
+    argc      => 3,
+    signature => {
+        desc     => <<"         DESC",
+Returns a list of raw JSON objects representing the full-text holdings for a given ISBN or ISSN
+         DESC
+        'params' => [ {
+                name => 'id_type',
+                desc => 'The type of identifier ("issn" or "isbn")',
+                type => 'string' 
+            }, {
+                name => 'id_value',
+                desc => 'The identifier value',
+                type => 'string'
+            }, {
+                 name => 'url_base',
+                 desc => 'The base URL for the resolver and instance',
+                 type => 'string'
+            },
+        ],
+        'return' => {
+            desc => 'Returns a list of raw JSON objects representing the full-text holdings for a given ISBN or ISSN',
+            type => 'array'
+        }
+    }
+);
+
+# Clear cache for specific lookups
+sub delete_cached_holdings {
+    my $self = shift;
+    my $conn = shift;
+    my $id_type = shift;      # keep it simple for now, either 'issn' or 'isbn'
+    my $id_value = shift;     # the normalized ISSN or ISBN
+    my $url_base = shift || $default_url_base; 
+    my @deleted_keys;
+
+    $logger->warn("Deleting value [$id_value]");
+    # We'll use this in our cache key
+    foreach my $method ('open-ils.resolver.resolve_holdings.raw', 'open-ils.resolver.resolve_holdings') {
+        my $ckey = $prefix . $method . $url_base . $id_type . $id_value;
+
+        $logger->warn("Deleted cache key [$ckey]");
+        my $result = $cache->delete_cache($ckey);
+
+        $logger->warn("Result of deleting cache key: [$result]");
+        push @deleted_keys, $result;
+    }
+
+    return \@deleted_keys;
+}
+
+__PACKAGE__->register_method(
+    method    => 'delete_holdings_cache',
+    api_name  => 'open-ils.resolver.delete_cached_holdings',
+    api_level => 1,
+    argc      => 3,
+    signature => {
+        desc     => <<"         DESC",
+Deletes the cached value of the full-text holdings for a given ISBN or ISSN
+         DESC
+        'params' => [ {
+                name => 'id_type',
+                desc => 'The type of identifier ("issn" or "isbn")',
+                type => 'string' 
+            }, {
+                name => 'id_value',
+                desc => 'The identifier value',
+                type => 'string'
+            }, {
+                 name => 'url_base',
+                 desc => 'The base URL for the resolver and instance',
+                 type => 'string'
+            },
+        ],
+        'return' => {
+            desc => 'Deletes the cached value of the full-text holdings for a given ISBN or ISSN',
+            type => 'array'
+        }
+    }
+);
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Search.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search.pm
new file mode 100644
index 0000000000..6de6225a73
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search.pm
@@ -0,0 +1,122 @@
+package OpenILS::Application::Search;
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+use OpenSRF::Utils::JSON;
+use OpenSRF::Utils::Logger qw(:logger);
+
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::ModsParser;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Cache;
+
+use OpenILS::Application::Search::Biblio;
+use OpenILS::Application::Search::Authority;
+use OpenILS::Application::Search::Z3950;
+use OpenILS::Application::Search::Zips;
+use OpenILS::Application::Search::CNBrowse;
+use OpenILS::Application::Search::Serial;
+
+
+use OpenILS::Application::AppUtils;
+
+use Time::HiRes qw(time);
+use OpenSRF::EX qw(:try);
+
+use Text::Aspell; 
+
+# Houses generic search utilites 
+
+sub initialize {
+	OpenILS::Application::Search::Z3950->initialize();
+	OpenILS::Application::Search::Zips->initialize();
+	OpenILS::Application::Search::Biblio->initialize();
+}
+
+sub child_init {
+	OpenILS::Application::Search::Z3950->child_init;
+}
+	
+
+
+# ------------------------------------------------------------------
+# Create custom dictionaries like so:
+# aspell --lang=en create  master ./oils_authority.dict < /tmp/words
+# where /tmp/words is a space separated list of words
+# ------------------------------------------------------------------
+
+__PACKAGE__->register_method(
+    method    => "spellcheck",
+    api_name  => "open-ils.search.spellcheck",
+    signature => {
+        desc  => 'Returns alternate spelling suggestions',
+        param => [
+            {
+                name => 'phrase',
+                desc => 'Word or phrase to return alternate spelling suggestions for',
+                type => 'string'
+            },
+            {
+                name => 'Dictionary class',
+                desc => 'Alternate configured dictionary to use (optional)',
+                type => 'string'
+            },
+        ],
+        return => {
+            desc => 'Array with a suggestions hash for each word in the phrase, like: '
+                  . q# [{ word: original_word, suggestions: [sug1, sug2, ...], found: 1 }, ... ] #
+                  . 'The "found" value will be 1 if the word was found in the dictionary, 0 otherwise.',
+            type => 'array',
+        }
+    }
+);
+
+my $speller = Text::Aspell->new();
+
+sub spellcheck {
+	my( $self, $client, $phrase, $class ) = @_;
+
+    return [] unless $phrase;   # nothing to check, abort.
+
+	my $conf = OpenSRF::Utils::SettingsClient->new;
+    $class ||= 'default';
+
+    my @conf_path = (apps => 'open-ils.search' => app_settings => spelling_dictionary => $class);
+
+	if( my $dict = $conf->config_value(@conf_path) ) {
+		$speller->set_option('master', $dict);
+		$logger->debug("spelling dictionary set to $dict");
+	}
+
+	my @resp;
+
+	for my $word (split(/\s+/,$phrase) ) {
+
+        my @suggestions = $speller->suggest($word);
+        my @trimmed;
+
+        for my $sug (@suggestions) {
+
+            # suggestion matches alternate case of original word
+            next if lc($sug) eq lc($word); 
+
+            # suggestion matches alternate case of already suggested word
+            next if grep { lc($sug) eq lc($_) } @trimmed;
+
+            push(@trimmed, $sug);
+        }
+
+		push( @resp, 
+			{
+				word => $word, 
+				suggestions => (@trimmed) ? [@trimmed] : undef,
+                found => $speller->check($word)
+			} 
+		); 
+	}
+	return \@resp;
+}
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/AddedContent.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/AddedContent.pm
new file mode 100644
index 0000000000..0538deab8b
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/AddedContent.pm
@@ -0,0 +1,67 @@
+package OpenILS::Application::Search::AddedContent;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+sub initialize { return 1; }
+
+
+__PACKAGE__->register_method(
+	method	=> "summary",
+	api_name	=> "open-ils.search.added_content.summary.retrieve",
+	notes		=> <<"	NOTE");
+		Returns an object like so:
+			{
+				Review		: true/false
+				Inventory	: true/false
+				Annotation	: true/false
+				Jacket		: true/false
+				TOC			: true/false
+				Product		: true/false
+			}
+		This object indicates the existance of each type of added content for the given ISBN
+		PARAMS( ISBN ),
+	NOTE
+
+sub summary {
+	return { 
+		Review		=> "false",
+		Inventory	=> "false",
+		Annotation	=> "false",
+		Jacket		=> "false",
+		TOC			=> "false",
+		Product		=> "false",
+	};
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "reviews",
+	api_name	=> "open-ils.search.added_content.review.retrieve.random",
+	notes		=> <<"	NOTE");
+		Returns a singe random review article object
+		PARAMS( ISBN ),
+	NOTE
+
+__PACKAGE__->register_method(
+	method	=> "reviews",
+	api_name	=> "open-ils.search.added_content.review.retrieve.all",
+	notes		=> <<"	NOTE");
+		Returns an array review article objects
+		PARAMS( ISBN ),
+	NOTE
+
+sub reviews { return []; }
+
+
+__PACKAGE__->register_method(
+	method	=> "toc",
+	api_name	=> "open-ils.search.added_content.toc.retrieve",
+	notes		=> <<"	NOTE");
+		Returns the table of contents for the given ISBN
+		PARAMS( ISBN ),
+	NOTE
+
+sub toc { return ""; }
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Authority.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Authority.pm
new file mode 100644
index 0000000000..37bc763109
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Authority.pm
@@ -0,0 +1,280 @@
+package OpenILS::Application::Search::Authority;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Application::AppUtils;
+use XML::LibXML;
+use XML::LibXSLT;
+use OpenILS::Utils::Editor q/:funcs/;
+use OpenSRF::Utils::Logger qw/$logger/;
+
+use OpenSRF::Utils::JSON;
+
+use Time::HiRes qw(time);
+use OpenSRF::EX qw(:try);
+use Digest::MD5 qw(md5_hex);
+
+my $cache;
+
+
+sub validate_authority {
+	my $self = shift;
+	my $client = shift;
+
+	my $session = OpenSRF::AppSession->create("open-ils.storage");
+	return $session->request( 'open-ils.storage.authority.validate.tag' => @_ )->gather(1);
+}
+__PACKAGE__->register_method(
+        method		=> "validate_authority",
+        api_name	=> "open-ils.search.authority.validate.tag",
+        argc		=> 4, 
+        note		=> "Validates authority data from existing controlled terms",
+);              
+
+sub validate_authority_return_records_by_id {
+	my $self = shift;
+	my $client = shift;
+
+	my $session = OpenSRF::AppSession->create("open-ils.storage");
+	return $session->request( 'open-ils.storage.authority.validate.tag.id_list' => @_ )->gather(1);
+}
+__PACKAGE__->register_method(
+        method		=> "validate_authority_return_records_by_id",
+        api_name	=> "open-ils.search.authority.validate.tag.id_list",
+        argc		=> 4, 
+        note		=> "Validates authority data from existing controlled terms",
+);              
+
+sub search_authority {
+	my $self = shift;
+	my $client = shift;
+
+	my $session = OpenSRF::AppSession->create("open-ils.storage");
+	return $session->request( 'open-ils.storage.authority.search.marc.atomic' => @_ )->gather(1);
+}
+__PACKAGE__->register_method(
+        method		=> "search_authority",
+        api_name	=> "open-ils.search.authority.fts",
+        argc		=> 2, 
+        note		=> "Searches authority data for existing controlled terms and crossrefs",
+);              
+
+
+sub crossref_authority {
+	my $self = shift;
+	my $client = shift;
+	my $class = shift;
+	my $term = shift;
+	my $limit = shift || 10;
+
+	my $session = OpenSRF::AppSession->create("open-ils.storage");
+
+	# Avoid generating spurious errors for more granular indexes, like author|personal
+	$class =~ s/^(.*?)\|.*?$/$1/;
+
+	$logger->info("authority xref search for $class=$term, limit=$limit");
+	my $fr = $session->request(
+		"open-ils.storage.authority.$class.see_from.controlled.atomic",$term, $limit)->gather(1);
+	my $al = $session->request(
+		"open-ils.storage.authority.$class.see_also_from.controlled.atomic",$term, $limit)->gather(1);
+
+	my $data = _auth_flatten( $term, $fr, $al, 1 );
+
+	return $data;
+}
+
+sub _auth_flatten {
+	my $term = shift;
+	my $fr = shift;
+	my $al = shift;
+	my $limit = shift;
+
+	my %hash = ();
+	for my $x (@$fr) {
+		my $string = $$x[0];
+		for my $i (1..10) {
+			last unless ($$x[$i]);
+			if ($string =~ /\W$/o) {
+				$string .= ' '.$$x[$i];
+			} else {
+				$string .= ' -- '.$$x[$i];
+			}
+		}
+		next if (lc($string) eq lc($term));
+		$hash{$string}++;
+		$hash{$string}++ if (lc($$x[0]) eq lc($term));
+	}
+	my $from = [keys %hash]; #[ sort { $hash{$b} <=> $hash{$a} || $a cmp $b } keys %hash ];
+
+#	$from = [ @$from[0..4] ] if $limit;
+
+	%hash = ();
+	for my $x (@$al) {
+		my $string = $$x[0];
+		for my $i (1..10) {
+			last unless ($$x[$i]);
+			if ($string =~ /\W$/o) {
+				$string .= ' '.$$x[$i];
+			} else {
+				$string .= ' -- '.$$x[$i];
+			}
+		}
+		next if (lc($string) eq lc($term));
+		$hash{$string}++;
+		$hash{$string}++ if (lc($$x[0]) eq lc($term));
+	}
+	my $also = [keys %hash]; #[ sort { $hash{$b} <=> $hash{$a} || $a cmp $b } keys %hash ];
+
+#	$also = [ @$also[0..4] ] if $limit;
+
+	#warn Dumper( { from => $from, also => $also } );
+
+	return { from => $from, also => $also };
+}
+
+__PACKAGE__->register_method(
+        method		=> "crossref_authority",
+        api_name	=> "open-ils.search.authority.crossref",
+        argc		=> 2, 
+        note		=> "Searches authority data for existing controlled terms and crossrefs",
+);              
+
+__PACKAGE__->register_method(
+	#method		=> "new_crossref_authority_batch",
+	method		=> "crossref_authority_batch2",
+	api_name	=> "open-ils.search.authority.crossref.batch",
+	argc		=> 1, 
+	note		=> <<"	NOTE");
+	Takes an array of class,term pair sub-arrays and performs an authority lookup for each
+
+	PARAMS( [ ["subject", "earth"], ["author","shakespeare"] ] );
+
+	Returns an object like so:
+	{
+		"classname" : {
+			"term" : { "from" : [ ...], "also" : [...] }
+			"term2" : { "from" : [ ...], "also" : [...] }
+		}
+	}
+	NOTE
+
+sub new_crossref_authority_batch {
+	my( $self, $client, $reqs ) = @_;
+
+	my $response = {};
+	my $lastr = [];
+	my $session = OpenSRF::AppSession->create("open-ils.storage");
+
+	for my $req (@$reqs) {
+
+		my $class = $req->[0];
+		my $term = $req->[1];
+		next unless $class and $term;
+		$logger->info("Sending authority request for $class : $term");
+		my $fr = $session->request("open-ils.storage.authority.$class.see_from.controlled.atomic",$term, 10)->gather(1);
+		my $al = $session->request("open-ils.storage.authority.$class.see_also_from.controlled.atomic",$term, 10)->gather(1);
+
+		$response->{$class} = {} unless exists $response->{$class};
+		$response->{$class}->{$term} = _auth_flatten( $term, $fr, $al, 1 );
+
+	}
+
+	#warn Dumper( $response );
+	return $response;
+}
+
+sub crossref_authority_batch {
+	my( $self, $client, $reqs ) = @_;
+
+	my $response = {};
+	my $lastr = [];
+	my $session = OpenSRF::AppSession->create("open-ils.storage");
+
+	for my $req (@$reqs) {
+
+		my $class = $req->[0];
+		my $term = $req->[1];
+		next unless $class and $term;
+		$logger->info("Sending authority request for $class : $term");
+		my $freq = $session->request("open-ils.storage.authority.$class.see_from.controlled.atomic",$term, 10);
+		my $areq = $session->request("open-ils.storage.authority.$class.see_also_from.controlled.atomic",$term, 10);
+
+		if( $lastr->[0] ) { #process old data while waiting on new data
+			my $cls = $lastr->[0];
+			my $trm = $lastr->[1];
+			my $fr	= $lastr->[2];
+			my $al	= $lastr->[3];
+			$response->{$cls} = {} unless exists $response->{$cls};
+			$response->{$cls}->{$trm} = _auth_flatten( $trm, $fr, $al, 1 );
+		}
+
+		$lastr->[0] = $class;
+		$lastr->[1] = $term; 
+		$lastr->[2] = $freq->gather(1);
+		$lastr->[3] = $areq->gather(1);
+	}
+
+	if( $lastr->[0] ) { #process old data while waiting on new data
+		my $cls = $lastr->[0];
+		my $trm = $lastr->[1];
+		my $fr	= $lastr->[2];
+		my $al	= $lastr->[3];
+		$response->{$cls} = {} unless exists $response->{$cls};
+		$response->{$cls}->{$trm} = _auth_flatten( $trm, $fr, $al, 1);
+	}
+
+	return $response;
+}
+
+
+
+
+sub crossref_authority_batch2 {
+	my( $self, $client, $reqs ) = @_;
+
+	my $response = {};
+	my $lastr = [];
+	my $session = OpenSRF::AppSession->create("open-ils.storage");
+
+	$cache = OpenSRF::Utils::Cache->new('global') unless $cache;
+
+	for my $req (@$reqs) {
+
+		my $class = $req->[0];
+		my $term = $req->[1];
+		next unless $class and $term;
+
+		my $t = $term;
+		$t =~ s/\s//og;
+		my $cdata = $cache->get_cache("oils_authority_${class}_$t");
+
+		if( $cdata ) {
+			$logger->debug("returning authority response from cache..");
+			$response->{$class} = {} unless exists $response->{$class};
+			$response->{$class}->{$term} = $cdata;
+			next;
+		}
+
+		$logger->debug("authority data not found in cache.. fetching from storage");
+
+		$logger->info("Sending authority request for $class : $term");
+		my $freq = $session->request("open-ils.storage.authority.$class.see_from.controlled.atomic",$term, 10);
+		my $areq = $session->request("open-ils.storage.authority.$class.see_also_from.controlled.atomic",$term, 10);
+		my $fr = $freq->gather(1);	
+		my $al = $areq->gather(1);
+		$response->{$class} = {} unless exists $response->{$class};
+		my $auth = _auth_flatten( $term, $fr, $al, 1 );
+
+		my $timeout = 7200; #two hours
+		$timeout = 300 if @{$auth->{from}} or @{$auth->{also}}; # 5 minutes
+		$response->{$class}->{$term} = $auth;
+		$logger->debug("adding authority lookup to cache with timeout $timeout");
+		$cache->put_cache("oils_authority_${class}_$t", $auth, $timeout);
+	}
+	return $response;
+}
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Biblio.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Biblio.pm
new file mode 100644
index 0000000000..96ca5d2f3e
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Biblio.pm
@@ -0,0 +1,2429 @@
+package OpenILS::Application::Search::Biblio;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+
+use OpenSRF::Utils::JSON;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::ModsParser;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenSRF::Utils::Cache;
+use Encode;
+
+use OpenSRF::Utils::Logger qw/:logger/;
+
+
+use OpenSRF::Utils::JSON;
+
+use Time::HiRes qw(time);
+use OpenSRF::EX qw(:try);
+use Digest::MD5 qw(md5_hex);
+
+use XML::LibXML;
+use XML::LibXSLT;
+
+use Data::Dumper;
+$Data::Dumper::Indent = 0;
+
+use OpenILS::Const qw/:const/;
+
+use OpenILS::Application::AppUtils;
+my $apputils = "OpenILS::Application::AppUtils";
+my $U = $apputils;
+
+my $pfx = "open-ils.search_";
+
+my $cache;
+my $cache_timeout;
+my $superpage_size;
+my $max_superpages;
+
+sub initialize {
+	$cache = OpenSRF::Utils::Cache->new('global');
+	my $sclient = OpenSRF::Utils::SettingsClient->new();
+	$cache_timeout = $sclient->config_value(
+			"apps", "open-ils.search", "app_settings", "cache_timeout" ) || 300;
+
+	$superpage_size = $sclient->config_value(
+			"apps", "open-ils.search", "app_settings", "superpage_size" ) || 500;
+
+	$max_superpages = $sclient->config_value(
+			"apps", "open-ils.search", "app_settings", "max_superpages" ) || 20;
+
+	$logger->info("Search cache timeout is $cache_timeout, ".
+        " superpage_size is $superpage_size, max_superpages is $max_superpages");
+}
+
+
+
+# ---------------------------------------------------------------------------
+# takes a list of record id's and turns the docs into friendly 
+# mods structures. Creates one MODS structure for each doc id.
+# ---------------------------------------------------------------------------
+sub _records_to_mods {
+	my @ids = @_;
+	
+	my @results;
+	my @marcxml_objs;
+
+	my $session = OpenSRF::AppSession->create("open-ils.cstore");
+	my $request = $session->request(
+			"open-ils.cstore.direct.biblio.record_entry.search", { id => \@ids } );
+
+	while( my $resp = $request->recv ) {
+		my $content = $resp->content;
+		next if $content->id == OILS_PRECAT_RECORD;
+		my $u = OpenILS::Utils::ModsParser->new();  # FIXME: we really need a new parser for each object?
+		$u->start_mods_batch( $content->marc );
+		my $mods = $u->finish_mods_batch();
+		$mods->doc_id($content->id());
+		$mods->tcn($content->tcn_value);
+		push @results, $mods;
+	}
+
+	$session->disconnect();
+	return \@results;
+}
+
+__PACKAGE__->register_method(
+    method    => "record_id_to_mods",
+    api_name  => "open-ils.search.biblio.record.mods.retrieve",
+    argc      => 1,
+    signature => {
+        desc   => "Provide ID, we provide the MODS object with copy count.  " 
+                . "Note: this method does NOT take an array of IDs like mods_slim.retrieve",    # FIXME: do it here too
+        params => [
+            { desc => 'Record ID', type => 'number' }
+        ],
+        return => {
+            desc => 'MODS object', type => 'object'
+        }
+    }
+);
+
+# converts a record into a mods object with copy counts attached
+sub record_id_to_mods {
+
+    my( $self, $client, $org_id, $id ) = @_;
+
+    my $mods_list = _records_to_mods( $id );
+    my $mods_obj  = $mods_list->[0];
+    my $cmethod   = $self->method_lookup("open-ils.search.biblio.record.copy_count");
+    my ($count)   = $cmethod->run($org_id, $id);
+    $mods_obj->copy_count($count);
+
+    return $mods_obj;
+}
+
+
+
+__PACKAGE__->register_method(
+    method        => "record_id_to_mods_slim",
+    api_name      => "open-ils.search.biblio.record.mods_slim.retrieve",
+    argc          => 1,
+    authoritative => 1,
+    signature     => {
+        desc   => "Provide ID(s), we provide the MODS",
+        params => [
+            { desc => 'Record ID or array of IDs' }
+        ],
+        return => {
+            desc => 'MODS object(s), event on error'
+        }
+    }
+);
+
+# converts a record into a mods object with NO copy counts attached
+sub record_id_to_mods_slim {
+	my( $self, $client, $id ) = @_;
+	return undef unless defined $id;
+
+	if(ref($id) and ref($id) == 'ARRAY') {
+		return _records_to_mods( @$id );
+	}
+	my $mods_list = _records_to_mods( $id );
+	my $mods_obj  = $mods_list->[0];
+	return OpenILS::Event->new('BIBLIO_RECORD_ENTRY_NOT_FOUND') unless $mods_obj;
+	return $mods_obj;
+}
+
+
+
+__PACKAGE__->register_method(
+    method   => "record_id_to_mods_slim_batch",
+    api_name => "open-ils.search.biblio.record.mods_slim.batch.retrieve",
+    stream   => 1
+);
+sub record_id_to_mods_slim_batch {
+	my($self, $conn, $id_list) = @_;
+    $conn->respond(_records_to_mods($_)->[0]) for @$id_list;
+    return undef;
+}
+
+
+# Returns the number of copies attached to a record based on org location
+__PACKAGE__->register_method(
+    method   => "record_id_to_copy_count",
+    api_name => "open-ils.search.biblio.record.copy_count",
+    signature => {
+        desc => q/Returns a copy summary for the given record for the context org
+            unit and all ancestor org units/,
+        params => [
+            {desc => 'Context org unit id', type => 'number'},
+            {desc => 'Record ID', type => 'number'}
+        ],
+        return => {
+            desc => q/summary object per org unit in the set, where the set
+                includes the context org unit and all parent org units.  
+                Object includes the keys "transcendant", "count", "org_unit", "depth", 
+                "unshadow", "available".  Each is a count, except "org_unit" which is 
+                the context org unit and "depth" which is the depth of the context org unit
+            /,
+            type => 'array'
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method        => "record_id_to_copy_count",
+    api_name      => "open-ils.search.biblio.record.copy_count.staff",
+    authoritative => 1,
+    signature => {
+        desc => q/Returns a copy summary for the given record for the context org
+            unit and all ancestor org units/,
+        params => [
+            {desc => 'Context org unit id', type => 'number'},
+            {desc => 'Record ID', type => 'number'}
+        ],
+        return => {
+            desc => q/summary object per org unit in the set, where the set
+                includes the context org unit and all parent org units.  
+                Object includes the keys "transcendant", "count", "org_unit", "depth", 
+                "unshadow", "available".  Each is a count, except "org_unit" which is 
+                the context org unit and "depth" which is the depth of the context org unit
+            /,
+            type => 'array'
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method   => "record_id_to_copy_count",
+    api_name => "open-ils.search.biblio.metarecord.copy_count",
+    signature => {
+        desc => q/Returns a copy summary for the given record for the context org
+            unit and all ancestor org units/,
+        params => [
+            {desc => 'Context org unit id', type => 'number'},
+            {desc => 'Record ID', type => 'number'}
+        ],
+        return => {
+            desc => q/summary object per org unit in the set, where the set
+                includes the context org unit and all parent org units.  
+                Object includes the keys "transcendant", "count", "org_unit", "depth", 
+                "unshadow", "available".  Each is a count, except "org_unit" which is 
+                the context org unit and "depth" which is the depth of the context org unit
+            /,
+            type => 'array'
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method   => "record_id_to_copy_count",
+    api_name => "open-ils.search.biblio.metarecord.copy_count.staff",
+    signature => {
+        desc => q/Returns a copy summary for the given record for the context org
+            unit and all ancestor org units/,
+        params => [
+            {desc => 'Context org unit id', type => 'number'},
+            {desc => 'Record ID', type => 'number'}
+        ],
+        return => {
+            desc => q/summary object per org unit in the set, where the set
+                includes the context org unit and all parent org units.  
+                Object includes the keys "transcendant", "count", "org_unit", "depth", 
+                "unshadow", "available".  Each is a count, except "org_unit" which is 
+                the context org unit and "depth" which is the depth of the context org
+                unit.  "depth" is always -1 when the count from a lasso search is
+                performed, since depth doesn't mean anything in a lasso context.
+            /,
+            type => 'array'
+        }
+    }
+);
+
+sub record_id_to_copy_count {
+    my( $self, $client, $org_id, $record_id ) = @_;
+
+    return [] unless $record_id;
+
+    my $key = $self->api_name =~ /metarecord/ ? 'metarecord' : 'record';
+    my $staff = $self->api_name =~ /staff/ ? 't' : 'f';
+
+    my $data = $U->cstorereq(
+        "open-ils.cstore.json_query.atomic",
+        { from => ['asset.' . $key  . '_copy_count' => $org_id => $record_id => $staff] }
+    );
+
+    my @count;
+    for my $d ( @$data ) { # fix up the key name change required by stored-proc version
+        $$d{count} = delete $$d{visible};
+        push @count, $d;
+    }
+
+    return [ sort { $a->{depth} <=> $b->{depth} } @count ];
+}
+
+
+__PACKAGE__->register_method(
+    method   => "biblio_search_tcn",
+    api_name => "open-ils.search.biblio.tcn",
+    argc     => 1,
+    signature => {
+        desc   => "Retrieve related record ID(s) given a TCN",
+        params => [
+            { desc => 'TCN', type => 'string' },
+            { desc => 'Flag indicating to include deleted records', type => 'string' }
+        ],
+        return => {
+            desc => 'Results object like: { "count": $i, "ids": [...] }',
+            type => 'object'
+        }
+    }
+
+);
+
+sub biblio_search_tcn {
+
+    my( $self, $client, $tcn, $include_deleted ) = @_;
+
+    $tcn =~ s/^\s+|\s+$//og;
+
+    my $e = new_editor();
+    my $search = {tcn_value => $tcn};
+    $search->{deleted} = 'f' unless $include_deleted;
+    my $recs = $e->search_biblio_record_entry( $search, {idlist =>1} );
+	
+    return { count => scalar(@$recs), ids => $recs };
+}
+
+
+# --------------------------------------------------------------------------------
+
+__PACKAGE__->register_method(
+    method   => "biblio_barcode_to_copy",
+    api_name => "open-ils.search.asset.copy.find_by_barcode",
+);
+sub biblio_barcode_to_copy { 
+	my( $self, $client, $barcode ) = @_;
+	my( $copy, $evt ) = $U->fetch_copy_by_barcode($barcode);
+	return $evt if $evt;
+	return $copy;
+}
+
+__PACKAGE__->register_method(
+    method   => "biblio_id_to_copy",
+    api_name => "open-ils.search.asset.copy.batch.retrieve",
+);
+sub biblio_id_to_copy { 
+	my( $self, $client, $ids ) = @_;
+	$logger->info("Fetching copies @$ids");
+	return $U->cstorereq(
+		"open-ils.cstore.direct.asset.copy.search.atomic", { id => $ids } );
+}
+
+
+__PACKAGE__->register_method(
+	method	=> "biblio_id_to_uris",
+	api_name=> "open-ils.search.asset.uri.retrieve_by_bib",
+	argc	=> 2, 
+    stream  => 1,
+    signature => q#
+        @param BibID Which bib record contains the URIs
+        @param OrgID Where to look for URIs
+        @param OrgDepth Range adjustment for OrgID
+        @return A stream or list of 'auri' objects
+    #
+
+);
+sub biblio_id_to_uris { 
+	my( $self, $client, $bib, $org, $depth ) = @_;
+    die "Org ID required" unless defined($org);
+    die "Bib ID required" unless defined($bib);
+
+    my @params;
+    push @params, $depth if (defined $depth);
+
+	my $ids = $U->cstorereq( "open-ils.cstore.json_query.atomic",
+        {   select  => { auri => [ 'id' ] },
+            from    => {
+                acn => {
+                    auricnm => {
+                        field   => 'call_number',
+                        fkey    => 'id',
+                        join    => {
+                            auri    => {
+                                field => 'id',
+                                fkey => 'uri',
+                                filter  => { active => 't' }
+                            }
+                        }
+                    }
+                }
+            },
+            where   => {
+                '+acn'  => {
+                    record      => $bib,
+                    owning_lib  => {
+                        in  => {
+                            select  => { aou => [ { column => 'id', transform => 'actor.org_unit_descendants', params => \@params, result_field => 'id' } ] },
+                            from    => 'aou',
+                            where   => { id => $org },
+                            distinct=> 1
+                        }
+                    }
+                }
+            },
+            distinct=> 1,
+        }
+    );
+
+	my $uris = $U->cstorereq(
+		"open-ils.cstore.direct.asset.uri.search.atomic",
+        { id => [ map { (values %$_) } @$ids ] }
+    );
+
+    $client->respond($_) for (@$uris);
+
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+    method    => "copy_retrieve",
+    api_name  => "open-ils.search.asset.copy.retrieve",
+    argc      => 1,
+    signature => {
+        desc   => 'Retrieve a copy object based on the Copy ID',
+        params => [
+            { desc => 'Copy ID', type => 'number'}
+        ],
+        return => {
+            desc => 'Copy object, event on error'
+        }
+    }
+);
+
+sub copy_retrieve {
+	my( $self, $client, $cid ) = @_;
+	my( $copy, $evt ) = $U->fetch_copy($cid);
+	return $evt || $copy;
+}
+
+__PACKAGE__->register_method(
+    method   => "volume_retrieve",
+    api_name => "open-ils.search.asset.call_number.retrieve"
+);
+sub volume_retrieve {
+	my( $self, $client, $vid ) = @_;
+	my $e = new_editor();
+	my $vol = $e->retrieve_asset_call_number($vid) or return $e->event;
+	return $vol;
+}
+
+__PACKAGE__->register_method(
+    method        => "fleshed_copy_retrieve_batch",
+    api_name      => "open-ils.search.asset.copy.fleshed.batch.retrieve",
+    authoritative => 1,
+);
+
+sub fleshed_copy_retrieve_batch { 
+	my( $self, $client, $ids ) = @_;
+	$logger->info("Fetching fleshed copies @$ids");
+	return $U->cstorereq(
+		"open-ils.cstore.direct.asset.copy.search.atomic",
+		{ id => $ids },
+		{ flesh => 1, 
+		  flesh_fields => { acp => [ qw/ circ_lib location status stat_cat_entries / ] }
+		});
+}
+
+
+__PACKAGE__->register_method(
+    method   => "fleshed_copy_retrieve",
+    api_name => "open-ils.search.asset.copy.fleshed.retrieve",
+);
+
+sub fleshed_copy_retrieve { 
+	my( $self, $client, $id ) = @_;
+	my( $c, $e) = $U->fetch_fleshed_copy($id);
+	return $e || $c;
+}
+
+
+__PACKAGE__->register_method(
+    method        => 'fleshed_by_barcode',
+    api_name      => "open-ils.search.asset.copy.fleshed2.find_by_barcode",
+    authoritative => 1,
+);
+sub fleshed_by_barcode {
+	my( $self, $conn, $barcode ) = @_;
+	my $e = new_editor();
+	my $copyid = $e->search_asset_copy(
+		{barcode => $barcode, deleted => 'f'}, {idlist=>1})->[0]
+		or return $e->event;
+	return fleshed_copy_retrieve2( $self, $conn, $copyid);
+}
+
+
+__PACKAGE__->register_method(
+    method        => "fleshed_copy_retrieve2",
+    api_name      => "open-ils.search.asset.copy.fleshed2.retrieve",
+    authoritative => 1,
+);
+
+sub fleshed_copy_retrieve2 { 
+	my( $self, $client, $id ) = @_;
+	my $e = new_editor();
+	my $copy = $e->retrieve_asset_copy(
+		[
+			$id,
+            {
+                flesh        => 2,
+                flesh_fields => {
+                    acp => [
+                        qw/ location status stat_cat_entry_copy_maps notes age_protect /
+                    ],
+                    ascecm => [qw/ stat_cat stat_cat_entry /],
+                }
+            }
+		]
+	) or return $e->event;
+
+	# For backwards compatibility
+	#$copy->stat_cat_entries($copy->stat_cat_entry_copy_maps);
+
+	if( $copy->status->id == OILS_COPY_STATUS_CHECKED_OUT ) {
+		$copy->circulations(
+			$e->search_action_circulation( 
+				[	
+					{ target_copy => $copy->id },
+					{
+						order_by => { circ => 'xact_start desc' },
+						limit => 1
+					}
+				]
+			)
+		);
+	}
+
+	return $copy;
+}
+
+
+__PACKAGE__->register_method(
+    method        => 'flesh_copy_custom',
+    api_name      => 'open-ils.search.asset.copy.fleshed.custom',
+    authoritative => 1,
+);
+
+sub flesh_copy_custom {
+	my( $self, $conn, $copyid, $fields ) = @_;
+	my $e = new_editor();
+	my $copy = $e->retrieve_asset_copy(
+		[
+			$copyid,
+			{ 
+				flesh				=> 1,
+				flesh_fields	=> { 
+					acp => $fields,
+				}
+			}
+		]
+	) or return $e->event;
+	return $copy;
+}
+
+
+__PACKAGE__->register_method(
+    method   => "biblio_barcode_to_title",
+    api_name => "open-ils.search.biblio.find_by_barcode",
+);
+
+sub biblio_barcode_to_title {
+	my( $self, $client, $barcode ) = @_;
+
+	my $title = $apputils->simple_scalar_request(
+		"open-ils.storage",
+		"open-ils.storage.biblio.record_entry.retrieve_by_barcode", $barcode );
+
+	return { ids => [ $title->id ], count => 1 } if $title;
+	return { count => 0 };
+}
+
+__PACKAGE__->register_method(
+    method        => 'title_id_by_item_barcode',
+    api_name      => 'open-ils.search.bib_id.by_barcode',
+    authoritative => 1,
+    signature => { 
+        desc   => 'Retrieve copy object with fleshed record, given the barcode',
+        params => [
+            { desc => 'Item barcode', type => 'string' }
+        ],
+        return => {
+            desc => 'Asset copy object with fleshed record and callnumber, or event on error or null set'
+        }
+    }
+);
+
+sub title_id_by_item_barcode {
+    my( $self, $conn, $barcode ) = @_;
+    my $e = new_editor();
+    my $copies = $e->search_asset_copy(
+        [
+            { deleted => 'f', barcode => $barcode },
+            {
+                flesh => 2,
+                flesh_fields => {
+                    acp => [ 'call_number' ],
+                    acn => [ 'record' ]
+                }
+            }
+        ]
+    );
+
+    return $e->event unless @$copies;
+    return $$copies[0]->call_number->record->id;
+}
+
+
+__PACKAGE__->register_method(
+    method   => "biblio_copy_to_mods",
+    api_name => "open-ils.search.biblio.copy.mods.retrieve",
+);
+
+# takes a copy object and returns it fleshed mods object
+sub biblio_copy_to_mods {
+	my( $self, $client, $copy ) = @_;
+
+	my $volume = $U->cstorereq( 
+		"open-ils.cstore.direct.asset.call_number.retrieve",
+		$copy->call_number() );
+
+	my $mods = _records_to_mods($volume->record());
+	$mods = shift @$mods;
+	$volume->copies([$copy]);
+	push @{$mods->call_numbers()}, $volume;
+
+	return $mods;
+}
+
+
+=head1 NAME
+
+OpenILS::Application::Search::Biblio
+
+=head1 DESCRIPTION
+
+=head2 API METHODS
+
+=head3 open-ils.search.biblio.multiclass.query (arghash, query, docache)
+
+For arghash and docache, see B.
+
+The query argument is a string, but built like a hash with key: value pairs.
+Recognized search keys include: 
+
+ keyword (kw) - search keyword(s) *
+ author  (au) - search author(s)  *
+ name    (au) - same as author    *
+ title   (ti) - search title      *
+ subject (su) - search subject    *
+ series  (se) - search series     *
+ lang - limit by language (specifiy multiple langs with lang:l1 lang:l2 ...)
+ site - search at specified org unit, corresponds to actor.org_unit.shortname
+ sort - sort type (title, author, pubdate)
+ dir  - sort direction (asc, desc)
+ available - if set to anything other than "false" or "0", limits to available items
+
+* Searching keyword, author, title, subject, and series supports additional search 
+subclasses, specified with a "|".  For example, C.
+
+For more, see B.
+
+=cut
+
+foreach (qw/open-ils.search.biblio.multiclass.query
+            open-ils.search.biblio.multiclass.query.staff
+            open-ils.search.metabib.multiclass.query
+            open-ils.search.metabib.multiclass.query.staff/)
+{
+__PACKAGE__->register_method(
+    api_name  => $_,
+    method    => 'multiclass_query',
+    signature => {
+        desc   => 'Perform a search query.  The .staff version of the call includes otherwise hidden hits.',
+        params => [
+            {name => 'arghash', desc => 'Arg hash (see open-ils.search.biblio.multiclass)',         type => 'object'},
+            {name => 'query',   desc => 'Raw human-readable query (see perldoc '. __PACKAGE__ .')', type => 'string'},
+            {name => 'docache', desc => 'Flag for caching (see open-ils.search.biblio.multiclass)', type => 'object'},
+        ],
+        return => {
+            desc => 'Search results from query, like: { "count" : $count, "ids" : [ [ $id, $relevancy, $total ], ...] }',
+            type => 'object',       # TODO: update as miker's new elements are included
+        }
+    }
+);
+}
+
+sub multiclass_query {
+    my($self, $conn, $arghash, $query, $docache) = @_;
+
+    $logger->debug("initial search query => $query");
+    my $orig_query = $query;
+
+    $query =~ s/\+/ /go;
+    $query =~ s/'/ /go;
+    $query =~ s/^\s+//go;
+
+    # convert convenience classes (e.g. kw for keyword) to the full class name
+    # ensure that the convenience class isn't part of a word (e.g. 'playhouse')
+    $query =~ s/(^|\s)kw(:|\|)/$1keyword$2/go;
+    $query =~ s/(^|\s)ti(:|\|)/$1title$2/go;
+    $query =~ s/(^|\s)au(:|\|)/$1author$2/go;
+    $query =~ s/(^|\s)su(:|\|)/$1subject$2/go;
+    $query =~ s/(^|\s)se(:|\|)/$1series$2/go;
+    $query =~ s/(^|\s)name(:|\|)/$1author$2/og;
+
+    $logger->debug("cleansed query string => $query");
+    my $search = {};
+
+    my $simple_class_re  = qr/((?:\w+(?:\|\w+)?):[^:]+?)$/;
+    my $class_list_re    = qr/(?:keyword|title|author|subject|series)/;
+    my $modifier_list_re = qr/(?:site|dir|sort|lang|available)/;
+
+    my $tmp_value = '';
+    while ($query =~ s/$simple_class_re//so) {
+
+        my $qpart = $1;
+        my $where = index($qpart,':');
+        my $type  = substr($qpart, 0, $where++);
+        my $value = substr($qpart, $where);
+
+        if ($type !~ /^(?:$class_list_re|$modifier_list_re)/o) {
+            $tmp_value = "$qpart $tmp_value";
+            next;
+        }
+
+        if ($type =~ /$class_list_re/o ) {
+            $value .= $tmp_value;
+            $tmp_value = '';
+        }
+
+        next unless $type and $value;
+
+        $value =~ s/^\s*//og;
+        $value =~ s/\s*$//og;
+        $type = 'sort_dir' if $type eq 'dir';
+
+        if($type eq 'site') {
+            # 'site' is the org shortname.  when using this, we also want 
+            # to search at the requested org's depth
+            my $e = new_editor();
+            if(my $org = $e->search_actor_org_unit({shortname => $value})->[0]) {
+                $arghash->{org_unit} = $org->id if $org;
+                $arghash->{depth} = $e->retrieve_actor_org_unit_type($org->ou_type)->depth;
+            } else {
+                $logger->warn("'site:' query used on invalid org shortname: $value ... ignoring");
+            }
+
+        } elsif($type eq 'available') {
+            # limit to available
+            $arghash->{available} = 1 unless $value eq 'false' or $value eq '0';
+
+        } elsif($type eq 'lang') {
+            # collect languages into an array of languages
+            $arghash->{language} = [] unless $arghash->{language};
+            push(@{$arghash->{language}}, $value);
+
+        } elsif($type =~ /^sort/o) {
+            # sort and sort_dir modifiers
+            $arghash->{$type} = $value;
+
+        } else {
+            # append the search term to the term under construction
+            $search->{$type} =  {} unless $search->{$type};
+            $search->{$type}->{term} =  
+                ($search->{$type}->{term}) ? $search->{$type}->{term} . " $value" : $value;
+        }
+    }
+
+    $query .= " $tmp_value";
+    $query =~ s/\s+/ /go;
+    $query =~ s/^\s+//go;
+    $query =~ s/\s+$//go;
+
+    my $type = $arghash->{default_class} || 'keyword';
+    $type = ($type eq '-') ? 'keyword' : $type;
+    $type = ($type !~ /^(title|author|keyword|subject|series)(?:\|\w+)?$/o) ? 'keyword' : $type;
+
+    if($query) {
+        # This is the front part of the string before any special tokens were
+        # parsed OR colon-separated strings that do not denote a class.
+        # Add this data to the default search class
+        $search->{$type} =  {} unless $search->{$type};
+        $search->{$type}->{term} =
+            ($search->{$type}->{term}) ? $search->{$type}->{term} . " $query" : $query;
+    }
+    my $real_search = $arghash->{searches} = { $type => { term => $orig_query } };
+
+    # capture the original limit because the search method alters the limit internally
+    my $ol = $arghash->{limit};
+
+	my $sclient = OpenSRF::Utils::SettingsClient->new;
+
+    (my $method = $self->api_name) =~ s/\.query//o;
+
+    $method =~ s/multiclass/multiclass.staged/
+        if $sclient->config_value(apps => 'open-ils.search',
+            app_settings => 'use_staged_search') =~ /true/i;
+
+    # XXX This stops the session locale from doing the right thing.
+    # XXX Revisit this and have it translate to a lang instead of a locale.
+    #$arghash->{preferred_language} = $U->get_org_locale($arghash->{org_unit})
+    #    unless $arghash->{preferred_language};
+
+	$method = $self->method_lookup($method);
+    my ($data) = $method->run($arghash, $docache);
+
+    $arghash->{searches} = $search if (!$data->{complex_query});
+
+    $arghash->{limit} = $ol if $ol;
+    $data->{compiled_search} = $arghash;
+    $data->{query} = $orig_query;
+
+    $logger->info("compiled search is " . OpenSRF::Utils::JSON->perl2JSON($arghash));
+
+    return $data;
+}
+
+__PACKAGE__->register_method(
+    method    => 'cat_search_z_style_wrapper',
+    api_name  => 'open-ils.search.biblio.zstyle',
+    stream    => 1,
+    signature => q/@see open-ils.search.biblio.multiclass/
+);
+
+__PACKAGE__->register_method(
+    method    => 'cat_search_z_style_wrapper',
+    api_name  => 'open-ils.search.biblio.zstyle.staff',
+    stream    => 1,
+    signature => q/@see open-ils.search.biblio.multiclass/
+);
+
+sub cat_search_z_style_wrapper {
+	my $self = shift;
+	my $client = shift;
+	my $authtoken = shift;
+	my $args = shift;
+
+	my $cstore = OpenSRF::AppSession->connect('open-ils.cstore');
+
+	my $ou = $cstore->request(
+		'open-ils.cstore.direct.actor.org_unit.search',
+		{ parent_ou => undef }
+	)->gather(1);
+
+	my $result = { service => 'native-evergreen-catalog', records => [] };
+	my $searchhash = { limit => $$args{limit}, offset => $$args{offset}, org_unit => $ou->id };
+
+	$$searchhash{searches}{title}{term}   = $$args{search}{title}   if $$args{search}{title};
+	$$searchhash{searches}{author}{term}  = $$args{search}{author}  if $$args{search}{author};
+	$$searchhash{searches}{subject}{term} = $$args{search}{subject} if $$args{search}{subject};
+	$$searchhash{searches}{keyword}{term} = $$args{search}{keyword} if $$args{search}{keyword};
+
+	$$searchhash{searches}{keyword}{term} .= join ' ', $$searchhash{searches}{keyword}{term}, $$args{search}{tcn}       if $$args{search}{tcn};
+	$$searchhash{searches}{keyword}{term} .= join ' ', $$searchhash{searches}{keyword}{term}, $$args{search}{isbn}      if $$args{search}{isbn};
+	$$searchhash{searches}{keyword}{term} .= join ' ', $$searchhash{searches}{keyword}{term}, $$args{search}{issn}      if $$args{search}{issn};
+	$$searchhash{searches}{keyword}{term} .= join ' ', $$searchhash{searches}{keyword}{term}, $$args{search}{publisher} if $$args{search}{publisher};
+	$$searchhash{searches}{keyword}{term} .= join ' ', $$searchhash{searches}{keyword}{term}, $$args{search}{pubdate}   if $$args{search}{pubdate};
+	$$searchhash{searches}{keyword}{term} .= join ' ', $$searchhash{searches}{keyword}{term}, $$args{search}{item_type} if $$args{search}{item_type};
+
+	my $list = the_quest_for_knowledge( $self, $client, $searchhash );
+
+	if ($list->{count} > 0) {
+		$result->{count} = $list->{count};
+
+		my $records = $cstore->request(
+			'open-ils.cstore.direct.biblio.record_entry.search.atomic',
+			{ id => [ map { ( $_->[0] ) } @{$list->{ids}} ] }
+		)->gather(1);
+
+		for my $rec ( @$records ) {
+			
+			my $u = OpenILS::Utils::ModsParser->new();
+                        $u->start_mods_batch( $rec->marc );
+                        my $mods = $u->finish_mods_batch();
+
+			push @{ $result->{records} }, { mvr => $mods, marcxml => $rec->marc, bibid => $rec->id };
+
+		}
+
+	}
+
+    $cstore->disconnect();
+	return $result;
+}
+
+# ----------------------------------------------------------------------------
+# These are the main OPAC search methods
+# ----------------------------------------------------------------------------
+
+__PACKAGE__->register_method(
+    method    => 'the_quest_for_knowledge',
+    api_name  => 'open-ils.search.biblio.multiclass',
+    signature => {
+        desc => "Performs a multi class biblio or metabib search",
+        params => [
+            {
+                desc => "A search hash with keys: "
+                      . "searches, org_unit, depth, limit, offset, format, sort, sort_dir.  "
+                      . "See perldoc " . __PACKAGE__ . " for more detail",
+                type => 'object',
+            },
+            {
+                desc => "A flag to enable/disable searching and saving results in cache (default OFF)",
+                type => 'string',
+            }
+        ],
+        return => {
+            desc => 'An object of the form: '
+                  . '{ "count" : $count, "ids" : [ [ $id, $relevancy, $total ], ...] }',
+        }
+    }
+);
+
+=head3 open-ils.search.biblio.multiclass (search-hash, docache)
+
+The search-hash argument can have the following elements:
+
+    searches: { "$class" : "$value", ...}           [REQUIRED]
+    org_unit: The org id to focus the search at
+    depth   : The org depth     
+    limit   : The search limit      default: 10
+    offset  : The search offset     default:  0
+    format  : The MARC format
+    sort    : What field to sort the results on? [ author | title | pubdate ]
+    sort_dir: What direction do we sort? [ asc | desc ]
+    tag_circulated_records : Boolean, if true, records that are in the user's visible checkout history
+        will be tagged with an additional value ("1") as the last value in the record ID array for
+        each record.  Requires the 'authtoken'
+    authtoken : Authentication token string;  When actions are performed that require a user login
+        (e.g. tagging circulated records), the authentication token is required
+
+The searches element is required, must have a hashref value, and the hashref must contain at least one 
+of the following classes as a key:
+
+    title
+    author
+    subject
+    series
+    keyword
+
+The value paired with a key is the associated search string.
+
+The docache argument enables/disables searching and saving results in cache (default OFF).
+
+The return object, if successful, will look like:
+
+    { "count" : $count, "ids" : [ [ $id, $relevancy, $total ], ...] }
+
+=cut
+
+__PACKAGE__->register_method(
+    method    => 'the_quest_for_knowledge',
+    api_name  => 'open-ils.search.biblio.multiclass.staff',
+    signature => q/The .staff search includes hidden bibs, hidden items and bibs with no items.  Otherwise, @see open-ils.search.biblio.multiclass/
+);
+__PACKAGE__->register_method(
+    method    => 'the_quest_for_knowledge',
+    api_name  => 'open-ils.search.metabib.multiclass',
+    signature => q/@see open-ils.search.biblio.multiclass/
+);
+__PACKAGE__->register_method(
+    method    => 'the_quest_for_knowledge',
+    api_name  => 'open-ils.search.metabib.multiclass.staff',
+    signature => q/The .staff search includes hidden bibs, hidden items and bibs with no items.  Otherwise, @see open-ils.search.biblio.multiclass/
+);
+
+sub the_quest_for_knowledge {
+	my( $self, $conn, $searchhash, $docache ) = @_;
+
+	return { count => 0 } unless $searchhash and
+		ref $searchhash->{searches} eq 'HASH';
+
+	my $method = 'open-ils.storage.biblio.multiclass.search_fts';
+	my $ismeta = 0;
+	my @recs;
+
+	if($self->api_name =~ /metabib/) {
+		$ismeta = 1;
+		$method =~ s/biblio/metabib/o;
+	}
+
+	# do some simple sanity checking
+	if(!$searchhash->{searches} or
+		( !grep { /^(?:title|author|subject|series|keyword)/ } keys %{$searchhash->{searches}} ) ) {
+		return { count => 0 };
+	}
+
+    my $offset = $searchhash->{offset} ||  0;   # user value or default in local var now
+    my $limit  = $searchhash->{limit}  || 10;   # user value or default in local var now
+    my $end    = $offset + $limit - 1;
+
+	my $maxlimit = 5000;
+    $searchhash->{offset} = 0;                  # possible user value overwritten in hash
+    $searchhash->{limit}  = $maxlimit;          # possible user value overwritten in hash
+
+	return { count => 0 } if $offset > $maxlimit;
+
+	my @search;
+	push( @search, ($_ => $$searchhash{$_})) for (sort keys %$searchhash);
+	my $s = OpenSRF::Utils::JSON->perl2JSON(\@search);
+	my $ckey = $pfx . md5_hex($method . $s);
+
+	$logger->info("bib search for: $s");
+
+	$searchhash->{limit} -= $offset;
+
+
+    my $trim = 0;
+	my $result = ($docache) ? search_cache($ckey, $offset, $limit) : undef;
+
+	if(!$result) {
+
+		$method .= ".staff" if($self->api_name =~ /staff/);
+		$method .= ".atomic";
+	
+		for (keys %$searchhash) { 
+			delete $$searchhash{$_} 
+				unless defined $$searchhash{$_}; 
+		}
+	
+		$result = $U->storagereq( $method, %$searchhash );
+        $trim = 1;
+
+	} else { 
+		$docache = 0;   # results came FROM cache, so we don't write back
+	}
+
+	return {count => 0} unless ($result && $$result[0]);
+
+	@recs = @$result;
+
+	my $count = ($ismeta) ? $result->[0]->[3] : $result->[0]->[2];
+
+	if($docache) {
+		# If we didn't get this data from the cache, put it into the cache
+		# then return the correct offset of records
+		$logger->debug("putting search cache $ckey\n");
+		put_cache($ckey, $count, \@recs);
+	}
+
+    if($trim) {
+        # if we have the full set of data, trim out 
+        # the requested chunk based on limit and offset
+        my @t;
+        for ($offset..$end) {
+            last unless $recs[$_];
+            push(@t, $recs[$_]);
+        }
+        @recs = @t;
+    }
+
+	return { ids => \@recs, count => $count };
+}
+
+
+__PACKAGE__->register_method(
+    method    => 'staged_search',
+    api_name  => 'open-ils.search.biblio.multiclass.staged',
+    signature => {
+        desc   => 'Staged search filters out unavailable items.  This means that it relies on an estimation strategy for determining ' .
+                  'how big a "raw" search result chunk (i.e. a "superpage") to obtain prior to filtering.  See "estimation_strategy" in your SRF config.',
+        params => [
+            {
+                desc => "A search hash with keys: "
+                      . "searches, limit, offset.  The others are optional, but the 'searches' key/value pair is required, with the value being a hashref.  "
+                      . "See perldoc " . __PACKAGE__ . " for more detail",
+                type => 'object',
+            },
+            {
+                desc => "A flag to enable/disable searching and saving results in cache, including facets (default OFF)",
+                type => 'string',
+            }
+        ],
+        return => {
+            desc => 'Hash with keys: count, core_limit, superpage_size, superpage_summary, facet_key, ids.  '
+                  . 'The superpage_summary value is a hashref that includes keys: estimated_hit_count, visible.',
+            type => 'object',
+        }
+    }
+);
+__PACKAGE__->register_method(
+    method    => 'staged_search',
+    api_name  => 'open-ils.search.biblio.multiclass.staged.staff',
+    signature => q/The .staff search includes hidden bibs, hidden items and bibs with no items.  Otherwise, @see open-ils.search.biblio.multiclass.staged/
+);
+__PACKAGE__->register_method(
+    method    => 'staged_search',
+    api_name  => 'open-ils.search.metabib.multiclass.staged',
+    signature => q/@see open-ils.search.biblio.multiclass.staged/
+);
+__PACKAGE__->register_method(
+    method    => 'staged_search',
+    api_name  => 'open-ils.search.metabib.multiclass.staged.staff',
+    signature => q/The .staff search includes hidden bibs, hidden items and bibs with no items.  Otherwise, @see open-ils.search.biblio.multiclass.staged/
+);
+
+sub staged_search {
+	my($self, $conn, $search_hash, $docache) = @_;
+
+    my $IAmMetabib = ($self->api_name =~ /metabib/) ? 1 : 0;
+
+    my $method = $IAmMetabib?
+        'open-ils.storage.metabib.multiclass.staged.search_fts':
+        'open-ils.storage.biblio.multiclass.staged.search_fts';
+
+    $method .= '.staff' if $self->api_name =~ /staff$/;
+    $method .= '.atomic';
+                
+    return {count => 0} unless (
+        $search_hash and 
+        $search_hash->{searches} and 
+        scalar( keys %{$search_hash->{searches}} ));
+
+    my $search_duration;
+    my $user_offset = $search_hash->{offset} ||  0; # user-specified offset
+    my $user_limit  = $search_hash->{limit}  || 10;
+    my $ignore_facet_classes  = $search_hash->{ignore_facet_classes};
+    $user_offset = ($user_offset >= 0) ? $user_offset :  0;
+    $user_limit  = ($user_limit  >= 0) ? $user_limit  : 10;
+
+
+    # we're grabbing results on a per-superpage basis, which means the 
+    # limit and offset should coincide with superpage boundaries
+    $search_hash->{offset} = 0;
+    $search_hash->{limit} = $superpage_size;
+
+    # force a well-known check_limit
+    $search_hash->{check_limit} = $superpage_size; 
+    # restrict total tested to superpage size * number of superpages
+    $search_hash->{core_limit}  = $superpage_size * $max_superpages;
+
+    # Set the configured estimation strategy, defaults to 'inclusion'.
+	my $estimation_strategy = OpenSRF::Utils::SettingsClient
+        ->new
+        ->config_value(
+            apps => 'open-ils.search', app_settings => 'estimation_strategy'
+        ) || 'inclusion';
+	$search_hash->{estimation_strategy} = $estimation_strategy;
+
+    # pull any existing results from the cache
+    my $key = search_cache_key($method, $search_hash);
+    my $facet_key = $key.'_facets';
+    my $cache_data = $cache->get_cache($key) || {};
+
+    # keep retrieving results until we find enough to 
+    # fulfill the user-specified limit and offset
+    my $all_results = [];
+    my $page; # current superpage
+    my $est_hit_count = 0;
+    my $current_page_summary = {};
+    my $global_summary = {checked => 0, visible => 0, excluded => 0, deleted => 0, total => 0};
+    my $is_real_hit_count = 0;
+    my $new_ids = [];
+
+    for($page = 0; $page < $max_superpages; $page++) {
+
+        my $data = $cache_data->{$page};
+        my $results;
+        my $summary;
+
+        $logger->debug("staged search: analyzing superpage $page");
+
+        if($data) {
+            # this window of results is already cached
+            $logger->debug("staged search: found cached results");
+            $summary = $data->{summary};
+            $results = $data->{results};
+
+        } else {
+            # retrieve the window of results from the database
+            $logger->debug("staged search: fetching results from the database");
+            $search_hash->{skip_check} = $page * $superpage_size;
+            my $start = time;
+            $results = $U->storagereq($method, %$search_hash);
+            $search_duration = time - $start;
+            $logger->info("staged search: DB call took $search_duration seconds and returned ".scalar(@$results)." rows, including summary");
+            $summary = shift(@$results) if $results;
+
+            unless($summary) {
+                $logger->info("search timed out: duration=$search_duration: params=".
+                    OpenSRF::Utils::JSON->perl2JSON($search_hash));
+                return {count => 0};
+            }
+
+            my $hc = $summary->{estimated_hit_count} || $summary->{visible};
+            if($hc == 0) {
+                $logger->info("search returned 0 results: duration=$search_duration: params=".
+                    OpenSRF::Utils::JSON->perl2JSON($search_hash));
+            }
+
+            # Create backwards-compatible result structures
+            if($IAmMetabib) {
+                $results = [map {[$_->{id}, $_->{rel}, $_->{record}]} @$results];
+            } else {
+                $results = [map {[$_->{id}]} @$results];
+            }
+
+            tag_circulated_records($search_hash->{authtoken}, $results, $IAmMetabib) 
+                if $search_hash->{tag_circulated_records} and $search_hash->{authtoken};
+
+            push @$new_ids, grep {defined($_)} map {$_->[0]} @$results;
+            $results = [grep {defined $_->[0]} @$results];
+            cache_staged_search_page($key, $page, $summary, $results) if $docache;
+        }
+
+        $current_page_summary = $summary;
+
+        # add the new set of results to the set under construction
+        push(@$all_results, @$results);
+
+        my $current_count = scalar(@$all_results);
+
+        $est_hit_count = $summary->{estimated_hit_count} || $summary->{visible}
+            if $page == 0;
+
+        $logger->debug("staged search: located $current_count, with estimated hits=".
+            $summary->{estimated_hit_count}." : visible=".$summary->{visible}.", checked=".$summary->{checked});
+
+		if (defined($summary->{estimated_hit_count})) {
+            foreach (qw/ checked visible excluded deleted /) {
+                $global_summary->{$_} += $summary->{$_};
+            }
+			$global_summary->{total} = $summary->{total};
+		}
+
+        # we've found all the possible hits
+        last if $current_count == $summary->{visible}
+            and not defined $summary->{estimated_hit_count};
+
+        # we've found enough results to satisfy the requested limit/offset
+        last if $current_count >= ($user_limit + $user_offset);
+
+        # we've scanned all possible hits
+        if($summary->{checked} < $superpage_size) {
+            $est_hit_count = scalar(@$all_results);
+            # we have all possible results in hand, so we know the final hit count
+            $is_real_hit_count = 1;
+            last;
+        }
+    }
+
+    my @results = grep {defined $_} @$all_results[$user_offset..($user_offset + $user_limit - 1)];
+
+	# refine the estimate if we have more than one superpage
+	if ($page > 0 and not $is_real_hit_count) {
+		if ($global_summary->{checked} >= $global_summary->{total}) {
+			$est_hit_count = $global_summary->{visible};
+		} else {
+			my $updated_hit_count = $U->storagereq(
+				'open-ils.storage.fts_paging_estimate',
+				$global_summary->{checked},
+				$global_summary->{visible},
+				$global_summary->{excluded},
+				$global_summary->{deleted},
+				$global_summary->{total}
+			);
+			$est_hit_count = $updated_hit_count->{$estimation_strategy};
+		}
+	}
+
+    $conn->respond_complete(
+        {
+            count             => $est_hit_count,
+            core_limit        => $search_hash->{core_limit},
+            superpage_size    => $search_hash->{check_limit},
+            superpage_summary => $current_page_summary,
+            facet_key         => $facet_key,
+            ids               => \@results
+        }
+    );
+
+    cache_facets($facet_key, $new_ids, $IAmMetabib, $ignore_facet_classes) if $docache;
+
+    return undef;
+}
+
+sub tag_circulated_records {
+    my ($auth, $results, $metabib) = @_;
+    my $e = new_editor(authtoken => $auth);
+    return $results unless $e->checkauth;
+
+    my $query = {
+        select   => { acn => [{ column => 'record', alias => 'tagme' }] }, 
+        from     => { acp => 'acn' }, 
+        where    => { id => { in => { from => ['action.usr_visible_circ_copies', $e->requestor->id] } } },
+        distinct => 1
+    };
+
+    if ($metabib) {
+        $query = {
+            select   => { mmsm => [{ column => 'metarecord', alias => 'tagme' }] },
+            from     => 'mmsm',
+            where    => { source => { in => $query } },
+            distinct => 1
+        };
+    }
+
+    # Give me the distinct set of bib records that exist in the user's visible circulation history
+    my $circ_recs = $e->json_query( $query );
+
+    # if the record appears in the circ history, push a 1 onto 
+    # the rec array structure to indicate truthiness
+    for my $rec (@$results) {
+        push(@$rec, 1) if grep { $_->{tagme} eq $$rec[0] } @$circ_recs;
+    }
+
+    $results
+}
+
+# creates a unique token to represent the query in the cache
+sub search_cache_key {
+    my $method = shift;
+    my $search_hash = shift;
+	my @sorted;
+    for my $key (sort keys %$search_hash) {
+	    push(@sorted, ($key => $$search_hash{$key})) 
+            unless $key eq 'limit'  or 
+                   $key eq 'offset' or 
+                   $key eq 'skip_check';
+    }
+	my $s = OpenSRF::Utils::JSON->perl2JSON(\@sorted);
+	return $pfx . md5_hex($method . $s);
+}
+
+sub retrieve_cached_facets {
+    my $self   = shift;
+    my $client = shift;
+    my $key    = shift;
+    my $limit    = shift;
+
+    return undef unless ($key and $key =~ /_facets$/);
+
+    my $blob = $cache->get_cache($key) || {};
+
+    my $facets = {};
+    if ($limit) {
+       for my $f ( keys %$blob ) {
+            my @sorted = map{ { $$_[1] => $$_[0] } } sort {$$b[0] <=> $$a[0] || $$a[1] cmp $$b[1]} map { [$$blob{$f}{$_}, $_] } keys %{ $$blob{$f} };
+            @sorted = @sorted[0 .. $limit - 1] if (scalar(@sorted) > $limit);
+            for my $s ( @sorted ) {
+                my ($k) = keys(%$s);
+                my ($v) = values(%$s);
+                $$facets{$f}{$k} = $v;
+            }
+        }
+    } else {
+        $facets = $blob;
+    }
+
+    return $facets;
+}
+
+__PACKAGE__->register_method(
+    method   => "retrieve_cached_facets",
+    api_name => "open-ils.search.facet_cache.retrieve",
+    signature => {
+        desc   => 'Returns facet data derived from a specific search based on a key '.
+                  'generated by open-ils.search.biblio.multiclass.staged and friends.',
+        params => [
+            {
+                desc => "The facet cache key returned with the initial search as the facet_key hash value",
+                type => 'string',
+            }
+        ],
+        return => {
+            desc => 'Two level hash of facet values.  Top level key is the facet id defined on the config.metabib_field table.  '.
+                    'Second level key is a string facet value.  Datum attached to each facet value is the number of distinct records, '.
+                    'or metarecords for a metarecord search, which use that facet value and are visible to the search at the time of '.
+                    'facet retrieval.  These counts are calculated for all superpages that have been checked for visibility.',
+            type => 'object',
+        }
+    }
+);
+
+
+sub cache_facets {
+    # add facets for this search to the facet cache
+    my($key, $results, $metabib, $ignore) = @_;
+    my $data = $cache->get_cache($key);
+    $data ||= {};
+
+    if (!ref($ignore)) {
+        $ignore = ['identifier']; # ignore the identifier class by default
+    }
+
+    return undef unless (@$results);
+
+    # The query we're constructing
+    #
+    # select  mfae.field as id,
+    #         mfae.value,
+    #         count(distinct mmrsm.appropriate-id-field )
+    #   from  metabib.facet_entry mfae
+    #         join metabib.metarecord_sourc_map mmrsm on (mfae.source = mmrsm.source)
+    #   where mmrsm.appropriate-id-field in IDLIST
+    #   group by 1,2;
+
+    my $count_field = $metabib ? 'metarecord' : 'source';
+    my $facets = $U->cstorereq( "open-ils.cstore.json_query.atomic",
+        {   select  => {
+                mfae => [ { column => 'field', alias => 'id'}, 'value' ],
+                mmrsm => [{
+                    transform => 'count',
+                    distinct => 1,
+                    column => $count_field,
+                    alias => 'count',
+                    aggregate => 1
+                }]
+            },
+            from    => {
+                mfae => {
+                    mmrsm => { field => 'source', fkey => 'source' },
+                    cmf   => { field => 'id', fkey => 'field' }
+                }
+            },
+            where   => {
+                '+mmrsm' => { $count_field => $results },
+                '+cmf'   => { field_class => { 'not in' => $ignore } }
+            }
+        }
+    );
+
+    for my $facet (@$facets) {
+        next unless ($facet->{value});
+        $data->{$facet->{id}}->{$facet->{value}} += $facet->{count};
+    }
+
+    $logger->info("facet compilation: cached with key=$key");
+
+    $cache->put_cache($key, $data, $cache_timeout);
+}
+
+sub cache_staged_search_page {
+    # puts this set of results into the cache
+    my($key, $page, $summary, $results) = @_;
+    my $data = $cache->get_cache($key);
+    $data ||= {};
+    $data->{$page} = {
+        summary => $summary,
+        results => $results
+    };
+
+    $logger->info("staged search: cached with key=$key, superpage=$page, estimated=".
+        $summary->{estimated_hit_count}.", visible=".$summary->{visible});
+
+    $cache->put_cache($key, $data, $cache_timeout);
+}
+
+sub search_cache {
+
+	my $key		= shift;
+	my $offset	= shift;
+	my $limit	= shift;
+	my $start	= $offset;
+	my $end		= $offset + $limit - 1;
+
+	$logger->debug("searching cache for $key : $start..$end\n");
+
+	return undef unless $cache;
+	my $data = $cache->get_cache($key);
+
+	return undef unless $data;
+
+	my $count = $data->[0];
+	$data = $data->[1];
+
+	return undef unless $offset < $count;
+
+	my @result;
+	for( my $i = $offset; $i <= $end; $i++ ) {
+		last unless my $d = $$data[$i];
+		push( @result, $d );
+	}
+
+	$logger->debug("search_cache found ".scalar(@result)." items for count=$count, start=$start, end=$end");
+
+	return \@result;
+}
+
+
+sub put_cache {
+	my( $key, $count, $data ) = @_;
+	return undef unless $cache;
+	$logger->debug("search_cache putting ".
+		scalar(@$data)." items at key $key with timeout $cache_timeout");
+	$cache->put_cache($key, [ $count, $data ], $cache_timeout);
+}
+
+
+__PACKAGE__->register_method(
+    method   => "biblio_mrid_to_modsbatch_batch",
+    api_name => "open-ils.search.biblio.metarecord.mods_slim.batch.retrieve"
+);
+
+sub biblio_mrid_to_modsbatch_batch {
+	my( $self, $client, $mrids) = @_;
+	# warn "Performing mrid_to_modsbatch_batch..."; # unconditional warn
+	my @mods;
+	my $method = $self->method_lookup("open-ils.search.biblio.metarecord.mods_slim.retrieve");
+	for my $id (@$mrids) {
+		next unless defined $id;
+		my ($m) = $method->run($id);
+		push @mods, $m;
+	}
+	return \@mods;
+}
+
+
+foreach (qw /open-ils.search.biblio.metarecord.mods_slim.retrieve
+             open-ils.search.biblio.metarecord.mods_slim.retrieve.staff/)
+    {
+    __PACKAGE__->register_method(
+        method    => "biblio_mrid_to_modsbatch",
+        api_name  => $_,
+        signature => {
+            desc   => "Returns the mvr associated with a given metarecod. If none exists, it is created.  "
+                    . "As usual, the .staff version of this method will include otherwise hidden records.",
+            params => [
+                { desc => 'Metarecord ID', type => 'number' },
+                { desc => '(Optional) Search filters hash with possible keys: format, org, depth', type => 'object' }
+            ],
+            return => {
+                desc => 'MVR Object, event on error',
+            }
+        }
+    );
+}
+
+sub biblio_mrid_to_modsbatch {
+	my( $self, $client, $mrid, $args) = @_;
+
+	# warn "Grabbing mvr for $mrid\n";    # unconditional warn
+
+	my ($mr, $evt) = _grab_metarecord($mrid);
+	return $evt unless $mr;
+
+	my $mvr = biblio_mrid_check_mvr($self, $client, $mr) ||
+              biblio_mrid_make_modsbatch($self, $client, $mr);
+
+	return $mvr unless ref($args);	
+
+	# Here we find the lead record appropriate for the given filters 
+	# and use that for the title and author of the metarecord
+    my $format = $$args{format};
+    my $org    = $$args{org};
+    my $depth  = $$args{depth};
+
+	return $mvr unless $format or $org or $depth;
+
+	my $method = "open-ils.storage.ordered.metabib.metarecord.records";
+	$method = "$method.staff" if $self->api_name =~ /staff/o; 
+
+	my $rec = $U->storagereq($method, $format, $org, $depth, 1);
+
+	if( my $mods = $U->record_to_mvr($rec) ) {
+
+        $mvr->title( $mods->title );
+        $mvr->author($mods->author);
+		$logger->debug("mods_slim updating title and ".
+			"author in mvr with ".$mods->title." : ".$mods->author);
+	}
+
+	return $mvr;
+}
+
+# converts a metarecord to an mvr
+sub _mr_to_mvr {
+	my $mr = shift;
+	my $perl = OpenSRF::Utils::JSON->JSON2perl($mr->mods());
+	return Fieldmapper::metabib::virtual_record->new($perl);
+}
+
+# checks to see if a metarecord has mods, if so returns true;
+
+__PACKAGE__->register_method(
+    method   => "biblio_mrid_check_mvr",
+    api_name => "open-ils.search.biblio.metarecord.mods_slim.check",
+    notes    => "Takes a metarecord ID or a metarecord object and returns true "
+              . "if the metarecord already has an mvr associated with it."
+);
+
+sub biblio_mrid_check_mvr {
+	my( $self, $client, $mrid ) = @_;
+	my $mr; 
+
+	my $evt;
+	if(ref($mrid)) { $mr = $mrid; } 
+	else { ($mr, $evt) = _grab_metarecord($mrid); }
+	return $evt if $evt;
+
+	# warn "Checking mvr for mr " . $mr->id . "\n";   # unconditional warn
+
+	return _mr_to_mvr($mr) if $mr->mods();
+	return undef;
+}
+
+sub _grab_metarecord {
+	my $mrid = shift;
+	#my $e = OpenILS::Utils::Editor->new;
+	my $e = new_editor();
+	my $mr = $e->retrieve_metabib_metarecord($mrid) or return ( undef, $e->event );
+	return ($mr);
+}
+
+
+__PACKAGE__->register_method(
+    method   => "biblio_mrid_make_modsbatch",
+    api_name => "open-ils.search.biblio.metarecord.mods_slim.create",
+    notes    => "Takes either a metarecord ID or a metarecord object. "
+              . "Forces the creations of an mvr for the given metarecord. "
+              . "The created mvr is returned."
+);
+
+sub biblio_mrid_make_modsbatch {
+	my( $self, $client, $mrid ) = @_;
+
+	#my $e = OpenILS::Utils::Editor->new;
+	my $e = new_editor();
+
+	my $mr;
+	if( ref($mrid) ) {
+		$mr = $mrid;
+		$mrid = $mr->id;
+	} else {
+		$mr = $e->retrieve_metabib_metarecord($mrid) 
+			or return $e->event;
+	}
+
+	my $masterid = $mr->master_record;
+	$logger->info("creating new mods batch for metarecord=$mrid, master record=$masterid");
+
+	my $ids = $U->storagereq(
+		'open-ils.storage.ordered.metabib.metarecord.records.staff.atomic', $mrid);
+	return undef unless @$ids;
+
+	my $master = $e->retrieve_biblio_record_entry($masterid)
+		or return $e->event;
+
+	# start the mods batch
+	my $u = OpenILS::Utils::ModsParser->new();
+	$u->start_mods_batch( $master->marc );
+
+	# grab all of the sub-records and shove them into the batch
+	my @ids = grep { $_ ne $masterid } @$ids;
+	#my $subrecs = (@ids) ? $e->batch_retrieve_biblio_record_entry(\@ids) : [];
+
+	my $subrecs = [];
+	if(@$ids) {
+		for my $i (@$ids) {
+			my $r = $e->retrieve_biblio_record_entry($i);
+			push( @$subrecs, $r ) if $r;
+		}
+	}
+
+	for(@$subrecs) {
+		$logger->debug("adding record ".$_->id." to mods batch for metarecord=$mrid");
+		$u->push_mods_batch( $_->marc ) if $_->marc;
+	}
+
+
+	# finish up and send to the client
+	my $mods = $u->finish_mods_batch();
+	$mods->doc_id($mrid);
+	$client->respond_complete($mods);
+
+
+	# now update the mods string in the db
+	my $string = OpenSRF::Utils::JSON->perl2JSON($mods->decast);
+	$mr->mods($string);
+
+	#$e = OpenILS::Utils::Editor->new(xact => 1);
+	$e = new_editor(xact => 1);
+	$e->update_metabib_metarecord($mr) 
+		or $logger->error("Error setting mods text on metarecord $mrid : " . Dumper($e->event));
+	$e->finish;
+
+	return undef;
+}
+
+
+# converts a mr id into a list of record ids
+
+foreach (qw/open-ils.search.biblio.metarecord_to_records
+            open-ils.search.biblio.metarecord_to_records.staff/)
+{
+    __PACKAGE__->register_method(
+        method    => "biblio_mrid_to_record_ids",
+        api_name  => $_,
+        signature => {
+            desc   => "Fetch record IDs corresponding to a meta-record ID, with optional search filters. "
+                    . "As usual, the .staff version of this method will include otherwise hidden records.",
+            params => [
+                { desc => 'Metarecord ID', type => 'number' },
+                { desc => '(Optional) Search filters hash with possible keys: format, org, depth', type => 'object' }
+            ],
+            return => {
+                desc => 'Results object like {count => $i, ids =>[...]}',
+                type => 'object'
+            }
+            
+        }
+    );
+}
+
+sub biblio_mrid_to_record_ids {
+	my( $self, $client, $mrid, $args ) = @_;
+
+    my $format = $$args{format};
+    my $org    = $$args{org};
+    my $depth  = $$args{depth};
+
+	my $method = "open-ils.storage.ordered.metabib.metarecord.records.atomic";
+	$method =~ s/atomic/staff\.atomic/o if $self->api_name =~ /staff/o; 
+	my $recs = $U->storagereq($method, $mrid, $format, $org, $depth);
+
+	return { count => scalar(@$recs), ids => $recs };
+}
+
+
+__PACKAGE__->register_method(
+    method   => "biblio_record_to_marc_html",
+    api_name => "open-ils.search.biblio.record.html"
+);
+
+__PACKAGE__->register_method(
+    method   => "biblio_record_to_marc_html",
+    api_name => "open-ils.search.authority.to_html"
+);
+
+# Persistent parsers and setting objects
+my $parser = XML::LibXML->new();
+my $xslt   = XML::LibXSLT->new();
+my $marc_sheet;
+my $slim_marc_sheet;
+my $settings_client = OpenSRF::Utils::SettingsClient->new();
+
+sub biblio_record_to_marc_html {
+	my($self, $client, $recordid, $slim, $marcxml) = @_;
+
+    my $sheet;
+	my $dir = $settings_client->config_value("dirs", "xsl");
+
+    if($slim) {
+        unless($slim_marc_sheet) {
+		    my $xsl = $settings_client->config_value(
+			    "apps", "open-ils.search", "app_settings", 'marc_html_xsl_slim');
+            if($xsl) {
+		        $xsl = $parser->parse_file("$dir/$xsl");
+		        $slim_marc_sheet = $xslt->parse_stylesheet($xsl);
+            }
+        }
+        $sheet = $slim_marc_sheet;
+    }
+
+    unless($sheet) {
+        unless($marc_sheet) {
+            my $xsl_key = ($slim) ? 'marc_html_xsl_slim' : 'marc_html_xsl';
+		    my $xsl = $settings_client->config_value(
+			    "apps", "open-ils.search", "app_settings", 'marc_html_xsl');
+		    $xsl = $parser->parse_file("$dir/$xsl");
+		    $marc_sheet = $xslt->parse_stylesheet($xsl);
+        }
+        $sheet = $marc_sheet;
+    }
+
+    my $record;
+    unless($marcxml) {
+        my $e = new_editor();
+        if($self->api_name =~ /authority/) {
+            $record = $e->retrieve_authority_record_entry($recordid)
+                or return $e->event;
+        } else {
+            $record = $e->retrieve_biblio_record_entry($recordid)
+                or return $e->event;
+        }
+        $marcxml = $record->marc;
+    }
+
+	my $xmldoc = $parser->parse_string($marcxml);
+	my $html = $sheet->transform($xmldoc);
+	return $html->documentElement->toString();
+}
+
+__PACKAGE__->register_method(
+    method    => "format_biblio_record_entry",
+    api_name  => "open-ils.search.biblio.record.print",
+    signature => {
+        desc   => 'Returns a printable version of the specified bib record',
+        params => [
+            { desc => 'Biblio record entry ID or array of IDs', type => 'number' },
+        ],
+        return => {
+            desc => q/An action_trigger.event object or error event./,
+            type => 'object',
+        }
+    }
+);
+__PACKAGE__->register_method(
+    method    => "format_biblio_record_entry",
+    api_name  => "open-ils.search.biblio.record.email",
+    signature => {
+        desc   => 'Emails an A/T templated version of the specified bib records to the authorized user',
+        params => [
+            { desc => 'Authentication token',  type => 'string'},
+            { desc => 'Biblio record entry ID or array of IDs', type => 'number' },
+        ],
+        return => {
+            desc => q/Undefined on success, otherwise an error event./,
+            type => 'object',
+        }
+    }
+);
+
+sub format_biblio_record_entry {
+    my($self, $conn, $arg1, $arg2) = @_;
+
+    my $for_print = ($self->api_name =~ /print/);
+    my $for_email = ($self->api_name =~ /email/);
+
+    my $e; my $auth; my $bib_id; my $context_org;
+
+    if ($for_print) {
+        $bib_id = $arg1;
+        $context_org = $arg2 || $U->fetch_org_tree->id;
+        $e = new_editor(xact => 1);
+    } elsif ($for_email) {
+        $auth = $arg1;
+        $bib_id = $arg2;
+        $e = new_editor(authtoken => $auth, xact => 1);
+        return $e->die_event unless $e->checkauth;
+        $context_org = $e->requestor->home_ou;
+    }
+
+    my $bib_ids;
+    if (ref $bib_id ne 'ARRAY') {
+        $bib_ids = [ $bib_id ];
+    } else {
+        $bib_ids = $bib_id;
+    }
+
+    my $bucket = Fieldmapper::container::biblio_record_entry_bucket->new;
+    $bucket->btype('temp');
+    $bucket->name('format_biblio_record_entry ' . $U->create_uuid_string);
+    if ($for_email) {
+        $bucket->owner($e->requestor) 
+    } else {
+        $bucket->owner(1);
+    }
+    my $bucket_obj = $e->create_container_biblio_record_entry_bucket($bucket);
+
+    for my $id (@$bib_ids) {
+
+        my $bib = $e->retrieve_biblio_record_entry([$id]) or return $e->die_event;
+
+        my $bucket_entry = Fieldmapper::container::biblio_record_entry_bucket_item->new;
+        $bucket_entry->target_biblio_record_entry($bib);
+        $bucket_entry->bucket($bucket_obj->id);
+        $e->create_container_biblio_record_entry_bucket_item($bucket_entry);
+    }
+
+    $e->commit;
+
+    if ($for_print) {
+
+        return $U->fire_object_event(undef, 'biblio.format.record_entry.print', [ $bucket ], $context_org);
+
+    } elsif ($for_email) {
+
+        $U->create_events_for_hook('biblio.format.record_entry.email', $bucket, $context_org, undef, undef, 1);
+    }
+
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+    method   => "retrieve_all_copy_statuses",
+    api_name => "open-ils.search.config.copy_status.retrieve.all"
+);
+
+sub retrieve_all_copy_statuses {
+	my( $self, $client ) = @_;
+	return new_editor()->retrieve_all_config_copy_status();
+}
+
+
+__PACKAGE__->register_method(
+    method   => "copy_counts_per_org",
+    api_name => "open-ils.search.biblio.copy_counts.retrieve"
+);
+
+__PACKAGE__->register_method(
+    method   => "copy_counts_per_org",
+    api_name => "open-ils.search.biblio.copy_counts.retrieve.staff"
+);
+
+sub copy_counts_per_org {
+	my( $self, $client, $record_id ) = @_;
+
+	warn "Retreiveing copy copy counts for record $record_id and method " . $self->api_name . "\n";
+
+	my $method = "open-ils.storage.biblio.record_entry.global_copy_count.atomic";
+	if($self->api_name =~ /staff/) { $method =~ s/atomic/staff\.atomic/; }
+
+	my $counts = $apputils->simple_scalar_request(
+		"open-ils.storage", $method, $record_id );
+
+	$counts = [ sort {$a->[0] <=> $b->[0]} @$counts ];
+	return $counts;
+}
+
+
+__PACKAGE__->register_method(
+    method   => "copy_count_summary",
+    api_name => "open-ils.search.biblio.copy_counts.summary.retrieve",
+    notes    => "returns an array of these: "
+              . "[ org_id, callnumber_label, , ,...] "
+              . "where statusx is a copy status name.  The statuses are sorted by ID.",
+);
+		
+
+sub copy_count_summary {
+	my( $self, $client, $rid, $org, $depth ) = @_;
+    $org   ||= 1;
+    $depth ||= 0;
+    my $data = $U->storagereq(
+		'open-ils.storage.biblio.record_entry.status_copy_count.atomic', $rid, $org, $depth );
+
+    return [ sort { $a->[1] cmp $b->[1] } @$data ];
+}
+
+__PACKAGE__->register_method(
+    method   => "copy_location_count_summary",
+    api_name => "open-ils.search.biblio.copy_location_counts.summary.retrieve",
+    notes    => "returns an array of these: "
+              . "[ org_id, callnumber_label, copy_location, , ,...] "
+              . "where statusx is a copy status name.  The statuses are sorted by ID.",
+);
+
+sub copy_location_count_summary {
+    my( $self, $client, $rid, $org, $depth ) = @_;
+    $org   ||= 1;
+    $depth ||= 0;
+    my $data = $U->storagereq(
+		'open-ils.storage.biblio.record_entry.status_copy_location_count.atomic', $rid, $org, $depth );
+
+    return [ sort { $a->[1] cmp $b->[1] || $a->[2] cmp $b->[2] } @$data ];
+}
+
+__PACKAGE__->register_method(
+    method   => "copy_count_location_summary",
+    api_name => "open-ils.search.biblio.copy_counts.location.summary.retrieve",
+    notes    => "returns an array of these: "
+              . "[ org_id, callnumber_label, , ,...] "
+              . "where statusx is a copy status name.  The statuses are sorted by ID."
+);
+
+sub copy_count_location_summary {
+    my( $self, $client, $rid, $org, $depth ) = @_;
+    $org   ||= 1;
+    $depth ||= 0;
+    my $data = $U->storagereq(
+        'open-ils.storage.biblio.record_entry.status_copy_location_count.atomic', $rid, $org, $depth );
+    return [ sort { $a->[1] cmp $b->[1] } @$data ];
+}
+
+
+foreach (qw/open-ils.search.biblio.marc
+            open-ils.search.biblio.marc.staff/)
+{
+__PACKAGE__->register_method(
+    method    => "marc_search",
+    api_name  => $_,
+    signature => {
+        desc   => 'Fetch biblio IDs based on MARC record criteria.  '
+                . 'As usual, the .staff version of the search includes otherwise hidden records',
+        params => [
+            {
+                desc => 'Search hash (required) with possible elements: searches, limit, offset, sort, sort_dir. ' .
+                        'See perldoc ' . __PACKAGE__ . ' for more detail.',
+                type => 'object'
+            },
+            {desc => 'limit (optional)',  type => 'number'},
+            {desc => 'offset (optional)', type => 'number'}
+        ],
+        return => {
+            desc => 'Results object like: { "count": $i, "ids": [...] }',
+            type => 'object'
+        }
+    }
+);
+}
+
+=head3 open-ils.search.biblio.marc (arghash, limit, offset)
+
+As elsewhere the arghash is the required argument, and must be a hashref.  The keys are:
+
+    searches: complex query object  (required)
+    org_unit: The org ID to focus the search at
+    depth   : The org depth     
+    limit   : integer search limit      default: 10
+    offset  : integer search offset     default:  0
+    sort    : What field to sort the results on? [ author | title | pubdate ]
+    sort_dir: In what direction do we sort? [ asc | desc ]
+
+Additional keys to refine search criteria:
+
+    audience : Audience
+    language : Language (code)
+    lit_form : Literary form
+    item_form: Item form
+    item_type: Item type
+    format   : The MARC format
+
+Please note that the specific strings to be used in the "addtional keys" will be entirely
+dependent on your loaded data.  
+
+All keys except "searches" are optional.
+The "searches" value must be an arrayref of hashref elements, including keys "term" and "restrict".  
+
+For example, an arg hash might look like:
+
+    $arghash = {
+        searches => [
+            {
+                term     => "harry",
+                restrict => [
+                    {
+                        tag => 245,
+                        subfield => "a"
+                    }
+                    # ...
+                ]
+            }
+            # ...
+        ],
+        org_unit  => 1,
+        limit     => 5,
+        sort      => "author",
+        item_type => "g"
+    }
+
+The arghash is eventually passed to the SRF call:
+L
+
+Presently, search uses the cache unconditionally.
+
+=cut
+
+# FIXME: that example above isn't actually tested.
+# TODO: docache option?
+sub marc_search {
+	my( $self, $conn, $args, $limit, $offset ) = @_;
+
+	my $method = 'open-ils.storage.biblio.full_rec.multi_search';
+	$method .= ".staff" if $self->api_name =~ /staff/;
+	$method .= ".atomic";
+
+    $limit  ||= 10;     # FIXME: what about $args->{limit} ?
+    $offset ||=  0;     # FIXME: what about $args->{offset} ?
+
+	my @search;
+	push( @search, ($_ => $$args{$_}) ) for (sort keys %$args);
+	my $ckey = $pfx . md5_hex($method . OpenSRF::Utils::JSON->perl2JSON(\@search));
+
+	my $recs = search_cache($ckey, $offset, $limit);
+
+	if(!$recs) {
+		$recs = $U->storagereq($method, %$args) || [];
+		if( $recs ) {
+			put_cache($ckey, scalar(@$recs), $recs);
+			$recs = [ @$recs[$offset..($offset + ($limit - 1))] ];
+		} else {
+			$recs = [];
+		}
+	}
+
+	my $count = 0;
+	$count = $recs->[0]->[2] if $recs->[0] and $recs->[0]->[2];
+	my @recs = map { $_->[0] } @$recs;
+
+	return { ids => \@recs, count => $count };
+}
+
+
+__PACKAGE__->register_method(
+    method    => "biblio_search_isbn",
+    api_name  => "open-ils.search.biblio.isbn",
+    signature => {
+        desc   => 'Retrieve biblio IDs for a given ISBN',
+        params => [
+            {desc => 'ISBN', type => 'string'}  # or number maybe?  How normalized is our storage data?
+        ],
+        return => {
+            desc => 'Results object like: { "count": $i, "ids": [...] }',
+            type => 'object'
+        }
+    }
+);
+
+sub biblio_search_isbn { 
+	my( $self, $client, $isbn ) = @_;
+	$logger->debug("Searching ISBN $isbn");
+	my $recs = $U->storagereq('open-ils.storage.id_list.biblio.record_entry.search.isbn.atomic', $isbn);
+	return { ids => $recs, count => scalar(@$recs) };
+}
+
+__PACKAGE__->register_method(
+    method   => "biblio_search_isbn_batch",
+    api_name => "open-ils.search.biblio.isbn_list",
+);
+
+sub biblio_search_isbn_batch { 
+	my( $self, $client, $isbn_list ) = @_;
+	$logger->debug("Searching ISBNs @$isbn_list");
+	my @recs = (); my %rec_set = ();
+	foreach my $isbn ( @$isbn_list ) {
+		foreach my $rec ( @{ $U->storagereq(
+			'open-ils.storage.id_list.biblio.record_entry.search.isbn.atomic', $isbn )
+		} ) {
+			if (! $rec_set{ $rec }) {
+				$rec_set{ $rec } = 1;
+				push @recs, $rec;
+			}
+		}
+	}
+	return { ids => \@recs, count => scalar(@recs) };
+}
+
+__PACKAGE__->register_method(
+    method   => "biblio_search_issn",
+    api_name => "open-ils.search.biblio.issn",
+    signature => {
+        desc   => 'Retrieve biblio IDs for a given ISSN',
+        params => [
+            {desc => 'ISBN', type => 'string'}
+        ],
+        return => {
+            desc => 'Results object like: { "count": $i, "ids": [...] }',
+            type => 'object'
+        }
+    }
+);
+
+sub biblio_search_issn { 
+	my( $self, $client, $issn ) = @_;
+	$logger->debug("Searching ISSN $issn");
+	my $e = new_editor();
+	$issn =~ s/-/ /g;
+	my $recs = $U->storagereq(
+		'open-ils.storage.id_list.biblio.record_entry.search.issn.atomic', $issn );
+	return { ids => $recs, count => scalar(@$recs) };
+}
+
+
+__PACKAGE__->register_method(
+    method    => "fetch_mods_by_copy",
+    api_name  => "open-ils.search.biblio.mods_from_copy",
+    argc      => 1,
+    signature => {
+        desc    => 'Retrieve MODS record given an attached copy ID',
+        params  => [
+            { desc => 'Copy ID', type => 'number' }
+        ],
+        returns => {
+            desc => 'MODS record, event on error or uncataloged item'
+        }
+    }
+);
+
+sub fetch_mods_by_copy {
+	my( $self, $client, $copyid ) = @_;
+	my ($record, $evt) = $apputils->fetch_record_by_copy( $copyid );
+	return $evt if $evt;
+	return OpenILS::Event->new('ITEM_NOT_CATALOGED') unless $record->marc;
+	return $apputils->record_to_mvr($record);
+}
+
+
+# -------------------------------------------------------------------------------------
+
+__PACKAGE__->register_method(
+    method   => "cn_browse",
+    api_name => "open-ils.search.callnumber.browse.target",
+    notes    => "Starts a callnumber browse"
+);
+
+__PACKAGE__->register_method(
+    method   => "cn_browse",
+    api_name => "open-ils.search.callnumber.browse.page_up",
+    notes    => "Returns the previous page of callnumbers",
+);
+
+__PACKAGE__->register_method(
+    method   => "cn_browse",
+    api_name => "open-ils.search.callnumber.browse.page_down",
+    notes    => "Returns the next page of callnumbers",
+);
+
+
+# RETURNS array of arrays like so: label, owning_lib, record, id
+sub cn_browse {
+	my( $self, $client, @params ) = @_;
+	my $method;
+
+	$method = 'open-ils.storage.asset.call_number.browse.target.atomic' 
+		if( $self->api_name =~ /target/ );
+	$method = 'open-ils.storage.asset.call_number.browse.page_up.atomic'
+		if( $self->api_name =~ /page_up/ );
+	$method = 'open-ils.storage.asset.call_number.browse.page_down.atomic'
+		if( $self->api_name =~ /page_down/ );
+
+	return $apputils->simplereq( 'open-ils.storage', $method, @params );
+}
+# -------------------------------------------------------------------------------------
+
+__PACKAGE__->register_method(
+    method        => "fetch_cn",
+    api_name      => "open-ils.search.callnumber.retrieve",
+    authoritative => 1,
+    notes         => "retrieves a callnumber based on ID",
+);
+
+sub fetch_cn {
+	my( $self, $client, $id ) = @_;
+	my( $cn, $evt ) = $apputils->fetch_callnumber( $id );
+	return $evt if $evt;
+	return $cn;
+}
+
+__PACKAGE__->register_method(
+    method    => "fetch_copy_by_cn",
+    api_name  => 'open-ils.search.copies_by_call_number.retrieve',
+    signature => q/
+		Returns an array of copy ID's by callnumber ID
+		@param cnid The callnumber ID
+		@return An array of copy IDs
+	/
+);
+
+sub fetch_copy_by_cn {
+	my( $self, $conn, $cnid ) = @_;
+	return $U->cstorereq(
+		'open-ils.cstore.direct.asset.copy.id_list.atomic', 
+		{ call_number => $cnid, deleted => 'f' } );
+}
+
+__PACKAGE__->register_method(
+    method    => 'fetch_cn_by_info',
+    api_name  => 'open-ils.search.call_number.retrieve_by_info',
+    signature => q/
+		@param label The callnumber label
+		@param record The record the cn is attached to
+		@param org The owning library of the cn
+		@return The callnumber object
+	/
+);
+
+
+sub fetch_cn_by_info {
+	my( $self, $conn, $label, $record, $org ) = @_;
+	return $U->cstorereq(
+		'open-ils.cstore.direct.asset.call_number.search',
+		{ label => $label, record => $record, owning_lib => $org, deleted => 'f' });
+}
+
+
+
+__PACKAGE__->register_method(
+    method   => 'bib_extras',
+    api_name => 'open-ils.search.biblio.lit_form_map.retrieve.all'
+);
+__PACKAGE__->register_method(
+    method   => 'bib_extras',
+    api_name => 'open-ils.search.biblio.item_form_map.retrieve.all'
+);
+__PACKAGE__->register_method(
+    method   => 'bib_extras',
+    api_name => 'open-ils.search.biblio.item_type_map.retrieve.all'
+);
+__PACKAGE__->register_method(
+    method   => 'bib_extras',
+    api_name => 'open-ils.search.biblio.bib_level_map.retrieve.all'
+);
+__PACKAGE__->register_method(
+    method   => 'bib_extras',
+    api_name => 'open-ils.search.biblio.audience_map.retrieve.all'
+);
+
+sub bib_extras {
+	my $self = shift;
+
+	my $e = new_editor();
+
+	return $e->retrieve_all_config_lit_form_map()
+		if( $self->api_name =~ /lit_form/ );
+
+	return $e->retrieve_all_config_item_form_map()
+		if( $self->api_name =~ /item_form_map/ );
+
+	return $e->retrieve_all_config_item_type_map()
+		if( $self->api_name =~ /item_type_map/ );
+
+	return $e->retrieve_all_config_bib_level_map()
+		if( $self->api_name =~ /bib_level_map/ );
+
+	return $e->retrieve_all_config_audience_map()
+		if( $self->api_name =~ /audience_map/ );
+
+	return [];
+}
+
+
+
+__PACKAGE__->register_method(
+    method    => 'fetch_slim_record',
+    api_name  => 'open-ils.search.biblio.record_entry.slim.retrieve',
+    signature => {
+        desc   => "Retrieves one or more biblio.record_entry without the attached marcxml",
+        params => [
+            { desc => 'Array of Record IDs', type => 'array' }
+        ],
+        return => { 
+            desc => 'Array of biblio records, event on error'
+        }
+    }
+);
+
+sub fetch_slim_record {
+    my( $self, $conn, $ids ) = @_;
+
+#my $editor = OpenILS::Utils::Editor->new;
+    my $editor = new_editor();
+	my @res;
+    for( @$ids ) {
+        return $editor->event unless
+            my $r = $editor->retrieve_biblio_record_entry($_);
+        $r->clear_marc;
+        push(@res, $r);
+    }
+    return \@res;
+}
+
+
+
+__PACKAGE__->register_method(
+    method    => 'rec_to_mr_rec_descriptors',
+    api_name  => 'open-ils.search.metabib.record_to_descriptors',
+    signature => q/
+		specialized method...
+		Given a biblio record id or a metarecord id, 
+		this returns a list of metabib.record_descriptor
+		objects that live within the same metarecord
+		@param args Object of args including:
+	/
+);
+
+sub rec_to_mr_rec_descriptors {
+	my( $self, $conn, $args ) = @_;
+
+    my $rec        = $$args{record};
+    my $mrec       = $$args{metarecord};
+    my $item_forms = $$args{item_forms};
+    my $item_types = $$args{item_types};
+    my $item_lang  = $$args{item_lang};
+
+	my $e = new_editor();
+	my $recs;
+
+	if( !$mrec ) {
+		my $map = $e->search_metabib_metarecord_source_map({source => $rec});
+		return $e->event unless @$map;
+		$mrec = $$map[0]->metarecord;
+	}
+
+	$recs = $e->search_metabib_metarecord_source_map({metarecord => $mrec});
+	return $e->event unless @$recs;
+
+	my @recs = map { $_->source } @$recs;
+	my $search = { record => \@recs };
+	$search->{item_form} = $item_forms if $item_forms and @$item_forms;
+	$search->{item_type} = $item_types if $item_types and @$item_types;
+	$search->{item_lang} = $item_lang  if $item_lang;
+
+	my $desc = $e->search_metabib_record_descriptor($search);
+
+	return { metarecord => $mrec, descriptors => $desc };
+}
+
+
+__PACKAGE__->register_method(
+    method   => 'fetch_age_protect',
+    api_name => 'open-ils.search.copy.age_protect.retrieve.all',
+);
+
+sub fetch_age_protect {
+	return new_editor()->retrieve_all_config_rule_age_hold_protect();
+}
+
+
+__PACKAGE__->register_method(
+    method   => 'copies_by_cn_label',
+    api_name => 'open-ils.search.asset.copy.retrieve_by_cn_label',
+);
+
+__PACKAGE__->register_method(
+    method   => 'copies_by_cn_label',
+    api_name => 'open-ils.search.asset.copy.retrieve_by_cn_label.staff',
+);
+
+sub copies_by_cn_label {
+	my( $self, $conn, $record, $label, $circ_lib ) = @_;
+	my $e = new_editor();
+	my $cns = $e->search_asset_call_number({record => $record, label => $label, deleted => 'f'}, {idlist=>1});
+	return [] unless @$cns;
+
+	# show all non-deleted copies in the staff client ...
+	if ($self->api_name =~ /staff$/o) {
+		return $e->search_asset_copy({call_number => $cns, circ_lib => $circ_lib, deleted => 'f'}, {idlist=>1});
+	}
+
+	# ... otherwise, grab the copies ...
+	my $copies = $e->search_asset_copy(
+		[ {call_number => $cns, circ_lib => $circ_lib, deleted => 'f', opac_visible => 't'},
+		  {flesh => 1, flesh_fields => { acp => [ qw/location status/] } }
+		]
+	);
+
+	# ... and test for location and status visibility
+	return [ map { ($U->is_true($_->location->opac_visible) && $U->is_true($_->status->opac_visible)) ? ($_->id) : () } @$copies ];
+}
+
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/CNBrowse.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/CNBrowse.pm
new file mode 100644
index 0000000000..eade47a727
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/CNBrowse.pm
@@ -0,0 +1,121 @@
+package OpenILS::Application::Search::CNBrowse;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+use OpenSRF::EX qw(:try);
+use OpenILS::Application::AppUtils;
+use Data::Dumper;
+use OpenSRF::Utils::Logger qw/:logger/;
+use OpenSRF::AppSession;
+my $U = "OpenILS::Application::AppUtils";
+
+
+__PACKAGE__->register_method(
+	method	=> "cn_browse_start",
+	api_name	=> "open-ils.search.callnumber.browse.target",
+	notes		=> "Starts a callnumber browse"
+	);
+
+__PACKAGE__->register_method(
+	method	=> "cn_browse_up",
+	api_name	=> "open-ils.search.callnumber.browse.page_up",
+	notes		=> "Returns the previous page of callnumbers", 
+	);
+
+__PACKAGE__->register_method(
+	method	=> "cn_browse_down",
+	api_name	=> "open-ils.search.callnumber.browse.page_down",
+	notes		=> "Returns the next page of callnumbers", 
+	);
+
+# XXX Deprecate me
+
+sub cn_browse_start {
+	my( $self, $client, @params ) = @_;
+	my $method;
+	$method = 'open-ils.storage.asset.call_number.browse.target.atomic' 
+		if( $self->api_name =~ /target/ );
+	$method = 'open-ils.storage.asset.call_number.browse.page_up'
+		if( $self->api_name =~ /page_up/ );
+	$method = 'open-ils.storage.asset.call_number.browse.page_down'
+		if( $self->api_name =~ /page_down/ );
+
+	return $U->simplereq( 'open-ils.storage', $method, @params );
+}
+
+
+__PACKAGE__->register_method(
+	method => "cn_browse",
+	api_name => "open-ils.search.callnumber.browse",
+    signature => {
+        desc => q/Paged call number browse/,
+        params => [
+            { name => 'label',
+              desc => 'The target call number lable',
+              type => 'string' },
+            { name => 'org_unit',
+              desc => 'The org unit shortname (or "-" or undef for global) to browse',
+              type => 'string' },
+            { name => 'page_size',
+              desc => 'Count of call numbers to retrieve, default is 9',
+              type => 'number' },
+            { name => 'offset',
+              desc => 'The page of call numbers to retrieve, calculated based on page_size.  Can be positive, negative or 0.',
+              type => 'number' },
+            { name => 'statuses',
+              desc => 'Array of statuses to filter copies by, optional and can be undef.',
+              type => 'array' },
+            { name => 'locations',
+              desc => 'Array of copy locations to filter copies by, optional and can be undef.',
+              type => 'array' },
+        ],
+        return => {
+            type => 'array',
+            desc => q/List of callnumber (acn) and record (mvr) objects/
+        }
+    }
+);
+
+sub cn_browse {
+	my( $self, $conn, $cn, $orgid, $size, $offset, $copy_statuses, $copy_locations ) = @_;
+	my $ses = OpenSRF::AppSession->create('open-ils.supercat');
+
+	my $tree = $U->get_slim_org_tree;
+	my $name = _find_shortname($orgid, $tree);
+
+	$logger->debug("cn browse found or name $name");
+
+	my $data = $ses->request(
+		'open-ils.supercat.call_number.browse', 
+		$cn, $name, $size, $offset, $copy_statuses, $copy_locations )->gather(1);
+
+	return [] unless $data;
+
+	my @res;
+	for my $d (@$data) {
+		my $mods = $U->record_to_mvr($d->record);
+		$d->owning_lib( $d->owning_lib->id );
+		$d->record($mods->doc_id);
+		push( @res, { cn	=> $d, mods	=> $mods });
+	}
+
+	return \@res;
+}
+
+
+sub _find_shortname {
+	my $id = shift;
+	my $node = shift;
+	return undef unless $node;
+	return $node->shortname if $node->id == $id;
+	if( $node->children ) {
+		for my $c (@{$node->children()}) {
+			my $d = _find_shortname($id, $c);
+			return $d if $d;
+		}
+	}
+	return undef;
+}
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Serial.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Serial.pm
new file mode 100644
index 0000000000..06d2f63829
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Serial.pm
@@ -0,0 +1,188 @@
+package OpenILS::Application::Search::Serial;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+
+use OpenSRF::Utils::JSON;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::MFHDParser;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenSRF::Utils::Cache;
+use Encode;
+
+use OpenSRF::Utils::Logger qw/:logger/;
+
+use Data::Dumper;
+
+use OpenSRF::Utils::JSON;
+
+use Time::HiRes qw(time);
+use OpenSRF::EX qw(:try);
+use Digest::MD5 qw(md5_hex);
+
+use XML::LibXML;
+use XML::LibXSLT;
+
+use OpenILS::Const qw/:const/;
+
+use OpenILS::Application::AppUtils;
+my $apputils = "OpenILS::Application::AppUtils";
+my $U = $apputils;
+
+my $pfx = "open-ils.search_";
+
+=over
+
+=item * mfhd_to_hash
+
+=back
+
+Takes an MFHD record ID and returns a hash of holdings statements
+
+=cut
+
+sub mfhd_to_hash {
+	my ($self, $client, $id) = @_;
+	
+	my $session = OpenSRF::AppSession->create("open-ils.cstore");
+	my $request = $session->request(
+			"open-ils.cstore.direct.serial.record_entry.retrieve", $id )->gather(1);
+
+	my $u = OpenILS::Utils::MFHDParser->new();
+	my $mfhd_hash = $u->generate_svr( $request->id, $request->marc, $request->owning_lib );
+
+	$session->disconnect();
+	return $mfhd_hash;
+}
+
+__PACKAGE__->register_method(
+	method	=> "mfhd_to_hash",
+	api_name	=> "open-ils.search.serial.record.mfhd.retrieve",
+	argc		=> 1, 
+	note		=> "Given a serial record ID, return MFHD holdings"
+);
+
+=over
+
+=item * bib_to_mfhd_hash 
+
+=back
+
+Given a bib record ID, returns a hash of holdings statements
+
+=cut
+
+# DEFUNCT ?
+#sub bib_to_mfhd_hash {
+#	my ($self, $client, $bib) = @_;
+#	
+#	my $mfhd_hash;
+#
+#	# XXX perhaps this? --miker
+##	my $e = OpenILS::Utils::CStoreEditor->new();
+##	my $mfhd = $e->search_serial_record_entry({ record => $bib });
+##	return $u->generate_svr( $mfhd->[0] ) if (ref $mfhd);
+##	return undef;
+#
+#	my @mfhd = $U->cstorereq( "open-ils.cstore.json_query.atomic", {
+#		select  => { sre => 'marc' },
+#		from    => 'sre',
+#		where   => { record => $bib, deleted => 'f' },
+#		distinct => 1
+#	});
+#	
+#	if (!@mfhd or scalar(@mfhd) == 0) {
+#		return undef;
+#	}
+#
+#	my $u = OpenILS::Utils::MFHDParser->new();
+#	$mfhd_hash = $u->generate_svr( $mfhd[0][0]->{id}, $mfhd[0][0]->{marc}, $mfhd[0][0]->{owning_lib} );
+#
+#	return $mfhd_hash;
+#}
+#
+#__PACKAGE__->register_method(
+#	method	=> "bib_to_mfhd_hash",
+#	api_name	=> "open-ils.search.serial.record.bib_to_mfhd.retrieve",
+#	argc		=> 1, 
+#	note		=> "Given a bibliographic record ID, return MFHD holdings"
+#);
+
+sub bib_to_svr {
+	my ($self, $client, $bib) = @_;
+	
+	my $svrs = [];
+
+	my $e = OpenILS::Utils::CStoreEditor->new();
+    # TODO: 'deleted' ssub support
+    my $sdists = $e->search_serial_distribution([{ "+ssub" => {"record_entry" => $bib} }, { "flesh" => 1, "flesh_fields" => {'sdist' => [ "record_entry", "holding_lib", "basic_summary", "supplement_summary", "index_summary" ]}, "join" => {"ssub" => {}} }]);
+	my $sres = $e->search_serial_record_entry([{ record => $bib, deleted => 'f', "+sdist" => {"id" => undef} }, { "join" => {"sdist" => { 'type' => 'left' }} }]);
+	if (!ref $sres and !ref $sdists) {
+		return undef;
+	}
+
+	my $mfhd_parser = OpenILS::Utils::MFHDParser->new();
+	foreach (@$sdists) {
+        my $svr;
+        if (ref $_->record_entry) {
+            $svr = $mfhd_parser->generate_svr($_->record_entry->id, $_->record_entry->marc, $_->record_entry->owning_lib);
+        } else {
+            $svr = Fieldmapper::serial::virtual_record->new;
+            $svr->sre_id(-1);
+            $svr->location($_->holding_lib->name);
+            $svr->owning_lib($_->holding_lib);
+            $svr->basic_holdings([]);
+            $svr->supplement_holdings([]);
+            $svr->index_holdings([]);
+            $svr->basic_holdings_add([]);
+            $svr->supplement_holdings_add([]);
+            $svr->index_holdings_add([]);
+            $svr->online([]);
+            $svr->missing([]);
+            $svr->incomplete([]);
+        }
+        if (ref $_->basic_summary) { #TODO: 'show-generated' boolean on summaries
+            if ($_->basic_summary->generated_coverage) {
+                push(@{$svr->basic_holdings}, $_->basic_summary->generated_coverage);
+            }
+            if ($_->basic_summary->textual_holdings) {
+                push(@{$svr->basic_holdings_add}, $_->basic_summary->textual_holdings);
+            }
+        }
+        if (ref $_->supplement_summary) {
+            if ($_->supplement_summary->generated_coverage) {
+                push(@{$svr->supplement_holdings}, $_->supplement_summary->generated_coverage);
+            }
+            if ($_->supplement_summary->textual_holdings) {
+                push(@{$svr->supplement_holdings_add}, $_->supplement_summary->textual_holdings);
+            }
+        }
+        if (ref $_->index_summary) {
+            if ($_->index_summary->generated_coverage) {
+                push(@{$svr->index_holdings}, $_->index_summary->generated_coverage);
+            }
+            if ($_->index_summary->textual_holdings) {
+                push(@{$svr->index_holdings_add}, $_->index_summary->textual_holdings);
+            }
+        }
+        push(@$svrs, $svr);
+	}
+	foreach (@$sres) {
+		push(@$svrs, $mfhd_parser->generate_svr($_->id, $_->marc, $_->owning_lib));
+	}
+
+    # do a basic location sort for simple predictability
+    @$svrs = sort { $a->location cmp $b->location } @$svrs;
+
+	return $svrs;
+}
+
+__PACKAGE__->register_method(
+	method	=> "bib_to_svr",
+	api_name	=> "open-ils.search.serial.record.bib.retrieve",
+	argc		=> 1, 
+	note		=> "Given a bibliographic record ID, return holdings in svr form"
+);
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Z3950.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Z3950.pm
new file mode 100644
index 0000000000..18884c6e38
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Z3950.pm
@@ -0,0 +1,459 @@
+package OpenILS::Application::Search::Z3950;
+use strict; use warnings;
+use base qw/OpenILS::Application/;
+
+use OpenILS::Utils::ZClient;
+use MARC::Record;
+use MARC::File::XML;
+use Unicode::Normalize;
+use XML::LibXML;
+
+use OpenILS::Event;
+use OpenSRF::EX qw(:try);
+use OpenILS::Utils::ModsParser;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Application::AppUtils;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+
+my $output = "usmarc"; 
+my $U = 'OpenILS::Application::AppUtils'; 
+
+my $sclient;
+my %services;
+my $default_service;
+
+
+__PACKAGE__->register_method(
+    method    => 'do_class_search',
+    api_name  => 'open-ils.search.z3950.search_class',
+    stream    => 1,
+    signature => q/
+        Performs a class based Z search.  The classes available
+        are defined by the 'attr' fields in the config for the
+        requested service.
+        @param auth The login session key
+        @param shash The search hash : { attr : value, attr2: value, ...}
+        @param service The service to connect to
+        @param username The username to use when connecting to the service
+        @param password The password to use when connecting to the service
+    /
+);
+
+__PACKAGE__->register_method(
+    method    => 'do_service_search',
+    api_name  => 'open-ils.search.z3950.search_service',
+    signature => q/
+        @param auth The login session key
+        @param query The Z3950 search string to use
+        @param service The service to connect to
+        @param username The username to use when connecting to the service
+        @param password The password to use when connecting to the service
+    /
+);
+
+
+__PACKAGE__->register_method(
+    method    => 'do_service_search',
+    api_name  => 'open-ils.search.z3950.search_raw',
+    signature => q/
+        @param auth The login session key
+        @param args An object of search params which must include:
+            host, port, db and query.  
+            optional fields include username and password
+    /
+);
+
+
+__PACKAGE__->register_method(
+    method    => "query_services",
+    api_name  => "open-ils.search.z3950.retrieve_services",
+    signature => q/
+        Returns a list of service names that we have config
+        data for
+    /
+);
+
+
+
+# -------------------------------------------------------------------
+# What services do we have config info for?
+# -------------------------------------------------------------------
+sub query_services {
+    my( $self, $client, $auth ) = @_;
+    my $e = new_editor(authtoken=>$auth);
+    return $e->event unless $e->checkauth;
+    return $e->event unless $e->allowed('REMOTE_Z3950_QUERY');
+
+    return fetch_service_defs();
+}
+
+# -------------------------------------------------------------------
+# What services do we have config info for?
+# -------------------------------------------------------------------
+sub fetch_service_defs {
+
+    my $hash = $sclient->config_value('z3950', 'services');
+
+    # overlay config file values with in-db values
+    my $e = new_editor();
+    if($e->can('search_config_z3950_source')) {
+
+        my $sources = $e->search_config_z3950_source(
+            [ { name => { '!=' => undef } },
+              { flesh => 1, flesh_fields => { czs => ['attrs'] } } ]
+        );
+
+        for my $s ( @$sources ) {
+            $$hash{ $s->name } = {
+                name => $s->name,
+                label => $s->label,
+                host => $s->host,
+                port => $s->port,
+                db => $s->db,
+                record_format => $s->record_format,
+                transmission_format => $s->transmission_format,
+                auth => $s->auth,
+            };
+
+            for my $a ( @{ $s->attrs } ) {
+                $$hash{ $a->source }{attrs}{ $a->name } = {
+                    name => $a->name,
+                    label => $a->label,
+                    code => $a->code,
+                    format => $a->format,
+                    source => $a->source,
+                    truncation => $a->truncation,
+                };
+            }
+        }
+    }
+
+    # Define the set of native catalog services
+    # XXX There are i18n problems here, but let's get the staff client working first
+    # XXX Move into the DB?
+    $hash->{'native-evergreen-catalog'} = {
+        attrs => {
+            title => {code => 'title', label => 'Title'},
+            author => {code => 'author', label => 'Author'},
+            subject => {code => 'subject', label => 'Subject'},
+            keyword => {code => 'keyword', label => 'Keyword'},
+            tcn => {code => 'tcn', label => 'TCN'},
+            isbn => {code => 'isbn', label => 'ISBN'},
+            issn => {code => 'issn', label => 'ISSN'},
+            publisher => {code => 'publisher', label => 'Publisher'},
+            pubdate => {code => 'pubdate', label => 'Pub Date'},
+            item_type => {code => 'item_type', label => 'Item Type'},
+        }
+    };
+
+    %services = %$hash; # cache these internally so we can actually use the db-configured sources
+    return $hash;
+}
+
+
+
+# -------------------------------------------------------------------
+# Load the pre-defined Z server configs
+# -------------------------------------------------------------------
+sub child_init {
+    $sclient = OpenSRF::Utils::SettingsClient->new();
+    $default_service = $sclient->config_value("z3950", "default" );
+}
+
+
+# -------------------------------------------------------------------
+# High-level class based search. 
+# -------------------------------------------------------------------
+sub do_class_search {
+
+    fetch_service_defs() unless (scalar(keys(%services)));
+
+    my $self = shift;
+    my $conn = shift;
+    my $auth = shift;
+    my $args = shift;
+
+    if (!ref($$args{service})) {
+        $$args{service} = [$$args{service}];
+        $$args{username} = [$$args{username}];
+        $$args{password} = [$$args{password}];
+    }
+
+    $$args{async} = 1;
+
+    my @connections;
+    my @results;
+    my @services; 
+    for (my $i = 0; $i < @{$$args{service}}; $i++) {
+        my %tmp_args = %$args;
+        $tmp_args{service} = $$args{service}[$i];
+        $tmp_args{username} = $$args{username}[$i];
+        $tmp_args{password} = $$args{password}[$i];
+
+        $logger->debug("z3950: service: $tmp_args{service}, async: $tmp_args{async}");
+
+        if ($tmp_args{service} eq 'native-evergreen-catalog') { 
+            my $method = $self->method_lookup('open-ils.search.biblio.zstyle.staff'); 
+            $conn->respond( 
+                $self->method_lookup('open-ils.search.biblio.zstyle.staff')->run($auth, \%tmp_args) 
+            ); 
+
+        } else { 
+
+            $tmp_args{query} = compile_query('and', $tmp_args{service}, $tmp_args{search}); 
+    
+            my $res = do_service_search( $self, $conn, $auth, \%tmp_args ); 
+    
+            if ($U->event_code($res)) { 
+                $conn->respond($res) if $U->event_code($res); 
+
+            } else { 
+                push @services, $tmp_args{service}; 
+                push @results, $res->{result}; 
+                push @connections, $res->{connection}; 
+            } 
+        }
+
+        $logger->debug("z3950: Result object: $results[$i], Connection object: $connections[$i]");
+    }
+
+    $logger->debug("z3950: Connections created");
+
+    return undef unless (@connections);
+    my @records;
+
+    # local catalog search is not processed with other z39 results;
+    $$args{service} = [grep {$_ ne 'native-evergreen-catalog'} @{$$args{service}}];
+
+    @connections = grep {defined $_} @connections;
+    return undef unless @connections;
+
+    while ((my $index = OpenILS::Utils::ZClient::event( \@connections )) != 0) {
+        my $ev = $connections[$index - 1]->last_event();
+        $logger->debug("z3950: Received event $ev");
+        if ($ev == OpenILS::Utils::ZClient::EVENT_END()) {
+            my $munged = process_results( $results[$index - 1], $$args{limit}, $$args{offset}, $$args{service}[$index -1] );
+            $$munged{service} = $$args{service}[$index - 1];
+            $conn->respond($munged);
+        }
+    }
+
+    $logger->debug("z3950: Search Complete");
+    return undef;
+}
+
+
+# -------------------------------------------------------------------
+# This handles the host settings, but expects a fully formed z query
+# -------------------------------------------------------------------
+sub do_service_search {
+
+    fetch_service_defs() unless (scalar(keys(%services)));
+
+    my $self = shift;
+    my $conn = shift;
+    my $auth = shift;
+    my $args = shift;
+    
+    my $info = $services{$$args{service}};
+
+    $$args{host} = $$info{host};
+    $$args{port} = $$info{port};
+    $$args{db} = $$info{db};
+    $logger->debug("z3950: do_search...");
+
+    return do_search( $self, $conn, $auth, $args );
+}
+
+
+
+# -------------------------------------------------------------------
+# This is the low level search method.  All config and query
+# data must be provided to this method
+# -------------------------------------------------------------------
+sub do_search {
+
+    fetch_service_defs() unless (scalar(keys(%services)));
+
+    my $self = shift;
+    my $conn = shift;
+    my $auth = shift;
+    my $args = shift;
+
+    my $host = $$args{host} or return undef;
+    my $port = $$args{port} or return undef;
+    my $db = $$args{db} or return undef;
+    my $query = $$args{query} or return undef;
+    my $async = $$args{async} || 0;
+
+    my $limit = $$args{limit} || 10;
+    my $offset = $$args{offset} || 0;
+
+    my $username = $$args{username} || "";
+    my $password = $$args{password} || "";
+
+    my $tformat = $services{$args->{service}}->{transmission_format} || $output;
+
+    my $editor = new_editor(authtoken => $auth);
+    return $editor->event unless $editor->checkauth;
+    return $editor->event unless $editor->allowed('REMOTE_Z3950_QUERY');
+
+    $logger->info("z3950: connecting to server $host:$port:$db as $username");
+
+    my $connection = OpenILS::Utils::ZClient->new(
+        $host, $port,
+        databaseName => $db, 
+        user => $username,
+        password => $password,
+        async => $async,
+        preferredRecordSyntax => $tformat, 
+    );
+
+    if( ! $connection ) {
+        $logger->error("z3950: Unable to connect to Z server: ".
+            "$host:$port:$db:$username:$password");
+        return OpenILS::Event->new('Z3950_LOGIN_FAILED') unless $connection;
+    }
+
+    my $start = time;
+    my $results;
+    my $err;
+
+    $logger->info("z3950: query => $query");
+
+    try {
+        $results = $connection->search_pqf( $query );
+    } catch Error with { $err = shift; };
+
+    return OpenILS::Event->new(
+        'Z3950_BAD_QUERY', payload => $query, debug => "$err") if $err;
+
+    return OpenILS::Event->new('Z3950_SEARCH_FAILED', 
+        debug => $connection->errcode." => ".$connection->errmsg." : query = $query") unless $results;
+
+    $logger->info("z3950: search [$query] took ".(time - $start)." seconds");
+
+    return {result => $results, connection => $connection} if ($async);
+
+    my $munged = process_results($results, $limit, $offset, $$args{service});
+    $munged->{query} = $query;
+
+    return $munged;
+}
+
+
+# -------------------------------------------------------------------
+# Takes a result batch and returns the hitcount and a list of xml
+# and mvr objects
+# -------------------------------------------------------------------
+sub process_results {
+
+    fetch_service_defs() unless (scalar(keys(%services)));
+
+    my $results = shift;
+    my $limit = shift || 10;
+    my $offset = shift || 0;
+    my $service = shift;
+
+    my $rformat = $services{$service}->{record_format};
+    my $tformat = $services{$service}->{transmission_format} || $output;
+
+    $results->option(elementSetName => $rformat);
+    $results->option(preferredRecordSyntax => $tformat);
+    $logger->info("z3950: using record format '$rformat' and transmission format '$tformat'");
+
+    my @records;
+    my $res = {};
+    my $count = $$res{count} = $results->size;
+
+    $logger->info("z3950: search returned $count hits");
+
+    my $tend = $limit + $offset;
+
+    my $end = ($tend <= $count) ? $tend : $count;
+
+    for($offset..$end - 1) {
+
+        my $err;
+        my $mods;
+        my $marc;
+        my $marcs;
+        my $marcxml;
+
+        $logger->info("z3950: fetching record $_");
+
+        try {
+
+            my $rec = $results->record($_);
+
+            if ($tformat eq 'usmarc') {
+                $marc = MARC::Record->new_from_usmarc($rec->raw());
+            } elsif ($tformat eq 'xml') {
+                $marc = MARC::Record->new_from_xml($rec->raw());
+            } else {
+                die "Unsupported record transmission format $tformat"
+            }
+
+            $marcs = $U->entityize($marc->as_xml_record);
+            $marcs = $U->strip_ctrl_chars($marcs);
+            my $doc = XML::LibXML->new->parse_string($marcs);
+            $marcxml = $U->entityize($doc->documentElement->toString);
+            $marcxml = $U->strip_ctrl_chars($marcxml);
+    
+            my $u = OpenILS::Utils::ModsParser->new();
+            $u->start_mods_batch( $marcxml );
+            $mods = $u->finish_mods_batch();
+    
+
+        } catch Error with { $err = shift; };
+
+        push @records, { 'mvr' => $mods, 'marcxml' => $marcxml } unless $err;
+        $logger->error("z3950: bad XML : $err") if $err;
+
+        if( $err ) {
+            warn "\n\n$marcs\n\n";
+        }
+    }
+    
+    $res->{records} = \@records;
+    return $res;
+}
+
+
+
+# -------------------------------------------------------------------
+# Compiles the class based search query
+# -------------------------------------------------------------------
+sub compile_query {
+
+    fetch_service_defs() unless (scalar(keys(%services)));
+
+    my $separator = shift;
+    my $service = shift;
+    my $hash = shift;
+
+    my $count = scalar(keys %$hash);
+
+    my $str = "";
+    $str .= "\@$separator " for (1..$count-1);
+    
+    # -------------------------------------------------------------------
+    # "code" is the bib-1 "use attribute", "format" is the bib-1 
+    # "structure attribute"
+    # -------------------------------------------------------------------
+    for( keys %$hash ) {
+        next unless ( exists $services{$service}->{attrs}->{$_} );
+        $str .= '@attr 1=' . $services{$service}->{attrs}->{$_}->{code} . # add the use attribute
+            ' @attr 4=' . $services{$service}->{attrs}->{$_}->{format}; # add the structure attribute
+        if (exists $services{$service}->{attrs}->{$_}->{truncation}
+                && $services{$service}->{attrs}->{$_}->{truncation} >= 0) {
+            $str .= ' @attr 5=' . $services{$service}->{attrs}->{$_}->{truncation};
+        }
+        $str .= " \"" . $$hash{$_} . "\" "; # add the search term
+    }
+    return $str;
+}
+
+1;
+# vim:et:ts=4:sw=4:
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Zips.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Zips.pm
new file mode 100644
index 0000000000..0cccf4651e
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Search/Zips.pm
@@ -0,0 +1,71 @@
+package OpenILS::Application::Search::Zips;
+use base qw/OpenILS::Application/;
+use strict; use warnings;
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::Editor;
+use OpenSRF::Utils::SettingsClient;
+
+my %zips;
+
+# -----------------------------------------------------------------
+# Reads zip code information from a file.  File format is : 
+# ID|StateAbb|City|Zip|IsDefault|StateID|County|AreaCode
+# Currently, StateAbb, City, Zip, County, AreaCode are used.  
+# IsDefault should be set to 1
+# -----------------------------------------------------------------
+
+sub initialize {
+	my $conf = OpenSRF::Utils::SettingsClient->new;
+	my $zfile = $conf->config_value(
+		"apps", "open-ils.search", "app_settings", "zips_file");
+	return 1 unless $zfile and -f $zfile;
+
+	$logger->info("search loaded zips file $zfile");
+	open(F,$zfile);
+	my @data = ;
+	close(F);
+
+	for(@data) {
+		chomp $_;
+		my @items = split(/\|/, "$_");
+		my $items = {
+			state		=> $items[1],
+			city		=> $items[2],
+			zip		=> $items[3],
+			stateid	=> $items[5],
+			county	=> $items[6],
+			areacode	=> $items[7],
+            alert   => $items[8]
+		};
+
+		next unless $items[4] eq '1';
+		$zips{$$items{zip}} = $items;
+	}
+}
+
+__PACKAGE__->register_method(
+	method => 'search_zip',
+	api_name	=> 'open-ils.search.zip',
+	signature	=> q/
+		Given a zip code, returns address info for the zip code
+		@param auth the login session key
+		@param zip The zip code to check
+		@return On success, returns an object of the form:
+		{ state=>, city=>, zip=>, stateid=>, county=>, areacode=>}
+		returns event on error
+	/
+);
+sub search_zip {
+	#my( $self, $conn, $auth, $zip ) = @_;
+	#my $e = OpenILS::Utils::Editor->new(authtoken=>$auth);
+	#return $e->event unless $e->checkauth;
+	#return $e->event unless $e->allowed('VIEW_ZIP_DATA');
+	my( $self, $conn, $zip ) = @_;
+	$zip =~ s/(^\d{5}).*/$1/; # we don't care about the last 4 digits if they exist 
+	return $zips{$zip};
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Serial.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Serial.pm
new file mode 100644
index 0000000000..c70aefea13
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Serial.pm
@@ -0,0 +1,3466 @@
+#!/usr/bin/perl
+
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+
+=head1 NAME
+
+OpenILS::Application::Serial - Performs serials-related tasks such as receiving issues and generating predictions
+
+=head1 SYNOPSIS
+
+TBD
+
+=head1 DESCRIPTION
+
+TBD
+
+=head1 AUTHOR
+
+Dan Wells, dbw2@calvin.edu
+
+=cut
+
+package OpenILS::Application::Serial;
+
+use strict;
+use warnings;
+
+
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+use OpenILS::Application::AppUtils;
+use OpenILS::Event;
+use OpenSRF::AppSession;
+use OpenSRF::Utils qw/:datetime/;
+use OpenSRF::Utils::Logger qw/:logger/;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::MFHD;
+use DateTime::Format::ISO8601;
+use MARC::File::XML (BinaryEncoding => 'utf8');
+my $U = 'OpenILS::Application::AppUtils';
+my @MFHD_NAMES = ('basic','supplement','index');
+my %MFHD_NAMES_BY_TAG = (  '853' => $MFHD_NAMES[0],
+                        '863' => $MFHD_NAMES[0],
+                        '854' => $MFHD_NAMES[1],
+                        '864' => $MFHD_NAMES[1],
+                        '855' => $MFHD_NAMES[2],
+                        '865' => $MFHD_NAMES[2] );
+my %MFHD_TAGS_BY_NAME = (  $MFHD_NAMES[0] => '853',
+                        $MFHD_NAMES[1] => '854',
+                        $MFHD_NAMES[2] => '855');
+my $_strp_date = new DateTime::Format::Strptime(pattern => '%F');
+
+# helper method for conforming dates to ISO8601
+sub _cleanse_dates {
+    my $item = shift;
+    my $fields = shift;
+
+    foreach my $field (@$fields) {
+        $item->$field(OpenSRF::Utils::clense_ISO8601($item->$field)) if $item->$field;
+    }
+    return 0;
+}
+
+sub _get_mvr {
+    $U->simplereq(
+        "open-ils.search",
+        "open-ils.search.biblio.record.mods_slim.retrieve",
+        @_
+    );
+}
+
+
+##########################################################################
+# item methods
+#
+__PACKAGE__->register_method(
+    method    => "create_item_safely",
+    api_name  => "open-ils.serial.item.create",
+    api_level => 1,
+    stream    => 1,
+    argc      => 3,
+    signature => {
+        desc => q/Creates any number of items, respecting only a few of the
+        submitted fields, as the user shouldn't be able to freely set certain
+        ones/,
+        params => [
+            {name=> "authtoken", desc => "Authtoken for current user session",
+                type => "string"},
+            {name => "item", desc => "serial item",
+                type => "object", class => "sitem"},
+            {name => "count",
+                desc => "optional: how many items to make " .
+                    "(default 1; 1-100 permitted)",
+                type => "number"}
+        ],
+        return => {
+            desc => "created items (a stream of them)",
+            type => "object", class => "sitem"
+        }
+    }
+);
+__PACKAGE__->register_method(
+    method    => "update_item_safely",
+    api_name  => "open-ils.serial.item.update",
+    api_level => 1,
+    stream    => 1,
+    argc      => 2,
+    signature => {
+        desc => q/Edit a serial item, respecting only a few of the
+        submitted fields, as the user shouldn't be able to freely set certain
+        ones/,
+        params => [
+            {name=> "authtoken", desc => "Authtoken for current user session",
+                type => "string"},
+            {name => "item", desc => "serial item",
+                type => "object", class => "sitem"},
+        ],
+        return => {
+            desc => "created item", type => "object", class => "sitem"
+        }
+    }
+);
+
+sub _set_safe_item_fields {
+    my $dest = shift;
+    my $source = shift;
+    my $requestor_id = shift;
+    # extra fields remain in @_
+
+    $dest->edit_date("now");
+    $dest->editor($requestor_id);
+
+    my @fields = qw/date_expected date_received status/;
+
+    for my $field (@fields, @_) {
+        $dest->$field($source->$field);
+    }
+}
+
+sub update_item_safely {
+    my ($self, $client, $auth, $item) = @_;
+
+    my $e = new_editor("xact" => 1, "authtoken" => $auth);
+    $e->checkauth or return $e->die_event;
+
+    my $orig = $e->retrieve_serial_item([
+        $item->id, {
+            "flesh" => 2, "flesh_fields" => {
+                "sitem" => ["stream"], "sstr" => ["distribution"]
+            }
+        }
+    ]) or return $e->die_event;
+
+    return $e->die_event unless $e->allowed(
+        "ADMIN_SERIAL_ITEM", $orig->stream->distribution->holding_lib
+    );
+
+    _set_safe_item_fields($orig, $item, $e->requestor->id);
+    $e->update_serial_item($orig) or return $e->die_event;
+
+    $client->respond($e->retrieve_serial_item($item->id));
+    $e->commit or return $e->die_event;
+    undef;
+}
+
+sub create_item_safely {
+    my ($self, $client, $auth, $item, $count) = @_;
+
+    $count = int $count;
+    $count ||= 1;
+    return new OpenILS::Event(
+        "BAD_PARAMS", note => "Count should be from 1 to 100"
+    ) unless $count >= 1 and $count <= 100;
+
+    my $e = new_editor("xact" => 1, "authtoken" => $auth);
+    $e->checkauth or return $e->die_event;
+
+    my $stream = $e->retrieve_serial_stream([
+        $item->stream, {
+            "flesh" => 1, "flesh_fields" => {"sstr" => ["distribution"]}
+        }
+    ]) or return $e->die_event;
+
+    return $e->die_event unless $e->allowed(
+        "ADMIN_SERIAL_ITEM", $stream->distribution->holding_lib
+    );
+
+    for (my $i = 0; $i < $count; $i++) {
+        my $actual = new Fieldmapper::serial::item;
+        $actual->creator($e->requestor->id);
+        _set_safe_item_fields(
+            $actual, $item, $e->requestor->id, "issuance", "stream"
+        );
+
+        $e->create_serial_item($actual) or return $e->die_event;
+        $client->respond($e->data);
+    }
+
+    $e->commit or return $e->die_event;
+    undef;
+}
+
+__PACKAGE__->register_method(
+    method    => 'fleshed_item_alter',
+    api_name  => 'open-ils.serial.item.fleshed.batch.update',
+    api_level => 1,
+    argc      => 2,
+    signature => {
+        desc     => 'Receives an array of one or more items and updates the database as needed',
+        'params' => [ {
+                 name => 'authtoken',
+                 desc => 'Authtoken for current user session',
+                 type => 'string'
+            },
+            {
+                 name => 'items',
+                 desc => 'Array of fleshed items',
+                 type => 'array'
+            }
+
+        ],
+        'return' => {
+            desc => 'Returns 1 if successful, event if failed',
+            type => 'mixed'
+        }
+    }
+);
+
+sub fleshed_item_alter {
+    my( $self, $conn, $auth, $items ) = @_;
+    return 1 unless ref $items;
+    my( $reqr, $evt ) = $U->checkses($auth);
+    return $evt if $evt;
+    my $editor = new_editor(requestor => $reqr, xact => 1);
+    my $override = $self->api_name =~ /override/;
+
+# TODO: permission check
+#        return $editor->event unless
+#            $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy));
+
+    for my $item (@$items) {
+
+        my $itemid = $item->id;
+        $item->editor($editor->requestor->id);
+        $item->edit_date('now');
+
+        if( $item->isdeleted ) {
+            $evt = _delete_sitem( $editor, $override, $item);
+        } elsif( $item->isnew ) {
+            # TODO: reconsider this
+            # if the item has a new issuance, create the issuance first
+            if (ref $item->issuance eq 'Fieldmapper::serial::issuance' and $item->issuance->isnew) {
+                fleshed_issuance_alter($self, $conn, $auth, [$item->issuance]);
+            }
+            _cleanse_dates($item, ['date_expected','date_received']);
+            $evt = _create_sitem( $editor, $item );
+        } else {
+            _cleanse_dates($item, ['date_expected','date_received']);
+            $evt = _update_sitem( $editor, $override, $item );
+        }
+    }
+
+    if( $evt ) {
+        $logger->info("fleshed item-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
+        $editor->rollback;
+        return $evt;
+    }
+    $logger->debug("item-alter: done updating item batch");
+    $editor->commit;
+    $logger->info("fleshed item-alter successfully updated ".scalar(@$items)." items");
+    return 1;
+}
+
+sub _delete_sitem {
+    my ($editor, $override, $item) = @_;
+    $logger->info("item-alter: delete item ".OpenSRF::Utils::JSON->perl2JSON($item));
+    return $editor->event unless $editor->delete_serial_item($item);
+    return 0;
+}
+
+sub _create_sitem {
+    my ($editor, $item) = @_;
+
+    $item->creator($editor->requestor->id);
+    $item->create_date('now');
+
+    $logger->info("item-alter: new item ".OpenSRF::Utils::JSON->perl2JSON($item));
+    return $editor->event unless $editor->create_serial_item($item);
+    return 0;
+}
+
+sub _update_sitem {
+    my ($editor, $override, $item) = @_;
+
+    $logger->info("item-alter: retrieving item ".$item->id);
+    my $orig_item = $editor->retrieve_serial_item($item->id);
+
+    $logger->info("item-alter: original item ".OpenSRF::Utils::JSON->perl2JSON($orig_item));
+    $logger->info("item-alter: updated item ".OpenSRF::Utils::JSON->perl2JSON($item));
+    return $editor->event unless $editor->update_serial_item($item);
+    return 0;
+}
+
+__PACKAGE__->register_method(
+    method  => "fleshed_serial_item_retrieve_batch",
+    authoritative => 1,
+    api_name    => "open-ils.serial.item.fleshed.batch.retrieve"
+);
+
+sub fleshed_serial_item_retrieve_batch {
+    my( $self, $client, $ids ) = @_;
+# FIXME: permissions?
+    $logger->info("Fetching fleshed serial items @$ids");
+    return $U->cstorereq(
+        "open-ils.cstore.direct.serial.item.search.atomic",
+        { id => $ids },
+        { flesh => 2,
+          flesh_fields => {sitem => [ qw/issuance creator editor stream unit notes/ ], sstr => ["distribution"], sunit => ["call_number"], siss => [qw/creator editor subscription/]}
+        });
+}
+
+
+##########################################################################
+# issuance methods
+#
+__PACKAGE__->register_method(
+    method    => 'fleshed_issuance_alter',
+    api_name  => 'open-ils.serial.issuance.fleshed.batch.update',
+    api_level => 1,
+    argc      => 2,
+    signature => {
+        desc     => 'Receives an array of one or more issuances and updates the database as needed',
+        'params' => [ {
+                 name => 'authtoken',
+                 desc => 'Authtoken for current user session',
+                 type => 'string'
+            },
+            {
+                 name => 'issuances',
+                 desc => 'Array of fleshed issuances',
+                 type => 'array'
+            }
+
+        ],
+        'return' => {
+            desc => 'Returns 1 if successful, event if failed',
+            type => 'mixed'
+        }
+    }
+);
+
+sub fleshed_issuance_alter {
+    my( $self, $conn, $auth, $issuances ) = @_;
+    return 1 unless ref $issuances;
+    my( $reqr, $evt ) = $U->checkses($auth);
+    return $evt if $evt;
+    my $editor = new_editor(requestor => $reqr, xact => 1);
+    my $override = $self->api_name =~ /override/;
+
+# TODO: permission support
+#        return $editor->event unless
+#            $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy));
+
+    for my $issuance (@$issuances) {
+        my $issuanceid = $issuance->id;
+        $issuance->editor($editor->requestor->id);
+        $issuance->edit_date('now');
+
+        if( $issuance->isdeleted ) {
+            $evt = _delete_siss( $editor, $override, $issuance);
+        } elsif( $issuance->isnew ) {
+            _cleanse_dates($issuance, ['date_published']);
+            $evt = _create_siss( $editor, $issuance );
+        } else {
+            _cleanse_dates($issuance, ['date_published']);
+            $evt = _update_siss( $editor, $override, $issuance );
+        }
+    }
+
+    if( $evt ) {
+        $logger->info("fleshed issuance-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
+        $editor->rollback;
+        return $evt;
+    }
+    $logger->debug("issuance-alter: done updating issuance batch");
+    $editor->commit;
+    $logger->info("fleshed issuance-alter successfully updated ".scalar(@$issuances)." issuances");
+    return 1;
+}
+
+sub _delete_siss {
+    my ($editor, $override, $issuance) = @_;
+    $logger->info("issuance-alter: delete issuance ".OpenSRF::Utils::JSON->perl2JSON($issuance));
+    return $editor->event unless $editor->delete_serial_issuance($issuance);
+    return 0;
+}
+
+sub _create_siss {
+    my ($editor, $issuance) = @_;
+
+    $issuance->creator($editor->requestor->id);
+    $issuance->create_date('now');
+
+    $logger->info("issuance-alter: new issuance ".OpenSRF::Utils::JSON->perl2JSON($issuance));
+    return $editor->event unless $editor->create_serial_issuance($issuance);
+    return 0;
+}
+
+sub _update_siss {
+    my ($editor, $override, $issuance) = @_;
+
+    $logger->info("issuance-alter: retrieving issuance ".$issuance->id);
+    my $orig_issuance = $editor->retrieve_serial_issuance($issuance->id);
+
+    $logger->info("issuance-alter: original issuance ".OpenSRF::Utils::JSON->perl2JSON($orig_issuance));
+    $logger->info("issuance-alter: updated issuance ".OpenSRF::Utils::JSON->perl2JSON($issuance));
+    return $editor->event unless $editor->update_serial_issuance($issuance);
+    return 0;
+}
+
+__PACKAGE__->register_method(
+    method  => "fleshed_serial_issuance_retrieve_batch",
+    authoritative => 1,
+    api_name    => "open-ils.serial.issuance.fleshed.batch.retrieve"
+);
+
+sub fleshed_serial_issuance_retrieve_batch {
+    my( $self, $client, $ids ) = @_;
+# FIXME: permissions?
+    $logger->info("Fetching fleshed serial issuances @$ids");
+    return $U->cstorereq(
+        "open-ils.cstore.direct.serial.issuance.search.atomic",
+        { id => $ids },
+        { flesh => 1,
+          flesh_fields => {siss => [ qw/creator editor subscription/ ]}
+        });
+}
+
+__PACKAGE__->register_method(
+    method  => "pub_fleshed_serial_issuance_retrieve_batch",
+    api_name    => "open-ils.serial.issuance.pub_fleshed.batch.retrieve",
+    signature => {
+        desc => q/
+            Public (i.e. OPAC) call for getting at the sub and 
+            ultimately the record entry from an issuance
+        /,
+        params => [{name => 'ids', desc => 'Array of IDs', type => 'array'}],
+        return => {
+            desc => q/
+                issuance objects, fleshed with subscriptions
+            /,
+            class => 'siss'
+        }
+    }
+);
+sub pub_fleshed_serial_issuance_retrieve_batch {
+    my( $self, $client, $ids ) = @_;
+    return [] unless $ids and @$ids;
+    return new_editor()->search_serial_issuance([
+        { id => $ids },
+        { 
+            flesh => 1,
+            flesh_fields => {siss => [ qw/subscription/ ]}
+        }
+    ]);
+}
+
+sub received_siss_by_bib {
+    my $self = shift;
+    my $client = shift;
+    my $bib = shift;
+
+    my $args = shift || {};
+    $$args{order} ||= 'asc';
+
+    my $global = $$args{global} == 0 ? 0 : 1;
+
+    my $e = new_editor();
+    my $issuances = $e->json_query({
+        select  => {
+            siss => [
+                $global ? { transform => "min", column => "id", aggregate => 1 } : "id",
+                "label",
+                "date_published"
+            ],
+            "sitem" => [
+                # We're not really interested in the minimum here.  This is
+                # just a way to distinguish issuances whose items have units
+                # from issuances whose items have no units, without altogether
+                # excluding the latter type of issuances.
+                {"transform" => "min", "alias" => "has_units",
+                    "column" => "unit", "aggregate" => 1}
+            ]
+        },
+        from => {
+            ssub => {
+                siss => {
+                    field => 'subscription',
+                    fkey  => 'id',
+                    join  => {
+                        sitem => {
+                            field  => 'issuance',
+                            fkey   => 'id',
+                            $$args{ou} ? ( join  => {
+                                sstr => {
+                                    field => 'id',
+                                    fkey  => 'stream',
+                                    join  => {
+                                        sdist => {
+                                            field  => 'id',
+                                            fkey   => 'distribution'
+                                        }
+                                    }
+                                }
+                            }) : ()
+                        }
+                    }
+                }
+            }
+        },
+        where => {
+            '+ssub'  => { record_entry => $bib },
+            $$args{type} ? ( '+siss' => { 'holding_type' => $$args{type} } ) : (),
+            '+sitem' => {
+                # XXX should we also take specific item statuses into account?
+                date_received => { '!=' => undef },
+                $$args{status} ? ( 'status' => $$args{status} ) : ()
+            },
+            $$args{ou} ? ( '+sdist' => {
+                holding_lib => {
+                    'in' => $U->get_org_descendants($$args{ou}, $$args{depth})
+                }
+            }) : ()
+        },
+        $$args{limit}  ? ( limit  => $$args{limit}  ) : (),
+        $$args{offset} ? ( offset => $$args{offset} ) : (),
+        order_by => [{ class => 'siss', field => 'date_published', direction => $$args{order} }],
+        distinct => 1
+    });
+
+    $client->respond({
+        "issuance" => $e->retrieve_serial_issuance($_->{"id"}),
+        "has_units" => $_->{"has_units"} ? 1 : 0
+    }) for @$issuances;
+
+    return undef;
+}
+__PACKAGE__->register_method(
+    method    => 'received_siss_by_bib',
+    api_name  => 'open-ils.serial.received_siss.retrieve.by_bib',
+    api_level => 1,
+    argc      => 1,
+    stream    => 1,
+    signature => {
+        desc   => 'Receives a Bib ID and other optional params and returns "siss" (issuance) objects',
+        params => [
+            {   name => 'bibid',
+                desc => 'id of the bre to which the issuances belong',
+                type => 'number'
+            },
+            {   name => 'args',
+                desc =>
+q/A hash of optional arguments.  Valid keys and their meanings:
+    global := If true, return only one representative version of a conceptual issuance regardless of the number of subscriptions, otherwise return all issuance objects meeting the requested criteria, including conceptual duplicates. Valid values are 0 (false) and 1 (true, default).
+    order  := date_published sort direction, either "asc" (chronological, default) or "desc" (reverse chronological)
+    limit  := Number of issuances to return.  Useful for paging results, or finding the oldest or newest
+    offset := Number of issuance to skip before returning results.  Useful for paging.
+    orgid  := OU id used to scope retrieval, based on distribution.holding_lib
+    depth  := OU depth used to range the scope of orgid
+    type   := Holding type filter. Valid values are "basic", "supplement" and "index". Can be a scalar (one) or arrayref (one or more).
+    status := Item status filter. Valid values are "Bindery", "Bound", "Claimed", "Discarded", "Expected", "Not Held", "Not Published" and "Received". Can be a scalar (one) or arrayref (one or more).
+/
+            }
+        ]
+    }
+);
+
+
+sub scoped_bib_holdings_summary {
+    my $self = shift;
+    my $client = shift;
+    my $bibid = shift;
+    my $args = shift || {};
+
+    $args->{order} = 'asc';
+
+    my ($issuances) = $self->method_lookup('open-ils.serial.received_siss.retrieve.by_bib.atomic')->run( $bibid => $args );
+
+    # split into issuance type sets
+    my %type_blob = (basic => [], supplement => [], index => []);
+    push @{ $type_blob{ $_->{"issuance"}->holding_type } }, $_->{"issuance"}
+        for (@$issuances);
+
+    # generate a statement list for each type
+    my %statement_blob;
+    for my $type ( keys %type_blob ) {
+        my ($mfhd,$list) = _summarize_contents(new_editor(), $type_blob{$type});
+        $statement_blob{$type} = $list;
+    }
+
+    return \%statement_blob;
+}
+__PACKAGE__->register_method(
+    method    => 'scoped_bib_holdings_summary',
+    api_name  => 'open-ils.serial.bib.summary_statements',
+    api_level => 1,
+    argc      => 1,
+    signature => {
+        desc   => 'Receives a Bib ID and other optional params and returns set of holdings statements',
+        params => [
+            {   name => 'bibid',
+                desc => 'id of the bre to which the issuances belong',
+                type => 'number'
+            },
+            {   name => 'args',
+                desc =>
+q/A hash of optional arguments.  Valid keys and their meanings:
+    orgid  := OU id used to scope retrieval, based on distribution.holding_lib
+    depth  := OU depth used to range the scope of orgid
+    type   := Holding type filter. Valid values are "basic", "supplement" and "index". Can be a scalar (one) or arrayref (one or more).
+    status := Item status filter. Valid values are "Bindery", "Bound", "Claimed", "Discarded", "Expected", "Not Held", "Not Published" and "Received". Can be a scalar (one) or arrayref (one or more).
+/
+            }
+        ]
+    }
+);
+
+
+##########################################################################
+# unit methods
+#
+__PACKAGE__->register_method(
+    method    => 'fleshed_sunit_alter',
+    api_name  => 'open-ils.serial.sunit.fleshed.batch.update',
+    api_level => 1,
+    argc      => 2,
+    signature => {
+        desc     => 'Receives an array of one or more Units and updates the database as needed',
+        'params' => [ {
+                 name => 'authtoken',
+                 desc => 'Authtoken for current user session',
+                 type => 'string'
+            },
+            {
+                 name => 'sunits',
+                 desc => 'Array of fleshed Units',
+                 type => 'array'
+            }
+
+        ],
+        'return' => {
+            desc => 'Returns 1 if successful, event if failed',
+            type => 'mixed'
+        }
+    }
+);
+
+sub fleshed_sunit_alter {
+    my( $self, $conn, $auth, $sunits ) = @_;
+    return 1 unless ref $sunits;
+    my( $reqr, $evt ) = $U->checkses($auth);
+    return $evt if $evt;
+    my $editor = new_editor(requestor => $reqr, xact => 1);
+    my $override = $self->api_name =~ /override/;
+
+# TODO: permission support
+#        return $editor->event unless
+#            $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy));
+
+    for my $sunit (@$sunits) {
+        if( $sunit->isdeleted ) {
+            $evt = _delete_sunit( $editor, $override, $sunit );
+        } else {
+            $sunit->default_location( $sunit->default_location->id ) if ref $sunit->default_location;
+
+            if( $sunit->isnew ) {
+                $evt = _create_sunit( $editor, $sunit );
+            } else {
+                $evt = _update_sunit( $editor, $override, $sunit );
+            }
+        }
+    }
+
+    if( $evt ) {
+        $logger->info("fleshed sunit-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
+        $editor->rollback;
+        return $evt;
+    }
+    $logger->debug("sunit-alter: done updating sunit batch");
+    $editor->commit;
+    $logger->info("fleshed sunit-alter successfully updated ".scalar(@$sunits)." Units");
+    return 1;
+}
+
+sub _delete_sunit {
+    my ($editor, $override, $sunit) = @_;
+    $logger->info("sunit-alter: delete sunit ".OpenSRF::Utils::JSON->perl2JSON($sunit));
+    return $editor->event unless $editor->delete_serial_unit($sunit);
+    return 0;
+}
+
+sub _create_sunit {
+    my ($editor, $sunit) = @_;
+
+    $logger->info("sunit-alter: new Unit ".OpenSRF::Utils::JSON->perl2JSON($sunit));
+    return $editor->event unless $editor->create_serial_unit($sunit);
+    return 0;
+}
+
+sub _update_sunit {
+    my ($editor, $override, $sunit) = @_;
+
+    $logger->info("sunit-alter: retrieving sunit ".$sunit->id);
+    my $orig_sunit = $editor->retrieve_serial_unit($sunit->id);
+
+    $logger->info("sunit-alter: original sunit ".OpenSRF::Utils::JSON->perl2JSON($orig_sunit));
+    $logger->info("sunit-alter: updated sunit ".OpenSRF::Utils::JSON->perl2JSON($sunit));
+    return $editor->event unless $editor->update_serial_unit($sunit);
+    return 0;
+}
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_unit_list",
+    authoritative => 1,
+	api_name	=> "open-ils.serial.unit_list.retrieve"
+);
+
+sub retrieve_unit_list {
+
+	my( $self, $client, @sdist_ids ) = @_;
+
+	if(ref($sdist_ids[0])) { @sdist_ids = @{$sdist_ids[0]}; }
+
+	my $e = new_editor();
+
+    my $query = {
+        'select' => 
+            { 'sunit' => [ 'id', 'summary_contents', 'sort_key' ],
+              'sitem' => ['stream'],
+              'sstr' => ['distribution'],
+              'sdist' => [{'column' => 'label', 'alias' => 'sdist_label'}]
+            },
+        'from' =>
+            { 'sdist' =>
+                { 'sstr' =>
+                    { 'join' =>
+                        { 'sitem' =>
+                            { 'join' => { 'sunit' => {} } }
+                        }
+                    }
+                }
+            },
+        'distinct' => 'true',
+        'where' => { '+sdist' => {'id' => \@sdist_ids} },
+        'order_by' => [{'class' => 'sunit', 'field' => 'sort_key'}]
+    };
+
+    my $unit_list_entries = $e->json_query($query);
+    
+    my @entries;
+    foreach my $entry (@$unit_list_entries) {
+        my $value = {'sunit' => $entry->{id}, 'sstr' => $entry->{stream}, 'sdist' => $entry->{distribution}};
+        my $label = $entry->{summary_contents};
+        if (length($label) > 100) {
+            $label = substr($label, 0, 100) . '...'; # limited space in dropdown / menu
+        }
+        $label = "[$entry->{sdist_label}/$entry->{stream} #$entry->{id}] " . $label;
+        push (@entries, [$label, OpenSRF::Utils::JSON->perl2JSON($value)]);
+    }
+
+    return \@entries;
+}
+
+
+
+##########################################################################
+# predict and receive methods
+#
+__PACKAGE__->register_method(
+    method    => 'make_predictions',
+    api_name  => 'open-ils.serial.make_predictions',
+    api_level => 1,
+    argc      => 1,
+    signature => {
+        desc     => 'Receives an ssub id and populates the issuance and item tables',
+        'params' => [ {
+                 name => 'ssub_id',
+                 desc => 'Serial Subscription ID',
+                 type => 'int'
+            }
+        ]
+    }
+);
+
+sub make_predictions {
+    my ($self, $conn, $authtoken, $args) = @_;
+
+    my $editor = OpenILS::Utils::CStoreEditor->new();
+    my $ssub_id = $args->{ssub_id};
+    my $mfhd = MFHD->new(MARC::Record->new());
+
+    my $ssub = $editor->retrieve_serial_subscription([$ssub_id]);
+    my $scaps = $editor->search_serial_caption_and_pattern({ subscription => $ssub_id, active => 't'});
+    my $sdists = $editor->search_serial_distribution( [{ subscription => $ssub->id }, { flesh => 1, flesh_fields => {sdist => [ qw/ streams / ]} }] ); #TODO: 'deleted' support?
+
+    my $total_streams = 0;
+    foreach (@$sdists) {
+        $total_streams += scalar(@{$_->streams});
+    }
+    if ($total_streams < 1) {
+        $editor->disconnect;
+        # XXX TODO new event type
+        return new OpenILS::Event(
+            "BAD_PARAMS", note =>
+                "There are no streams to direct items. Can't predict."
+        );
+    }
+
+    unless (@$scaps) {
+        $editor->disconnect;
+        # XXX TODO new event type
+        return new OpenILS::Event(
+            "BAD_PARAMS", note =>
+                "There are no active caption-and-pattern objects associated " .
+                "with this subscription. Can't predict."
+        );
+    }
+
+    my @predictions;
+    my $link_id = 1;
+    foreach my $scap (@$scaps) {
+        my $caption_field = _revive_caption($scap);
+        $caption_field->update('8' => $link_id);
+        my $using_fake_chron = 0;
+        # if we have no chronology, add one for prediction puposes
+        if (!$caption_field->subfield('i') and !$caption_field->enumeration_is_chronology) {
+            $using_fake_chron = 1;
+        }
+        $mfhd->append_fields($caption_field);
+        my $options = {
+                'caption' => $caption_field,
+                'scap_id' => $scap->id,
+                'num_to_predict' => $args->{num_to_predict},
+                'end_date' => defined $args->{end_date} ?
+                    $_strp_date->parse_datetime($args->{end_date}) : undef
+                };
+        if ($args->{base_issuance}) { # predict from a given issuance
+            $options->{predict_from} = _revive_holding($args->{base_issuance}->holding_code, $caption_field, 1); # fresh MFHD Record, so we simply default to 1 for seqno
+            $options->{faked_chron_date} = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($args->{base_issuance}->date_published)) if $using_fake_chron;
+        } else { # default to predicting from last published
+            my $last_published = $editor->search_serial_issuance([
+                    {'caption_and_pattern' => $scap->id,
+                    'subscription' => $ssub_id},
+                {limit => 1, order_by => { siss => "date_published DESC" }}]
+                );
+            if ($last_published->[0]) {
+                my $last_siss = $last_published->[0];
+                unless ($last_siss->holding_code) {
+                    $editor->disconnect;
+                    # XXX TODO new event type
+                    return new OpenILS::Event(
+                        "BAD_PARAMS", note =>
+                            "Last issuance has no holding code. Can't predict."
+                    );
+                }
+                $options->{predict_from} = _revive_holding($last_siss->holding_code, $caption_field, 1);
+                $options->{faked_chron_date} = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($last_siss->date_published)) if $using_fake_chron;
+            } else {
+                $editor->disconnect;
+                # XXX TODO make a new event type instead of hijacking this one
+                return new OpenILS::Event(
+                    "BAD_PARAMS", note => "No issuance from which to predict!"
+                );
+            }
+        }
+        push( @predictions, _generate_issuance_values($mfhd, $options) );
+        $link_id++;
+    }
+
+    my @issuances;
+    foreach my $prediction (@predictions) {
+        my $issuance = new Fieldmapper::serial::issuance;
+        $issuance->isnew(1);
+        $issuance->label($prediction->{label});
+        $issuance->date_published($prediction->{date_published}->strftime('%F'));
+        $issuance->holding_code(OpenSRF::Utils::JSON->perl2JSON($prediction->{holding_code}));
+        $issuance->holding_type($prediction->{holding_type});
+        $issuance->caption_and_pattern($prediction->{caption_and_pattern});
+        $issuance->subscription($ssub->id);
+        push (@issuances, $issuance);
+    }
+
+    fleshed_issuance_alter($self, $conn, $authtoken, \@issuances); # FIXME: catch events
+
+    my @items;
+    for (my $i = 0; $i < @issuances; $i++) {
+        my $date_expected = $predictions[$i]->{date_published}->add(seconds => interval_to_seconds($ssub->expected_date_offset))->strftime('%F');
+        my $issuance = $issuances[$i];
+        #$issuance->label(interval_to_seconds($ssub->expected_date_offset));
+        foreach my $sdist (@$sdists) {
+            my $streams = $sdist->streams;
+            foreach my $stream (@$streams) {
+                my $item = new Fieldmapper::serial::item;
+                $item->isnew(1);
+                $item->stream($stream->id);
+                $item->date_expected($date_expected);
+                $item->issuance($issuance->id);
+                push (@items, $item);
+            }
+        }
+    }
+    fleshed_item_alter($self, $conn, $authtoken, \@items); # FIXME: catch events
+    return \@items;
+}
+
+#
+# _generate_issuance_values() is an initial attempt at a function which can be used
+# to populate an issuance table with a list of predicted issues.  It accepts
+# a hash ref of options initially defined as:
+# caption : the caption field to predict on
+# num_to_predict : the number of issues you wish to predict
+# last_rec_date : the date of the last received issue, to be used as an offset
+#                 for predicting future issues
+# faked_chron_date : if the serial does not actually have a chronology caption (but we need one for prediction's sake), base predictions on this date
+#
+# The basic method is to first convert to a single holding if compressed, then
+# increment the holding and save the resulting values to @issuances.
+# 
+# returns @issuance_values, an array of hashrefs containing (formatted
+# label, formatted chronology date, formatted estimated arrival date, and an
+# array ref of holding subfields as (key, value, key, value ...)) (not a hash
+# to protect order and possible duplicate keys), and a holding type.
+#
+sub _generate_issuance_values {
+    my ($mfhd, $options) = @_;
+    my $caption = $options->{caption};
+    my $scap_id = $options->{scap_id};
+    my $num_to_predict = $options->{num_to_predict};
+    my $end_date = $options->{end_date};
+    my $predict_from = $options->{predict_from};   # issuance to predict from
+    my $faked_chron_date = $options->{faked_chron_date};   # serial does not have a chronology caption, so add one (temporarily) based on this date 
+    #my $last_rec_date = $options->{last_rec_date};   # expected or actual
+
+
+# Only needed for 'real' MFHD records, not our temp records
+#    my $link_id = $caption->link_id;
+#    if(!$predict_from) {
+#        my $htag = $caption->tag;
+#        $htag =~ s/^85/86/;
+#        my @holdings = $mfhd->holdings($htag, $link_id);
+#        my $last_holding = $holdings[-1];
+#
+#        #if ($last_holding->is_compressed) {
+#        #    $last_holding->compressed_to_last; # convert to last in range
+#        #}
+#        $predict_from = $last_holding;
+#    }
+#
+
+    $predict_from->notes('public',  []);
+# add a note marker for system use (?)
+    $predict_from->notes('private', ['AUTOGEN']);
+
+    # our basic method for dealing with 'faked' chronologies will be to add it in, do the predicting, then take it back out
+    my $orig_caption;
+    my $faked_caption;
+    if ($faked_chron_date) {
+        $orig_caption = $predict_from->caption;
+        # because of the way MFHD::Caption and Holding work, it is simplest
+        # to recreate rather than try to update
+        $faked_caption = new MFHD::Caption(new MARC::Field($orig_caption->tag, $orig_caption->indicator(1), $orig_caption->indicator(2), $orig_caption->subfields_list, 'i' => '(year)', 'j' => '(month)', 'k' => '(day)'));
+        $predict_from = new MFHD::Holding($predict_from->seqno, new MARC::Field($predict_from->tag, $predict_from->indicator(1), $predict_from->indicator(2), $predict_from->subfields_list, 'i' => $faked_chron_date->year, 'j' => $faked_chron_date->month, 'k' => $faked_chron_date->day), $faked_caption);
+    }
+
+    my @predictions = $mfhd->generate_predictions({'base_holding' => $predict_from, 'num_to_predict' => $num_to_predict, 'end_date' => $end_date});
+
+    my $pub_date;
+    my @issuance_values;
+    foreach my $prediction (@predictions) {
+        $pub_date = $_strp_date->parse_datetime($prediction->chron_to_date);
+        if ($faked_chron_date) { # get rid of the chronology portions and restore original caption
+            $prediction->delete_subfield(code => ['i', 'j', 'k']);
+            $prediction = new MFHD::Holding($prediction->seqno, new MARC::Field($prediction->tag, $prediction->indicator(1), $prediction->indicator(2), $prediction->subfields_list), $orig_caption);
+        }
+        push(
+                @issuance_values,
+                {
+                    #$link_id,
+                    label => $prediction->format,
+                    date_published => $pub_date,
+                    #date_expected => $date_expected->strftime('%F'),
+                    holding_code => [$prediction->indicator(1),$prediction->indicator(2),$prediction->subfields_list],
+                    holding_type => $MFHD_NAMES_BY_TAG{$caption->tag},
+                    caption_and_pattern => $scap_id
+                }
+            );
+    }
+
+    return @issuance_values;
+}
+
+sub _revive_caption {
+    my $scap = shift;
+
+    my $pattern_code = $scap->pattern_code;
+
+    # build MARC::Field
+    my $pattern_parts = OpenSRF::Utils::JSON->JSON2perl($pattern_code);
+    unshift(@$pattern_parts, $MFHD_TAGS_BY_NAME{$scap->type});
+    my $pattern_field = new MARC::Field(@$pattern_parts);
+
+    # build MFHD::Caption
+    return new MFHD::Caption($pattern_field);
+}
+
+sub _revive_holding {
+    my $holding_code = shift;
+    my $caption_field = shift;
+    my $seqno = shift;
+
+    # build MARC::Field
+    my $holding_parts = OpenSRF::Utils::JSON->JSON2perl($holding_code);
+    my $captag = $caption_field->tag;
+    $captag =~ s/^85/86/;
+    unshift(@$holding_parts, $captag);
+    my $holding_field = new MARC::Field(@$holding_parts);
+
+    # build MFHD::Holding
+    return new MFHD::Holding($seqno, $holding_field, $caption_field);
+}
+
+__PACKAGE__->register_method(
+    method    => 'unitize_items',
+    api_name  => 'open-ils.serial.receive_items',
+    api_level => 1,
+    argc      => 1,
+    signature => {
+        desc     => 'Marks an item as received, updates the shelving unit (creating a new shelving unit if needed), and updates the summaries',
+        'params' => [ {
+                 name => 'items',
+                 desc => 'array of serial items',
+                 type => 'array'
+            },
+            {
+                 name => 'barcodes',
+                 desc => 'hash of item_ids => barcodes',
+                 type => 'hash'
+            },
+            {
+                 name => 'call_numbers',
+                 desc => 'hash of item_ids => call_numbers',
+                 type => 'hash'
+            }
+        ],
+        'return' => {
+            desc => 'Returns number of received items (num_items) and new unit ID, if applicable (new_unit_id)',
+            type => 'hashref'
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => 'unitize_items',
+    api_name  => 'open-ils.serial.bind_items',
+    api_level => 1,
+    argc      => 1,
+    signature => {
+        desc     => 'Marks an item as bound, updates the shelving unit (creating a new shelving unit if needed)',
+        'params' => [ {
+                 name => 'items',
+                 desc => 'array of serial items',
+                 type => 'array'
+            },
+            {
+                 name => 'barcodes',
+                 desc => 'hash of item_ids => barcodes',
+                 type => 'hash'
+            },
+            {
+                 name => 'call_numbers',
+                 desc => 'hash of item_ids => call_numbers',
+                 type => 'hash'
+            }
+        ],
+        'return' => {
+            desc => 'Returns number of bound items (num_items) and new unit ID, if applicable (new_unit_id)',
+            type => 'hashref'
+        }
+    }
+);
+
+# TODO: reset/delete claims information once implemented
+# XXX: deal with emptied call numbers here?
+__PACKAGE__->register_method(
+    method    => 'unitize_items',
+    api_name  => 'open-ils.serial.reset_items',
+    api_level => 1,
+    argc      => 1,
+    signature => {
+        desc     => 'Resets the items to Expected, updates the shelving unit (deleting the shelving unit if empty), and updates the summaries',
+        'params' => [ {
+                 name => 'items',
+                 desc => 'array of serial items',
+                 type => 'array'
+            }
+        ],
+        'return' => {
+            desc => 'Returns number of reset items (num_items)',
+            type => 'hashref'
+        }
+    }
+);
+
+sub unitize_items {
+    my ($self, $conn, $auth, $items, $barcodes, $call_numbers) = @_;
+
+    my $editor = new_editor("authtoken" => $auth, "xact" => 1);
+    return $editor->die_event unless $editor->checkauth;
+    return $editor->die_event unless $editor->allowed("RECEIVE_SERIAL");
+    $self->api_name =~ /serial\.(\w*)_items/;
+    my $mode = $1;
+    
+    my %found_unit_ids;
+    my %found_stream_ids;
+    my %found_types;
+
+    my %stream_ids_by_unit_id;
+
+    my %unit_map;
+    my %sdist_by_unit_id;
+    my %call_number_by_unit_id;
+    my %sdist_by_stream_id;
+
+    my $new_unit_id; # id for '-2' units to share
+    foreach my $item (@$items) {
+        # for debugging only, TODO: delete
+        if (!ref $item) { # hopefully we got an id instead
+            $item = $editor->retrieve_serial_item($item);
+        }
+        # get ids
+        my $unit_id = ref($item->unit) ? $item->unit->id : $item->unit;
+        my $stream_id = ref($item->stream) ? $item->stream->id : $item->stream;
+        my $issuance_id = ref($item->issuance) ? $item->issuance->id : $item->issuance;
+        #TODO: evt on any missing ids
+
+        if ($mode eq 'receive') {
+            $item->date_received('now');
+            $item->status('Received');
+        } elsif ($mode eq 'reset') {
+            # clear date_received
+            $item->clear_date_received;
+            # Set status to 'Expected'
+            $item->status('Expected');
+            # remove from unit
+            $item->clear_unit;
+        }
+
+        # check for types to trigger summary updates
+        my $scap;
+        if (!ref $item->issuance) {
+            my $scaps = $editor->search_serial_caption_and_pattern([{"+siss" => {"id" => $issuance_id}}, { "join" => {"siss" => {}} }]);
+            $scap = $scaps->[0];
+        } elsif (!ref $item->issuance->caption_and_pattern) {
+            $scap = $editor->retrieve_serial_caption_and_pattern($item->issuance->caption_and_pattern);
+        } else {
+            $scap = $editor->issuance->caption_and_pattern;
+        }
+        if (!exists($found_types{$stream_id})) {
+            $found_types{$stream_id} = {};
+        }
+        $found_types{$stream_id}->{$scap->type} = 1;
+
+        # create unit if needed
+        if ($unit_id == -1 or (!$new_unit_id and $unit_id == -2)) { # create unit per item
+            my $unit;
+            my $sdists = $editor->search_serial_distribution([
+                {"+sstr" => {"id" => $stream_id}},
+                {
+                    "join" => {"sstr" => {}},
+                    "flesh" => 1,
+                    "flesh_fields" => {"sdist" => ["subscription"]}
+                }]);
+            $unit = _build_unit($editor, $sdists->[0], $mode);
+            # if _build_unit fails, $unit is an event, so return it
+            if ($U->event_code($unit)) {
+                $editor->rollback;
+                $unit->{"note"} = "Item ID: " . $item->id;
+                return $unit;
+            }
+            $unit->barcode($barcodes->{$item->id}) if exists($barcodes->{$item->id});
+            my $evt =  _create_sunit($editor, $unit);
+            return $evt if $evt;
+            if ($unit_id == -2) {
+                $new_unit_id = $unit->id;
+                $unit_id = $new_unit_id;
+            } else {
+                $unit_id = $unit->id;
+            }
+            $item->unit($unit_id);
+            
+            # get unit with 'DEFAULT's and save unit, sdist, and call number for later use
+            $unit = $editor->retrieve_serial_unit($unit->id);
+            $unit_map{$unit_id} = $unit;
+            $sdist_by_unit_id{$unit_id} = $sdists->[0];
+            $call_number_by_unit_id{$unit_id} = $call_numbers->{$item->id};
+            $sdist_by_stream_id{$stream_id} = $sdists->[0];
+        } elsif ($unit_id == -2) { # create one unit for all '-2' items
+            $unit_id = $new_unit_id;
+            $item->unit($unit_id);
+        }
+
+        $found_stream_ids{$stream_id} = 1;
+
+        if (defined($unit_id)) {
+            $found_unit_ids{$unit_id} = 1;
+            # save the stream_id for this unit_id
+            # TODO: prevent items from different streams in same unit? (perhaps in interface)
+            $stream_ids_by_unit_id{$unit_id} = $stream_id;
+        }
+
+        my $evt = _update_sitem($editor, undef, $item);
+        return $evt if $evt;
+    }
+
+    # cleanup 'dead' units (units which are now emptied of their items)
+    my $dead_units = $editor->search_serial_unit([{'+sitem' => {'id' => undef}, 'deleted' => 'f'}, {'join' => {'sitem' => {'type' => 'left'}}}]);
+    foreach my $unit (@$dead_units) {
+        _delete_sunit($editor, undef, $unit);
+        delete $found_unit_ids{$unit->id};
+    }
+
+    # deal with unit level contents
+    foreach my $unit_id (keys %found_unit_ids) {
+
+        # get all the needed issuances for unit
+        # TODO remove 'Bindery' from this search (leaving it in for now for backwards compatibility with any current test environment data)
+        my $issuances = $editor->search_serial_issuance([ {"+sitem" => {"unit" => $unit_id, "status" => ["Received", "Bindery"]}}, {"join" => {"sitem" => {}}, "order_by" => {"siss" => "date_published"}} ]);
+        #TODO: evt on search failure
+
+        # retrieve and update unit contents
+        my $sunit;
+        my $sdist;
+        my $call_number_string;
+        my $record_id;
+        # if we just created the unit, we will already have it and the distribution stored, and we will need to assign the call number
+        if (exists $unit_map{$unit_id}) {
+            $sunit = $unit_map{$unit_id};
+            $sdist = $sdist_by_unit_id{$unit_id};
+            $call_number_string = $call_number_by_unit_id{$unit_id};
+            $record_id = $sdist->subscription->record_entry;
+        } else {
+            $sunit = $editor->retrieve_serial_unit($unit_id);
+            $sdist = $editor->search_serial_distribution([{"+sstr" => {"id" => $stream_ids_by_unit_id{$unit_id}}}, { "join" => {"sstr" => {}} }]);
+            $sdist = $sdist->[0];
+        }
+
+        my $evt = _prepare_unit($editor, $sunit, $sdist, $issuances, $call_number_string, $record_id);
+        if ($U->event_code($evt)) {
+            $editor->rollback;
+            return $evt;
+        }
+
+        $evt = _update_sunit($editor, undef, $sunit);
+        if ($U->event_code($evt)) {
+            $editor->rollback;
+            return $evt;
+        }
+    }
+
+    if ($mode ne 'bind') { # the summary holdings do not change when binding
+        # deal with stream level summaries
+        # summaries will be built from the "primary" stream only, that is, the stream with the lowest ID per distribution
+        # (TODO: consider direct designation)
+        my %primary_streams_by_sdist;
+        my %streams_by_sdist;
+
+        # see if we have primary streams, and if so, associate them with their distributions
+        foreach my $stream_id (keys %found_stream_ids) {
+            my $sdist;
+            if (exists $sdist_by_stream_id{$stream_id}) {
+                $sdist = $sdist_by_stream_id{$stream_id};
+            } else {
+                $sdist = $editor->search_serial_distribution([{"+sstr" => {"id" => $stream_id}}, { "join" => {"sstr" => {}} }]);
+                $sdist = $sdist->[0];
+            }
+            my $streams;
+            if (!exists($streams_by_sdist{$sdist->id})) {
+                $streams = $editor->search_serial_stream([{"distribution" => $sdist->id}, {"order_by" => {"sstr" => "id"}}]);
+                $streams_by_sdist{$sdist->id} = $streams;
+            } else {
+                $streams = $streams_by_sdist{$sdist->id};
+            }
+            $primary_streams_by_sdist{$sdist->id} = $streams->[0] if ($stream_id == $streams->[0]->id);
+        }
+
+        # retrieve and update summaries for each affected primary stream's distribution
+        foreach my $sdist_id (keys %primary_streams_by_sdist) {
+            my $stream = $primary_streams_by_sdist{$sdist_id};
+            my $stream_id = $stream->id;
+            # get all the needed issuances for stream
+            # FIXME: search in Bindery/Bound/Not Published? as well as Received
+            foreach my $type (keys %{$found_types{$stream_id}}) {
+                my $issuances = $editor->search_serial_issuance([ {"+sitem" => {"stream" => $stream_id, "status" => "Received"}, "+scap" => {"type" => $type}}, {"join" => {"sitem" => {}, "scap" => {}}, "order_by" => {"siss" => "date_published"}} ]);
+                #TODO: evt on search failure
+                my $evt = _prepare_summaries($editor, $issuances, $sdist_id, $type);
+                if ($U->event_code($evt)) {
+                    $editor->rollback;
+                    return $evt;
+                }
+            }
+        }
+    }
+
+    $editor->commit;
+    return {'num_items' => scalar @$items, 'new_unit_id' => $new_unit_id};
+}
+
+sub _find_or_create_call_number {
+    my ($e, $lib, $cn_string, $record) = @_;
+
+    my $existing = $e->search_asset_call_number({
+        "owning_lib" => $lib,
+        "label" => $cn_string,
+        "record" => $record,
+        "deleted" => "f"
+    }) or return $e->die_event;
+
+    if (@$existing) {
+        return $existing->[0]->id;
+    } else {
+        return $e->die_event unless
+            $e->allowed("CREATE_VOLUME", $lib);
+
+        my $acn = new Fieldmapper::asset::call_number;
+
+        $acn->creator($e->requestor->id);
+        $acn->editor($e->requestor->id);
+        $acn->record($record);
+        $acn->label($cn_string);
+        $acn->owning_lib($lib);
+
+        $e->create_asset_call_number($acn) or return $e->die_event;
+        return $e->data->id;
+    }
+}
+
+sub _issuances_received {
+    # XXX TODO: Add some caching or something. This is getting called
+    # more often than it has to be.
+    my ($e, $sitem) = @_;
+
+    my $results = $e->json_query({
+        "select" => {"sitem" => ["issuance"]},
+        "from" => {"sitem" => {"sstr" => {}, "siss" => {}}},
+        "where" => {
+            "+sstr" => {"distribution" => $sitem->stream->distribution->id},
+            "+siss" => {"holding_type" => $sitem->issuance->holding_type},
+            "+sitem" => {"date_received" => {"!=" => undef}}
+        },
+        "order_by" => {
+            "siss" => {"date_published" => {"direction" => "asc"}}
+        }
+    }) or return $e->die_event;
+
+    my $uniq = +{map { $_->{"issuance"} => 1 } @$results};
+    return [ map { $e->retrieve_serial_issuance($_) } keys %$uniq ];
+}
+
+# _prepare_unit populates the detailed_contents, summary_contents, and
+# sort_key fields for a given unit based on a given set of issuances
+# Also finds/creates call number as needed
+sub _prepare_unit {
+    my ($e, $sunit, $sdist, $issuances, $call_number_string, $record_id) = @_;
+
+    # Handle call number first if we have one
+    if ($call_number_string) {
+        my $org_unit_id = ref $sdist->holding_lib ? $sdist->holding_lib->id : $sdist->holding_lib;
+        my $real_cn = _find_or_create_call_number(
+            $e, $org_unit_id,
+            $call_number_string, $record_id
+        );
+
+        if ($U->event_code($real_cn)) {
+            return $real_cn;
+        } else {
+            $sunit->call_number($real_cn);
+        }
+    }
+
+    my ($mfhd, $formatted_parts) = _summarize_contents($e, $issuances);
+
+    # special case for single formatted_part (may have summarized version)
+    if (@$formatted_parts == 1) {
+        #TODO: MFHD.pm should have a 'format_summary' method for this
+    }
+
+    $sunit->detailed_contents(
+        join(
+            " ",
+            $sdist->unit_label_prefix,
+            join(", ", @$formatted_parts),
+            $sdist->unit_label_suffix
+        )
+    );
+
+    # TODO: change this when real summary contents are available
+    $sunit->summary_contents($sunit->detailed_contents);
+
+    # Create sort_key by left padding numbers to 6 digits.
+    (my $sort_key = $sunit->detailed_contents) =~
+        s/(\d+)/sprintf '%06d', $1/eg;
+    $sunit->sort_key($sort_key);
+}
+
+# _prepare_summaries populates the generated_coverage field for a given summary 
+# type ('basic', 'index', 'supplement') for a given distribution.
+# It also creates the summary if it doesn't yet exist.
+sub _prepare_summaries {
+    my ($e, $issuances, $dist_id, $type) = @_;
+
+    my ($mfhd, $formatted_parts) = _summarize_contents($e, $issuances);
+
+    my $search_method = "search_serial_${type}_summary";
+    my $summary = $e->$search_method([{"distribution" => $dist_id}]);
+
+    my $cu_method = "update";
+
+    if (@$summary) {
+        $summary = $summary->[0];
+    } else {
+        my $class = "Fieldmapper::serial::${type}_summary";
+        $summary = $class->new;
+        $summary->distribution($dist_id);
+        $cu_method = "create";
+    }
+
+    $summary->generated_coverage(join(", ", @$formatted_parts));
+    my $method = "${cu_method}_serial_${type}_summary";
+    return $e->die_event unless $e->$method($summary);
+}
+
+sub _unit_by_iss_and_str {
+    my ($e, $issuance, $stream) = @_;
+
+    my $unit = $e->json_query({
+        "select" => {"sunit" => ["id"]},
+        "from" => {"sitem" => {"sunit" => {}}},
+        "where" => {
+            "+sitem" => {
+                "issuance" => $issuance->id,
+                "stream" => $stream->id
+            }
+        }
+    }) or return $e->die_event;
+    return 0 if not @$unit;
+
+    $e->retrieve_serial_unit($unit->[0]->{"id"}) or $e->die_event;
+}
+
+sub move_previous_unit {
+    my ($e, $prev_iss, $curr_item, $new_loc) = @_;
+
+    my $prev_unit = _unit_by_iss_and_str($e,$prev_iss,$curr_item->stream);
+    return $prev_unit if defined $U->event_code($prev_unit);
+    return 0 if not $prev_unit;
+
+    if ($prev_unit->location != $new_loc) {
+        $prev_unit->location($new_loc);
+        $e->update_serial_unit($prev_unit) or return $e->die_event;
+    }
+    0;
+}
+
+# _previous_issuance() assumes $existing is an ordered array
+sub _previous_issuance {
+    my ($existing, $issuance) = @_;
+
+    my $last = $existing->[-1];
+    return undef unless $last;
+    return ($last->id == $issuance->id ? $existing->[-2] : $last);
+}
+
+__PACKAGE__->register_method(
+    "method" => "receive_items_one_unit_per",
+    "api_name" => "open-ils.serial.receive_items.one_unit_per",
+    "stream" => 1,
+    "api_level" => 1,
+    "argc" => 3,
+    "signature" => {
+        "desc" => "Marks items in a list as received, creates a new unit for each item if any unit is fleshed on, and updates summaries as needed",
+        "params" => [
+            {
+                 "name" => "auth",
+                 "desc" => "authtoken",
+                 "type" => "string"
+            },
+            {
+                 "name" => "items",
+                 "desc" => "array of serial items, possibly fleshed with units and definitely fleshed with stream->distribution",
+                 "type" => "array"
+            },
+            {
+                "name" => "record",
+                "desc" => "id of bib record these items are associated with
+                    (XXX could/should be derived from items)",
+                "type" => "number"
+            }
+        ],
+        "return" => {
+            "desc" => "The item ID for each item successfully received",
+            "type" => "int"
+        }
+    }
+);
+
+sub receive_items_one_unit_per {
+    # XXX This function may be temporary, as it does some of what
+    # unitize_items() does, just in a different way.
+    my ($self, $client, $auth, $items, $record) = @_;
+
+    my $e = new_editor("authtoken" => $auth, "xact" => 1);
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed("RECEIVE_SERIAL");
+
+    my $prev_loc_setting_map = {};
+    my $user_id = $e->requestor->id;
+
+    # Get a list of all the non-virtual field names in a serial::unit for
+    # merging given unit objects with template-built units later.
+    # XXX move this somewhere global so it isn't re-run all the time
+    my $all_unit_fields =
+        $Fieldmapper::fieldmap->{"Fieldmapper::serial::unit"}->{"fields"};
+    my @real_unit_fields = grep {
+        not $all_unit_fields->{$_}->{"virtual"}
+    } keys %$all_unit_fields;
+
+    foreach my $item (@$items) {
+        # Note that we expect a certain fleshing on the items we're getting.
+        my $sdist = $item->stream->distribution;
+
+        # Fetch a list of issuances with received copies already existing
+        # on this distribution (and with the same holding type on the
+        # issuance).  This will be used in up to two places: once when building
+        # a summary, once when changing the copy location of the previous
+        # issuance's copy.
+        my $issuances_received = _issuances_received($e, $item);
+        if ($U->event_code($issuances_received)) {
+            $e->rollback;
+            return $issuances_received;
+        }
+
+        # Find out if we need to to deal with previous copy location changing.
+        my $ou = $sdist->holding_lib->id;
+        unless (exists $prev_loc_setting_map->{$ou}) {
+            $prev_loc_setting_map->{$ou} = $U->ou_ancestor_setting_value(
+                $ou, "serial.prev_issuance_copy_location", $e
+            );
+        }
+
+        # If there is a previous copy location setting, we need the previous
+        # issuance, from which we can in turn look up the item attached to the
+        # same stream we're on now.
+        if ($prev_loc_setting_map->{$ou}) {
+            if (my $prev_iss =
+                _previous_issuance($issuances_received, $item->issuance)) {
+
+                # Now we can change the copy location of the previous unit,
+                # if needed.
+                return $e->event if defined $U->event_code(
+                    move_previous_unit(
+                        $e, $prev_iss, $item, $prev_loc_setting_map->{$ou}
+                    )
+                );
+            }
+        }
+
+        # Create unit if given by user
+        if (ref $item->unit) {
+            # detach from the item, as we need to create separately
+            my $user_unit = $item->unit;
+
+            # get a unit based on associated template
+            my $template_unit = _build_unit($e, $sdist, "receive");
+            if ($U->event_code($template_unit)) {
+                $e->rollback;
+                $template_unit->{"note"} = "Item ID: " . $item->id;
+                return $template_unit;
+            }
+
+            # merge built unit with provided unit from user
+            foreach (@real_unit_fields) {
+                unless ($user_unit->$_) {
+                    $user_unit->$_($template_unit->$_);
+                }
+            }
+
+            # Treat call number specially: the provided value from the
+            # user will really be a string.
+            my $call_number_string;
+            if ($user_unit->call_number) {
+                $call_number_string = $user_unit->call_number;
+                # clear call number for now (replaced in _prepare_unit)
+                $user_unit->clear_call_number;
+            }
+
+            my $evt = _prepare_unit(
+                $e, $user_unit, $sdist, [$item->issuance],
+                $call_number_string, $record
+            );
+            if ($U->event_code($evt)) {
+                $e->rollback;
+                return $evt;
+            }
+
+            # create/update summary objects related to this distribution
+            # Make sure @$issuances_received contains current item's issuance
+            unless (grep { $_->id == $item->issuance->id } @$issuances_received) {
+                push @$issuances_received, $item->issuance;
+            }
+            $evt = _prepare_summaries($e, $issuances_received, $item->stream->distribution->id, $item->issuance->holding_type);
+            if ($U->event_code($evt)) {
+                $e->rollback;
+                return $evt;
+            }
+
+            # set the incontrovertibles on the unit
+            $user_unit->edit_date("now");
+            $user_unit->create_date("now");
+            $user_unit->editor($user_id);
+            $user_unit->creator($user_id);
+
+            return $e->die_event unless $e->create_serial_unit($user_unit);
+
+            # save reference to new unit
+            $item->unit($e->data->id);
+        }
+
+        # Create notes if given by user
+        if (ref($item->notes) and @{$item->notes}) {
+            foreach my $note (@{$item->notes}) {
+                $note->creator($user_id);
+                $note->create_date("now");
+
+                return $e->die_event unless $e->create_serial_item_note($note);
+            }
+
+            $item->clear_notes; # They're saved; we no longer want them here.
+        }
+
+        # Set the incontrovertibles on the item
+        $item->status("Received");
+        $item->date_received("now");
+        $item->edit_date("now");
+        $item->editor($user_id);
+
+        return $e->die_event unless $e->update_serial_item($item);
+
+        # send client a response
+        $client->respond($item->id);
+    }
+
+    $e->commit or return $e->die_event;
+    undef;
+}
+
+sub _build_unit {
+    my $editor = shift;
+    my $sdist = shift;
+    my $mode = shift;
+    #my $skip_call_number = shift;
+
+    my $attr = $mode . '_unit_template';
+    my $template = $editor->retrieve_asset_copy_template($sdist->$attr) or
+        return new OpenILS::Event("SERIAL_DISTRIBUTION_HAS_NO_COPY_TEMPLATE");
+
+    my @parts = qw( status location loan_duration fine_level age_protect circulate deposit ref holdable deposit_amount price circ_modifier circ_as_type alert_message opac_visible floating mint_condition );
+
+    my $unit = new Fieldmapper::serial::unit;
+    foreach my $part (@parts) {
+        my $value = $template->$part;
+        next if !defined($value);
+        $unit->$part($value);
+    }
+
+    # ignore circ_lib in template, set to distribution holding_lib
+    $unit->circ_lib($sdist->holding_lib);
+    $unit->creator($editor->requestor->id);
+    $unit->editor($editor->requestor->id);
+
+# XXX: this feature has been pushed back until after 2.0 at least
+#    unless ($skip_call_number) {
+#        $attr = $mode . '_call_number';
+#        my $cn = $sdist->$attr or
+#            return new OpenILS::Event("SERIAL_DISTRIBUTION_HAS_NO_CALL_NUMBER");
+#
+#        $unit->call_number($cn);
+#    }
+    $unit->call_number('-1'); # default to the dummy call number
+    $unit->barcode('@@PLACEHOLDER'); # generic unit will start with a generated placeholder barcode
+    $unit->sort_key('');
+    $unit->summary_contents('');
+    $unit->detailed_contents('');
+
+    return $unit;
+}
+
+
+sub _summarize_contents {
+    my $editor = shift;
+    my $issuances = shift;
+
+    # create MFHD record
+    my $mfhd = MFHD->new(MARC::Record->new());
+    my %scaps;
+    my %scap_fields;
+    my @scap_fields_ordered;
+    my $seqno = 1;
+    my $link_id = 1;
+    foreach my $issuance (@$issuances) {
+        my $scap_id = $issuance->caption_and_pattern;
+        next if (!$scap_id); # skip issuances with no caption/pattern
+
+        my $scap;
+        my $scap_field;
+        # if this is the first appearance of this scap, retrieve it and add it to the temporary record
+        if (!exists $scaps{$issuance->caption_and_pattern}) {
+            $scaps{$scap_id} = $editor->retrieve_serial_caption_and_pattern($scap_id);
+            $scap = $scaps{$scap_id};
+            $scap_field = _revive_caption($scap);
+            $scap_fields{$scap_id} = $scap_field;
+            push(@scap_fields_ordered, $scap_field);
+            $scap_field->update('8' => $link_id);
+            $mfhd->append_fields($scap_field);
+            $link_id++;
+        } else {
+            $scap = $scaps{$scap_id};
+            $scap_field = $scap_fields{$scap_id};
+        }
+
+        $mfhd->append_fields(_revive_holding($issuance->holding_code, $scap_field, $seqno));
+        $seqno++;
+    }
+
+    my @formatted_parts;
+    foreach my $scap_field (@scap_fields_ordered) { #TODO: use generic MFHD "summarize" method, once available
+       my @updated_holdings = $mfhd->get_compressed_holdings($scap_field);
+       foreach my $holding (@updated_holdings) {
+           push(@formatted_parts, $holding->format);
+       }
+    }
+
+    return ($mfhd, \@formatted_parts);
+}
+
+##########################################################################
+# note methods
+#
+__PACKAGE__->register_method(
+    method      => 'fetch_notes',
+    api_name        => 'open-ils.serial.item_note.retrieve.all',
+    signature   => q/
+        Returns an array of copy note objects.  
+        @param args A named hash of parameters including:
+            authtoken   : Required if viewing non-public notes
+            item_id      : The id of the item whose notes we want to retrieve
+            pub         : True if all the caller wants are public notes
+        @return An array of note objects
+    /
+);
+
+__PACKAGE__->register_method(
+    method      => 'fetch_notes',
+    api_name        => 'open-ils.serial.subscription_note.retrieve.all',
+    signature   => q/
+        Returns an array of copy note objects.  
+        @param args A named hash of parameters including:
+            authtoken       : Required if viewing non-public notes
+            subscription_id : The id of the item whose notes we want to retrieve
+            pub             : True if all the caller wants are public notes
+        @return An array of note objects
+    /
+);
+
+__PACKAGE__->register_method(
+    method      => 'fetch_notes',
+    api_name        => 'open-ils.serial.distribution_note.retrieve.all',
+    signature   => q/
+        Returns an array of copy note objects.  
+        @param args A named hash of parameters including:
+            authtoken       : Required if viewing non-public notes
+            distribution_id : The id of the item whose notes we want to retrieve
+            pub             : True if all the caller wants are public notes
+        @return An array of note objects
+    /
+);
+
+# TODO: revisit this method to consider replacing cstore direct calls
+sub fetch_notes {
+    my( $self, $connection, $args ) = @_;
+    
+    $self->api_name =~ /serial\.(\w*)_note/;
+    my $type = $1;
+
+    my $id = $$args{object_id};
+    my $authtoken = $$args{authtoken};
+    my( $r, $evt);
+
+    if( $$args{pub} ) {
+        return $U->cstorereq(
+            'open-ils.cstore.direct.serial.'.$type.'_note.search.atomic',
+            { $type => $id, pub => 't' } );
+    } else {
+        # FIXME: restore perm check
+        # ( $r, $evt ) = $U->checksesperm($authtoken, 'VIEW_COPY_NOTES');
+        # return $evt if $evt;
+        return $U->cstorereq(
+            'open-ils.cstore.direct.serial.'.$type.'_note.search.atomic', {$type => $id} );
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method(
+    method      => 'create_note',
+    api_name        => 'open-ils.serial.item_note.create',
+    signature   => q/
+        Creates a new item note
+        @param authtoken The login session key
+        @param note The note object to create
+        @return The id of the new note object
+    /
+);
+
+__PACKAGE__->register_method(
+    method      => 'create_note',
+    api_name        => 'open-ils.serial.subscription_note.create',
+    signature   => q/
+        Creates a new subscription note
+        @param authtoken The login session key
+        @param note The note object to create
+        @return The id of the new note object
+    /
+);
+
+__PACKAGE__->register_method(
+    method      => 'create_note',
+    api_name        => 'open-ils.serial.distribution_note.create',
+    signature   => q/
+        Creates a new distribution note
+        @param authtoken The login session key
+        @param note The note object to create
+        @return The id of the new note object
+    /
+);
+
+sub create_note {
+    my( $self, $connection, $authtoken, $note ) = @_;
+
+    $self->api_name =~ /serial\.(\w*)_note/;
+    my $type = $1;
+
+    my $e = new_editor(xact=>1, authtoken=>$authtoken);
+    return $e->event unless $e->checkauth;
+
+    # FIXME: restore permission support
+#    my $item = $e->retrieve_serial_item(
+#        [
+#            $note->item
+#        ]
+#    );
+#
+#    return $e->event unless
+#        $e->allowed('CREATE_COPY_NOTE', $item->call_number->owning_lib);
+
+    $note->create_date('now');
+    $note->creator($e->requestor->id);
+    $note->pub( ($U->is_true($note->pub)) ? 't' : 'f' );
+    $note->clear_id;
+
+    my $method = "create_serial_${type}_note";
+    $e->$method($note) or return $e->event;
+    $e->commit;
+    return $note->id;
+}
+
+__PACKAGE__->register_method(
+    method      => 'delete_note',
+    api_name        =>  'open-ils.serial.item_note.delete',
+    signature   => q/
+        Deletes an existing item note
+        @param authtoken The login session key
+        @param noteid The id of the note to delete
+        @return 1 on success - Event otherwise.
+        /
+);
+
+__PACKAGE__->register_method(
+    method      => 'delete_note',
+    api_name        =>  'open-ils.serial.subscription_note.delete',
+    signature   => q/
+        Deletes an existing subscription note
+        @param authtoken The login session key
+        @param noteid The id of the note to delete
+        @return 1 on success - Event otherwise.
+        /
+);
+
+__PACKAGE__->register_method(
+    method      => 'delete_note',
+    api_name        =>  'open-ils.serial.distribution_note.delete',
+    signature   => q/
+        Deletes an existing distribution note
+        @param authtoken The login session key
+        @param noteid The id of the note to delete
+        @return 1 on success - Event otherwise.
+        /
+);
+
+sub delete_note {
+    my( $self, $conn, $authtoken, $noteid ) = @_;
+
+    $self->api_name =~ /serial\.(\w*)_note/;
+    my $type = $1;
+
+    my $e = new_editor(xact=>1, authtoken=>$authtoken);
+    return $e->die_event unless $e->checkauth;
+
+    my $method = "retrieve_serial_${type}_note";
+    my $note = $e->$method([
+        $noteid,
+    ]) or return $e->die_event;
+
+# FIXME: restore permissions check
+#    if( $note->creator ne $e->requestor->id ) {
+#        return $e->die_event unless
+#            $e->allowed('DELETE_COPY_NOTE', $note->item->call_number->owning_lib);
+#    }
+
+    $method = "delete_serial_${type}_note";
+    $e->$method($note) or return $e->die_event;
+    $e->commit;
+    return 1;
+}
+
+
+##########################################################################
+# subscription methods
+#
+__PACKAGE__->register_method(
+    method    => 'fleshed_ssub_alter',
+    api_name  => 'open-ils.serial.subscription.fleshed.batch.update',
+    api_level => 1,
+    argc      => 2,
+    signature => {
+        desc     => 'Receives an array of one or more subscriptions and updates the database as needed',
+        'params' => [ {
+                 name => 'authtoken',
+                 desc => 'Authtoken for current user session',
+                 type => 'string'
+            },
+            {
+                 name => 'subscriptions',
+                 desc => 'Array of fleshed subscriptions',
+                 type => 'array'
+            }
+
+        ],
+        'return' => {
+            desc => 'Returns 1 if successful, event if failed',
+            type => 'mixed'
+        }
+    }
+);
+
+sub fleshed_ssub_alter {
+    my( $self, $conn, $auth, $ssubs ) = @_;
+    return 1 unless ref $ssubs;
+    my( $reqr, $evt ) = $U->checkses($auth);
+    return $evt if $evt;
+    my $editor = new_editor(requestor => $reqr, xact => 1);
+    my $override = $self->api_name =~ /override/;
+
+# TODO: permission check
+#        return $editor->event unless
+#            $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy));
+
+    for my $ssub (@$ssubs) {
+
+        my $ssubid = $ssub->id;
+
+        if( $ssub->isdeleted ) {
+            $evt = _delete_ssub( $editor, $override, $ssub);
+        } elsif( $ssub->isnew ) {
+            _cleanse_dates($ssub, ['start_date','end_date']);
+            $evt = _create_ssub( $editor, $ssub );
+        } else {
+            _cleanse_dates($ssub, ['start_date','end_date']);
+            $evt = _update_ssub( $editor, $override, $ssub );
+        }
+    }
+
+    if( $evt ) {
+        $logger->info("fleshed subscription-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
+        $editor->rollback;
+        return $evt;
+    }
+    $logger->debug("subscription-alter: done updating subscription batch");
+    $editor->commit;
+    $logger->info("fleshed subscription-alter successfully updated ".scalar(@$ssubs)." subscriptions");
+    return 1;
+}
+
+sub _delete_ssub {
+    my ($editor, $override, $ssub) = @_;
+    $logger->info("subscription-alter: delete subscription ".OpenSRF::Utils::JSON->perl2JSON($ssub));
+    my $sdists = $editor->search_serial_distribution(
+            { subscription => $ssub->id }, { limit => 1 } ); #TODO: 'deleted' support?
+    my $cps = $editor->search_serial_caption_and_pattern(
+            { subscription => $ssub->id }, { limit => 1 } ); #TODO: 'deleted' support?
+    my $sisses = $editor->search_serial_issuance(
+            { subscription => $ssub->id }, { limit => 1 } ); #TODO: 'deleted' support?
+    return OpenILS::Event->new(
+            'SERIAL_SUBSCRIPTION_NOT_EMPTY', payload => $ssub->id ) if (@$sdists or @$cps or @$sisses);
+
+    return $editor->event unless $editor->delete_serial_subscription($ssub);
+    return 0;
+}
+
+sub _create_ssub {
+    my ($editor, $ssub) = @_;
+
+    $logger->info("subscription-alter: new subscription ".OpenSRF::Utils::JSON->perl2JSON($ssub));
+    return $editor->event unless $editor->create_serial_subscription($ssub);
+    return 0;
+}
+
+sub _update_ssub {
+    my ($editor, $override, $ssub) = @_;
+
+    $logger->info("subscription-alter: retrieving subscription ".$ssub->id);
+    my $orig_ssub = $editor->retrieve_serial_subscription($ssub->id);
+
+    $logger->info("subscription-alter: original subscription ".OpenSRF::Utils::JSON->perl2JSON($orig_ssub));
+    $logger->info("subscription-alter: updated subscription ".OpenSRF::Utils::JSON->perl2JSON($ssub));
+    return $editor->event unless $editor->update_serial_subscription($ssub);
+    return 0;
+}
+
+__PACKAGE__->register_method(
+    method  => "fleshed_serial_subscription_retrieve_batch",
+    authoritative => 1,
+    api_name    => "open-ils.serial.subscription.fleshed.batch.retrieve"
+);
+
+sub fleshed_serial_subscription_retrieve_batch {
+    my( $self, $client, $ids ) = @_;
+# FIXME: permissions?
+    $logger->info("Fetching fleshed subscriptions @$ids");
+    return $U->cstorereq(
+        "open-ils.cstore.direct.serial.subscription.search.atomic",
+        { id => $ids },
+        { flesh => 1,
+          flesh_fields => {ssub => [ qw/owning_lib notes/ ]}
+        });
+}
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_sub_tree",
+    authoritative => 1,
+	api_name	=> "open-ils.serial.subscription_tree.retrieve"
+);
+
+__PACKAGE__->register_method(
+	method	=> "retrieve_sub_tree",
+	api_name	=> "open-ils.serial.subscription_tree.global.retrieve"
+);
+
+sub retrieve_sub_tree {
+
+	my( $self, $client, $user_session, $docid, @org_ids ) = @_;
+
+	if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
+
+	$docid = "$docid";
+
+	# TODO: permission support
+	if(!@org_ids and $user_session) {
+		my $user_obj = 
+			OpenILS::Application::AppUtils->check_user_session( $user_session ); #throws EX on error
+			@org_ids = ($user_obj->home_ou);
+	}
+
+	if( $self->api_name =~ /global/ ) {
+		return _build_subs_list( { record_entry => $docid } ); # TODO: filter for !deleted, or active?
+
+	} else {
+
+		my @all_subs;
+		for my $orgid (@org_ids) {
+			my $subs = _build_subs_list( 
+					{ record_entry => $docid, owning_lib => $orgid } );# TODO: filter for !deleted, or active?
+			push( @all_subs, @$subs );
+		}
+		
+		return \@all_subs;
+	}
+
+	return undef;
+}
+
+sub _build_subs_list {
+	my $search_hash = shift;
+
+	#$search_hash->{deleted} = 'f';
+	my $e = new_editor();
+
+	my $subs = $e->search_serial_subscription([$search_hash, { 'order_by' => {'ssub' => 'id'} }]);
+
+	my @built_subs;
+
+	for my $sub (@$subs) {
+
+        # TODO: filter on !deleted?
+		my $dists = $e->search_serial_distribution(
+            [{ subscription => $sub->id }, { 'order_by' => {'sdist' => 'label'} }]
+            );
+
+		#$dists = [ sort { $a->label cmp $b->label } @$dists  ];
+
+		$sub->distributions($dists);
+        
+        # TODO: filter on !deleted?
+		my $issuances = $e->search_serial_issuance(
+			[{ subscription => $sub->id }, { 'order_by' => {'siss' => 'label'} }]
+            );
+
+		#$issuances = [ sort { $a->label cmp $b->label } @$issuances  ];
+		$sub->issuances($issuances);
+
+        # TODO: filter on !deleted?
+		my $scaps = $e->search_serial_caption_and_pattern(
+			[{ subscription => $sub->id }, { 'order_by' => {'scap' => 'id'} }]
+            );
+
+		#$scaps = [ sort { $a->id cmp $b->id } @$scaps  ];
+		$sub->scaps($scaps);
+		push( @built_subs, $sub );
+	}
+
+	return \@built_subs;
+
+}
+
+__PACKAGE__->register_method(
+    method  => "subscription_orgs_for_title",
+    authoritative => 1,
+    api_name    => "open-ils.serial.subscription.retrieve_orgs_by_title"
+);
+
+sub subscription_orgs_for_title {
+    my( $self, $client, $record_id ) = @_;
+
+    my $subs = $U->simple_scalar_request(
+        "open-ils.cstore",
+        "open-ils.cstore.direct.serial.subscription.search.atomic",
+        { record_entry => $record_id }); # TODO: filter on !deleted?
+
+    my $orgs = { map {$_->owning_lib => 1 } @$subs };
+    return [ keys %$orgs ];
+}
+
+
+##########################################################################
+# distribution methods
+#
+__PACKAGE__->register_method(
+    method    => 'fleshed_sdist_alter',
+    api_name  => 'open-ils.serial.distribution.fleshed.batch.update',
+    api_level => 1,
+    argc      => 2,
+    signature => {
+        desc     => 'Receives an array of one or more distributions and updates the database as needed',
+        'params' => [ {
+                 name => 'authtoken',
+                 desc => 'Authtoken for current user session',
+                 type => 'string'
+            },
+            {
+                 name => 'distributions',
+                 desc => 'Array of fleshed distributions',
+                 type => 'array'
+            }
+
+        ],
+        'return' => {
+            desc => 'Returns 1 if successful, event if failed',
+            type => 'mixed'
+        }
+    }
+);
+
+sub fleshed_sdist_alter {
+    my( $self, $conn, $auth, $sdists ) = @_;
+    return 1 unless ref $sdists;
+    my( $reqr, $evt ) = $U->checkses($auth);
+    return $evt if $evt;
+    my $editor = new_editor(requestor => $reqr, xact => 1);
+    my $override = $self->api_name =~ /override/;
+
+# TODO: permission check
+#        return $editor->event unless
+#            $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy));
+
+    for my $sdist (@$sdists) {
+        my $sdistid = $sdist->id;
+
+        if( $sdist->isdeleted ) {
+            $evt = _delete_sdist( $editor, $override, $sdist);
+        } elsif( $sdist->isnew ) {
+            $evt = _create_sdist( $editor, $sdist );
+        } else {
+            $evt = _update_sdist( $editor, $override, $sdist );
+        }
+    }
+
+    if( $evt ) {
+        $logger->info("fleshed distribution-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
+        $editor->rollback;
+        return $evt;
+    }
+    $logger->debug("distribution-alter: done updating distribution batch");
+    $editor->commit;
+    $logger->info("fleshed distribution-alter successfully updated ".scalar(@$sdists)." distributions");
+    return 1;
+}
+
+sub _delete_sdist {
+    my ($editor, $override, $sdist) = @_;
+    $logger->info("distribution-alter: delete distribution ".OpenSRF::Utils::JSON->perl2JSON($sdist));
+    return $editor->event unless $editor->delete_serial_distribution($sdist);
+    return 0;
+}
+
+sub _create_sdist {
+    my ($editor, $sdist) = @_;
+
+    $logger->info("distribution-alter: new distribution ".OpenSRF::Utils::JSON->perl2JSON($sdist));
+    return $editor->event unless $editor->create_serial_distribution($sdist);
+
+    # create summaries too
+    my $summary = new Fieldmapper::serial::basic_summary;
+    $summary->distribution($sdist->id);
+    $summary->generated_coverage('');
+    return $editor->event unless $editor->create_serial_basic_summary($summary);
+    $summary = new Fieldmapper::serial::supplement_summary;
+    $summary->distribution($sdist->id);
+    $summary->generated_coverage('');
+    return $editor->event unless $editor->create_serial_supplement_summary($summary);
+    $summary = new Fieldmapper::serial::index_summary;
+    $summary->distribution($sdist->id);
+    $summary->generated_coverage('');
+    return $editor->event unless $editor->create_serial_index_summary($summary);
+
+    # create a starter stream (TODO: reconsider this)
+    my $stream = new Fieldmapper::serial::stream;
+    $stream->distribution($sdist->id);
+    return $editor->event unless $editor->create_serial_stream($stream);
+
+    return 0;
+}
+
+sub _update_sdist {
+    my ($editor, $override, $sdist) = @_;
+
+    $logger->info("distribution-alter: retrieving distribution ".$sdist->id);
+    my $orig_sdist = $editor->retrieve_serial_distribution($sdist->id);
+
+    $logger->info("distribution-alter: original distribution ".OpenSRF::Utils::JSON->perl2JSON($orig_sdist));
+    $logger->info("distribution-alter: updated distribution ".OpenSRF::Utils::JSON->perl2JSON($sdist));
+    return $editor->event unless $editor->update_serial_distribution($sdist);
+    return 0;
+}
+
+__PACKAGE__->register_method(
+    method  => "fleshed_serial_distribution_retrieve_batch",
+    authoritative => 1,
+    api_name    => "open-ils.serial.distribution.fleshed.batch.retrieve"
+);
+
+sub fleshed_serial_distribution_retrieve_batch {
+    my( $self, $client, $ids ) = @_;
+# FIXME: permissions?
+    $logger->info("Fetching fleshed distributions @$ids");
+    return $U->cstorereq(
+        "open-ils.cstore.direct.serial.distribution.search.atomic",
+        { id => $ids },
+        { flesh => 1,
+          flesh_fields => {sdist => [ qw/ holding_lib receive_call_number receive_unit_template bind_call_number bind_unit_template streams / ]}
+        });
+}
+
+__PACKAGE__->register_method(
+    method  => "retrieve_dist_tree",
+    authoritative => 1,
+    api_name    => "open-ils.serial.distribution_tree.retrieve"
+);
+
+__PACKAGE__->register_method(
+    method  => "retrieve_dist_tree",
+    api_name    => "open-ils.serial.distribution_tree.global.retrieve"
+);
+
+sub retrieve_dist_tree {
+    my( $self, $client, $user_session, $docid, @org_ids ) = @_;
+
+    if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
+
+    $docid = "$docid";
+
+    # TODO: permission support
+    if(!@org_ids and $user_session) {
+        my $user_obj =
+            OpenILS::Application::AppUtils->check_user_session( $user_session ); #throws EX on error
+            @org_ids = ($user_obj->home_ou);
+    }
+
+    my $e = new_editor();
+
+    if( $self->api_name =~ /global/ ) {
+        return $e->search_serial_distribution([{'+ssub' => { record_entry => $docid }},
+            {   flesh => 1,
+                flesh_fields => {sdist => [ qw/ holding_lib receive_call_number receive_unit_template bind_call_number bind_unit_template streams basic_summary supplement_summary index_summary / ]},
+                order_by => {'sdist' => 'id'},
+                'join' => {'ssub' => {}}
+            }
+        ]); # TODO: filter for !deleted?
+
+    } else {
+        my @all_dists;
+        for my $orgid (@org_ids) {
+            my $dists = $e->search_serial_distribution([{'+ssub' => { record_entry => $docid }, holding_lib => $orgid},
+                {   flesh => 1,
+                    flesh_fields => {sdist => [ qw/ holding_lib receive_call_number receive_unit_template bind_call_number bind_unit_template streams basic_summary supplement_summary index_summary / ]},
+                    order_by => {'sdist' => 'id'},
+                    'join' => {'ssub' => {}}
+                }
+            ]); # TODO: filter for !deleted?
+            push( @all_dists, @$dists ) if $dists;
+        }
+
+        return \@all_dists;
+    }
+
+    return undef;
+}
+
+
+__PACKAGE__->register_method(
+    method  => "distribution_orgs_for_title",
+    authoritative => 1,
+    api_name    => "open-ils.serial.distribution.retrieve_orgs_by_title"
+);
+
+sub distribution_orgs_for_title {
+    my( $self, $client, $record_id ) = @_;
+
+    my $dists = $U->cstorereq(
+        "open-ils.cstore.direct.serial.distribution.search.atomic",
+        { '+ssub' => { record_entry => $record_id } },
+        { 'join' => {'ssub' => {}} }); # TODO: filter on !deleted?
+
+    my $orgs = { map {$_->holding_lib => 1 } @$dists };
+    return [ keys %$orgs ];
+}
+
+
+##########################################################################
+# caption and pattern methods
+#
+__PACKAGE__->register_method(
+    method    => 'scap_alter',
+    api_name  => 'open-ils.serial.caption_and_pattern.batch.update',
+    api_level => 1,
+    argc      => 2,
+    signature => {
+        desc     => 'Receives an array of one or more caption and patterns and updates the database as needed',
+        'params' => [ {
+                 name => 'authtoken',
+                 desc => 'Authtoken for current user session',
+                 type => 'string'
+            },
+            {
+                 name => 'scaps',
+                 desc => 'Array of caption and patterns',
+                 type => 'array'
+            }
+
+        ],
+        'return' => {
+            desc => 'Returns 1 if successful, event if failed',
+            type => 'mixed'
+        }
+    }
+);
+
+sub scap_alter {
+    my( $self, $conn, $auth, $scaps ) = @_;
+    return 1 unless ref $scaps;
+    my( $reqr, $evt ) = $U->checkses($auth);
+    return $evt if $evt;
+    my $editor = new_editor(requestor => $reqr, xact => 1);
+    my $override = $self->api_name =~ /override/;
+
+# TODO: permission check
+#        return $editor->event unless
+#            $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy));
+
+    for my $scap (@$scaps) {
+        my $scapid = $scap->id;
+
+        if( $scap->isdeleted ) {
+            $evt = _delete_scap( $editor, $override, $scap);
+        } elsif( $scap->isnew ) {
+            $evt = _create_scap( $editor, $scap );
+        } else {
+            $evt = _update_scap( $editor, $override, $scap );
+        }
+    }
+
+    if( $evt ) {
+        $logger->info("caption_and_pattern-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
+        $editor->rollback;
+        return $evt;
+    }
+    $logger->debug("caption_and_pattern-alter: done updating caption_and_pattern batch");
+    $editor->commit;
+    $logger->info("caption_and_pattern-alter successfully updated ".scalar(@$scaps)." caption_and_patterns");
+    return 1;
+}
+
+sub _delete_scap {
+    my ($editor, $override, $scap) = @_;
+    $logger->info("caption_and_pattern-alter: delete caption_and_pattern ".OpenSRF::Utils::JSON->perl2JSON($scap));
+    my $sisses = $editor->search_serial_issuance(
+            { caption_and_pattern => $scap->id }, { limit => 1 } ); #TODO: 'deleted' support?
+    return OpenILS::Event->new(
+            'SERIAL_CAPTION_AND_PATTERN_HAS_ISSUANCES', payload => $scap->id ) if (@$sisses);
+
+    return $editor->event unless $editor->delete_serial_caption_and_pattern($scap);
+    return 0;
+}
+
+sub _create_scap {
+    my ($editor, $scap) = @_;
+
+    $logger->info("caption_and_pattern-alter: new caption_and_pattern ".OpenSRF::Utils::JSON->perl2JSON($scap));
+    return $editor->event unless $editor->create_serial_caption_and_pattern($scap);
+    return 0;
+}
+
+sub _update_scap {
+    my ($editor, $override, $scap) = @_;
+
+    $logger->info("caption_and_pattern-alter: retrieving caption_and_pattern ".$scap->id);
+    my $orig_scap = $editor->retrieve_serial_caption_and_pattern($scap->id);
+
+    $logger->info("caption_and_pattern-alter: original caption_and_pattern ".OpenSRF::Utils::JSON->perl2JSON($orig_scap));
+    $logger->info("caption_and_pattern-alter: updated caption_and_pattern ".OpenSRF::Utils::JSON->perl2JSON($scap));
+    return $editor->event unless $editor->update_serial_caption_and_pattern($scap);
+    return 0;
+}
+
+__PACKAGE__->register_method(
+    method  => "serial_caption_and_pattern_retrieve_batch",
+    authoritative => 1,
+    api_name    => "open-ils.serial.caption_and_pattern.batch.retrieve"
+);
+
+sub serial_caption_and_pattern_retrieve_batch {
+    my( $self, $client, $ids ) = @_;
+    $logger->info("Fetching caption_and_patterns @$ids");
+    return $U->cstorereq(
+        "open-ils.cstore.direct.serial.caption_and_pattern.search.atomic",
+        { id => $ids }
+    );
+}
+
+##########################################################################
+# stream methods
+#
+__PACKAGE__->register_method(
+    method    => 'sstr_alter',
+    api_name  => 'open-ils.serial.stream.batch.update',
+    api_level => 1,
+    argc      => 2,
+    signature => {
+        desc     => 'Receives an array of one or more streams and updates the database as needed',
+        'params' => [ {
+                 name => 'authtoken',
+                 desc => 'Authtoken for current user session',
+                 type => 'string'
+            },
+            {
+                 name => 'sstrs',
+                 desc => 'Array of streams',
+                 type => 'array'
+            }
+
+        ],
+        'return' => {
+            desc => 'Returns 1 if successful, event if failed',
+            type => 'mixed'
+        }
+    }
+);
+
+sub sstr_alter {
+    my( $self, $conn, $auth, $sstrs ) = @_;
+    return 1 unless ref $sstrs;
+    my( $reqr, $evt ) = $U->checkses($auth);
+    return $evt if $evt;
+    my $editor = new_editor(requestor => $reqr, xact => 1);
+    my $override = $self->api_name =~ /override/;
+
+# TODO: permission check
+#        return $editor->event unless
+#            $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy));
+
+    for my $sstr (@$sstrs) {
+        my $sstrid = $sstr->id;
+
+        if( $sstr->isdeleted ) {
+            $evt = _delete_sstr( $editor, $override, $sstr);
+        } elsif( $sstr->isnew ) {
+            $evt = _create_sstr( $editor, $sstr );
+        } else {
+            $evt = _update_sstr( $editor, $override, $sstr );
+        }
+    }
+
+    if( $evt ) {
+        $logger->info("stream-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
+        $editor->rollback;
+        return $evt;
+    }
+    $logger->debug("stream-alter: done updating stream batch");
+    $editor->commit;
+    $logger->info("stream-alter successfully updated ".scalar(@$sstrs)." streams");
+    return 1;
+}
+
+sub _delete_sstr {
+    my ($editor, $override, $sstr) = @_;
+    $logger->info("stream-alter: delete stream ".OpenSRF::Utils::JSON->perl2JSON($sstr));
+    my $sitems = $editor->search_serial_item(
+            { stream => $sstr->id }, { limit => 1 } ); #TODO: 'deleted' support?
+    return OpenILS::Event->new(
+            'SERIAL_STREAM_HAS_ITEMS', payload => $sstr->id ) if (@$sitems);
+
+    return $editor->event unless $editor->delete_serial_stream($sstr);
+    return 0;
+}
+
+sub _create_sstr {
+    my ($editor, $sstr) = @_;
+
+    $logger->info("stream-alter: new stream ".OpenSRF::Utils::JSON->perl2JSON($sstr));
+    return $editor->event unless $editor->create_serial_stream($sstr);
+    return 0;
+}
+
+sub _update_sstr {
+    my ($editor, $override, $sstr) = @_;
+
+    $logger->info("stream-alter: retrieving stream ".$sstr->id);
+    my $orig_sstr = $editor->retrieve_serial_stream($sstr->id);
+
+    $logger->info("stream-alter: original stream ".OpenSRF::Utils::JSON->perl2JSON($orig_sstr));
+    $logger->info("stream-alter: updated stream ".OpenSRF::Utils::JSON->perl2JSON($sstr));
+    return $editor->event unless $editor->update_serial_stream($sstr);
+    return 0;
+}
+
+__PACKAGE__->register_method(
+    method  => "serial_stream_retrieve_batch",
+    authoritative => 1,
+    api_name    => "open-ils.serial.stream.batch.retrieve"
+);
+
+sub serial_stream_retrieve_batch {
+    my( $self, $client, $ids ) = @_;
+    $logger->info("Fetching streams @$ids");
+    return $U->cstorereq(
+        "open-ils.cstore.direct.serial.stream.search.atomic",
+        { id => $ids }
+    );
+}
+
+
+##########################################################################
+# summary methods
+#
+__PACKAGE__->register_method(
+    method    => 'sum_alter',
+    api_name  => 'open-ils.serial.basic_summary.batch.update',
+    api_level => 1,
+    argc      => 2,
+    signature => {
+        desc     => 'Receives an array of one or more summaries and updates the database as needed',
+        'params' => [ {
+                 name => 'authtoken',
+                 desc => 'Authtoken for current user session',
+                 type => 'string'
+            },
+            {
+                 name => 'sbsums',
+                 desc => 'Array of basic summaries',
+                 type => 'array'
+            }
+
+        ],
+        'return' => {
+            desc => 'Returns 1 if successful, event if failed',
+            type => 'mixed'
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => 'sum_alter',
+    api_name  => 'open-ils.serial.supplement_summary.batch.update',
+    api_level => 1,
+    argc      => 2,
+    signature => {
+        desc     => 'Receives an array of one or more summaries and updates the database as needed',
+        'params' => [ {
+                 name => 'authtoken',
+                 desc => 'Authtoken for current user session',
+                 type => 'string'
+            },
+            {
+                 name => 'sbsums',
+                 desc => 'Array of supplement summaries',
+                 type => 'array'
+            }
+
+        ],
+        'return' => {
+            desc => 'Returns 1 if successful, event if failed',
+            type => 'mixed'
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    method    => 'sum_alter',
+    api_name  => 'open-ils.serial.index_summary.batch.update',
+    api_level => 1,
+    argc      => 2,
+    signature => {
+        desc     => 'Receives an array of one or more summaries and updates the database as needed',
+        'params' => [ {
+                 name => 'authtoken',
+                 desc => 'Authtoken for current user session',
+                 type => 'string'
+            },
+            {
+                 name => 'sbsums',
+                 desc => 'Array of index summaries',
+                 type => 'array'
+            }
+
+        ],
+        'return' => {
+            desc => 'Returns 1 if successful, event if failed',
+            type => 'mixed'
+        }
+    }
+);
+
+sub sum_alter {
+    my( $self, $conn, $auth, $sums ) = @_;
+    return 1 unless ref $sums;
+
+    $self->api_name =~ /serial\.(\w*)_summary/;
+    my $type = $1;
+
+    my( $reqr, $evt ) = $U->checkses($auth);
+    return $evt if $evt;
+    my $editor = new_editor(requestor => $reqr, xact => 1);
+    my $override = $self->api_name =~ /override/;
+
+# TODO: permission check
+#        return $editor->event unless
+#            $editor->allowed('UPDATE_COPY', $class->copy_perm_org($vol, $copy));
+
+    for my $sum (@$sums) {
+        my $sumid = $sum->id;
+
+        # XXX: (for now, at least) summaries should be created/deleted by the distribution functions
+        if( $sum->isdeleted ) {
+            $evt = OpenILS::Event->new('SERIAL_SUMMARIES_NOT_INDEPENDENT');
+        } elsif( $sum->isnew ) {
+            $evt = OpenILS::Event->new('SERIAL_SUMMARIES_NOT_INDEPENDENT');
+        } else {
+            $evt = _update_sum( $editor, $override, $sum, $type );
+        }
+    }
+
+    if( $evt ) {
+        $logger->info("${type}_summary-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
+        $editor->rollback;
+        return $evt;
+    }
+    $logger->debug("${type}_summary-alter: done updating ${type}_summary batch");
+    $editor->commit;
+    $logger->info("${type}_summary-alter successfully updated ".scalar(@$sums)." ${type}_summaries");
+    return 1;
+}
+
+sub _update_sum {
+    my ($editor, $override, $sum, $type) = @_;
+
+    $logger->info("${type}_summary-alter: retrieving ${type}_summary ".$sum->id);
+    my $retrieve_method = "retrieve_serial_${type}_summary";
+    my $orig_sum = $editor->$retrieve_method($sum->id);
+
+    $logger->info("${type}_summary-alter: original ${type}_summary ".OpenSRF::Utils::JSON->perl2JSON($orig_sum));
+    $logger->info("${type}_summary-alter: updated ${type}_summary ".OpenSRF::Utils::JSON->perl2JSON($sum));
+    my $update_method = "update_serial_${type}_summary";
+    return $editor->event unless $editor->$update_method($sum);
+    return 0;
+}
+
+__PACKAGE__->register_method(
+    method  => "serial_summary_retrieve_batch",
+    authoritative => 1,
+    api_name    => "open-ils.serial.basic_summary.batch.retrieve"
+);
+
+__PACKAGE__->register_method(
+    method  => "serial_summary_retrieve_batch",
+    authoritative => 1,
+    api_name    => "open-ils.serial.supplement_summary.batch.retrieve"
+);
+
+__PACKAGE__->register_method(
+    method  => "serial_summary_retrieve_batch",
+    authoritative => 1,
+    api_name    => "open-ils.serial.index_summary.batch.retrieve"
+);
+
+sub serial_summary_retrieve_batch {
+    my( $self, $client, $ids ) = @_;
+
+    $self->api_name =~ /serial\.(\w*)_summary/;
+    my $type = $1;
+
+    $logger->info("Fetching ${type}_summaries @$ids");
+    return $U->cstorereq(
+        "open-ils.cstore.direct.serial.".$type."_summary.search.atomic",
+        { id => $ids }
+    );
+}
+
+
+##########################################################################
+# other methods
+#
+__PACKAGE__->register_method(
+    "method" => "bre_by_identifier",
+    "api_name" => "open-ils.serial.biblio.record_entry.by_identifier",
+    "stream" => 1,
+    "signature" => {
+        "desc" => "Find instances of biblio.record_entry given a search token" .
+            " that could be a value for any identifier defined in " .
+            "config.metabib_field",
+        "params" => [
+            {"desc" => "Search token", "type" => "string"},
+            {"desc" => "Options: require_subscriptions, add_mvr, is_actual_id" .
+                ", id_list (all boolean)", "type" => "object"}
+        ],
+        "return" => {
+            "desc" => "Any matching BREs, or if the add_mvr option is true, " .
+                "objects with a 'bre' key/value pair, and an 'mvr' " .
+                "key-value pair.  BREs have subscriptions fleshed on.",
+            "type" => "object"
+        }
+    }
+);
+
+sub bre_by_identifier {
+    my ($self, $client, $term, $options) = @_;
+
+    return new OpenILS::Event("BAD_PARAMS") unless $term;
+
+    $options ||= {};
+    my $e = new_editor();
+
+    my @ids;
+
+    if ($options->{"is_actual_id"}) {
+        @ids = ($term);
+    } else {
+        my $cmf =
+            $e->search_config_metabib_field({"field_class" => "identifier"})
+                or return $e->die_event;
+
+        my @identifiers = map { $_->name } @$cmf;
+        my $query = join(" || ", map { "id|$_: $term" } @identifiers);
+
+        my $search = create OpenSRF::AppSession("open-ils.search");
+        my $search_result = $search->request(
+            "open-ils.search.biblio.multiclass.query.staff", {}, $query
+        )->gather(1);
+        $search->disconnect;
+
+        # Un-nest results. They tend to look like [[1],[2],[3]] for some reason.
+        @ids = map { @{$_} } @{$search_result->{"ids"}};
+
+        unless (@ids) {
+            $e->disconnect;
+            return undef;
+        }
+
+        if ($options->{"id_list"}) {
+            $e->disconnect;
+            $client->respond($_) foreach (@ids);
+            return undef;
+        }
+    }
+
+    my $bre = $e->search_biblio_record_entry([
+        {"id" => \@ids}, {
+            "flesh" => 2, "flesh_fields" => {
+                "bre" => ["subscriptions"],
+                "ssub" => ["owning_lib"]
+            }
+        }
+    ]) or return $e->die_event;
+
+    if (@$bre && $options->{"require_subscriptions"}) {
+        $bre = [ grep { @{$_->subscriptions} } @$bre ];
+    }
+
+    $e->disconnect;
+
+    if (@$bre) { # re-evaluate after possible grep
+        if ($options->{"add_mvr"}) {
+            $client->respond(
+                {"bre" => $_, "mvr" => _get_mvr($_->id)}
+            ) foreach (@$bre);
+        } else {
+            $client->respond($_) foreach (@$bre);
+        }
+    }
+
+    undef;
+}
+
+__PACKAGE__->register_method(
+    "method" => "get_items_by",
+    "api_name" => "open-ils.serial.items.receivable.by_subscription",
+    "stream" => 1,
+    "signature" => {
+        "desc" => "Return all receivable items under a given subscription",
+        "params" => [
+            {"desc" => "Authtoken", "type" => "string"},
+            {"desc" => "Subscription ID", "type" => "number"},
+        ],
+        "return" => {
+            "desc" => "All receivable items under a given subscription",
+            "type" => "object", "class" => "sitem"
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    "method" => "get_items_by",
+    "api_name" => "open-ils.serial.items.receivable.by_issuance",
+    "stream" => 1,
+    "signature" => {
+        "desc" => "Return all receivable items under a given issuance",
+        "params" => [
+            {"desc" => "Authtoken", "type" => "string"},
+            {"desc" => "Issuance ID", "type" => "number"},
+        ],
+        "return" => {
+            "desc" => "All receivable items under a given issuance",
+            "type" => "object", "class" => "sitem"
+        }
+    }
+);
+
+__PACKAGE__->register_method(
+    "method" => "get_items_by",
+    "api_name" => "open-ils.serial.items.by_issuance",
+    "stream" => 1,
+    "signature" => {
+        "desc" => "Return all items under a given issuance",
+        "params" => [
+            {"desc" => "Authtoken", "type" => "string"},
+            {"desc" => "Issuance ID", "type" => "number"},
+        ],
+        "return" => {
+            "desc" => "All items under a given issuance",
+            "type" => "object", "class" => "sitem"
+        }
+    }
+);
+
+sub get_items_by {
+    my ($self, $client, $auth, $term, $opts)  = @_;
+
+    # Not to be used in the json_query, but after limiting by perm check.
+    $opts = {} unless ref $opts eq "HASH";
+    $opts->{"limit"} ||= 10000;    # some existing users may want all results
+    $opts->{"offset"} ||= 0;
+    $opts->{"limit"} = int($opts->{"limit"});
+    $opts->{"offset"} = int($opts->{"offset"});
+
+    my $e = new_editor("authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $by = ($self->api_name =~ /by_(\w+)$/)[0];
+    my $receivable = ($self->api_name =~ /receivable/);
+
+    my %where = (
+        "issuance" => {"issuance" => $term},
+        "subscription" => {"+siss" => {"subscription" => $term}}
+    );
+
+    my $item_rows = $e->json_query(
+        {
+            "select" => {"sitem" => ["id"], "sdist" => ["holding_lib"]},
+            "from" => {
+                "sitem" => {
+                    "siss" => {},
+                    "sstr" => {"join" => {"sdist" => {}}}
+                }
+            },
+            "where" => {
+                %{$where{$by}}, $receivable ? ("date_received" => undef) : ()
+            },
+            "order_by" => {"sitem" => ["id"]}
+        }
+    ) or return $e->die_event;
+
+    return undef unless @$item_rows;
+
+    my $skipped = 0;
+    my $returned = 0;
+    foreach (@$item_rows) {
+        last if $returned >= $opts->{"limit"};
+        next unless $e->allowed("RECEIVE_SERIAL", $_->{"holding_lib"});
+        if ($skipped < $opts->{"offset"}) {
+            $skipped++;
+            next;
+        }
+
+        $client->respond(
+            $e->retrieve_serial_item([
+                $_->{"id"}, {
+                    "flesh" => 3,
+                    "flesh_fields" => {
+                        "sitem" => [qw/stream issuance unit creator editor/],
+                        "sstr" => ["distribution"],
+                        "sdist" => ["holding_lib"]
+                    }
+                }
+            ])
+        );
+        $returned++;
+    }
+
+    $e->disconnect;
+    undef;
+}
+
+__PACKAGE__->register_method(
+    "method" => "get_receivable_issuances",
+    "api_name" => "open-ils.serial.issuances.receivable",
+    "stream" => 1,
+    "signature" => {
+        "desc" => "Return all issuances with receivable items given " .
+            "a subscription ID",
+        "params" => [
+            {"desc" => "Authtoken", "type" => "string"},
+            {"desc" => "Subscription ID", "type" => "number"},
+        ],
+        "return" => {
+            "desc" => "All issuances with receivable items " .
+                "(but not the items themselves)", "type" => "object"
+        }
+    }
+);
+
+sub get_receivable_issuances {
+    my ($self, $client, $auth, $sub_id) = @_;
+
+    my $e = new_editor("authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    # XXX permissions
+
+    my $issuance_ids = $e->json_query({
+        "select" => {
+            "siss" => [
+                {"transform" => "distinct", "column" => "id"},
+                "date_published"
+            ]
+        },
+        "from" => {"siss" => "sitem"},
+        "where" => {
+            "subscription" => $sub_id,
+            "+sitem" => {"date_received" => undef}
+        },
+        "order_by" => {
+            "siss" => {"date_published" => {"direction" => "asc"}}
+        }
+
+    }) or return $e->die_event;
+
+    $client->respond($e->retrieve_serial_issuance($_->{"id"}))
+        foreach (@$issuance_ids);
+
+    $e->disconnect;
+    undef;
+}
+
+
+__PACKAGE__->register_method(
+    "method" => "get_routing_list_users",
+    "api_name" => "open-ils.serial.routing_list_users.fleshed_and_ordered",
+    "stream" => 1,
+    "signature" => {
+        "desc" => "Return all routing list users with reader fleshed " .
+            "(with card and home_ou) for a given stream ID, sorted by pos",
+        "params" => [
+            {"desc" => "Authtoken", "type" => "string"},
+            {"desc" => "Stream ID (int or array of ints)", "type" => "mixed"},
+        ],
+        "return" => {
+            "desc" => "Stream of routing list users", "type" => "object",
+                "class" => "srlu"
+        }
+    }
+);
+
+sub get_routing_list_users {
+    my ($self, $client, $auth, $stream_id) = @_;
+
+    my $e = new_editor("authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $users = $e->search_serial_routing_list_user([
+        {"stream" => $stream_id}, {
+            "order_by" => {"srlu" => "pos"},
+            "flesh" => 2,
+            "flesh_fields" => {
+                "srlu" => [qw/reader stream/],
+                "au" => [qw/card home_ou/],
+                "sstr" => ["distribution"]
+            }
+        }
+    ]) or return $e->die_event;
+
+    return undef unless @$users;
+
+    # The ADMIN_SERIAL_STREAM permission is used simply to avoid the
+    # need for any new permission.  The context OU will be the same
+    # for every result of the above query, so we need only check once.
+    return $e->die_event unless $e->allowed(
+        "ADMIN_SERIAL_STREAM", $users->[0]->stream->distribution->holding_lib
+    );
+
+    $e->disconnect;
+
+    my @users = map { $_->stream($_->stream->id); $_ } @$users;
+    @users = sort { $a->stream cmp $b->stream } @users if
+        ref $stream_id eq "ARRAY";
+
+    $client->respond($_) for @users;
+
+    undef;
+}
+
+
+__PACKAGE__->register_method(
+    "method" => "replace_routing_list_users",
+    "api_name" => "open-ils.serial.routing_list_users.replace",
+    "signature" => {
+        "desc" => "Replace all routing list users on the specified streams " .
+            "with those in the list argument",
+        "params" => [
+            {"desc" => "Authtoken", "type" => "string"},
+            {"desc" => "List of srlu objects", "type" => "array"},
+        ],
+        "return" => {
+            "desc" => "event on failure, undef on success"
+        }
+    }
+);
+
+sub replace_routing_list_users {
+    my ($self, $client, $auth, $users) = @_;
+
+    return undef unless ref $users eq "ARRAY";
+
+    if (grep { ref $_ ne "Fieldmapper::serial::routing_list_user" } @$users) {
+        return new OpenILS::Event("BAD_PARAMS", "note" => "Only srlu objects");
+    }
+
+    my $e = new_editor("authtoken" => $auth, "xact" => 1);
+    return $e->die_event unless $e->checkauth;
+
+    my %streams_ok = ();
+    my $pos = 0;
+
+    foreach my $user (@$users) {
+        unless (exists $streams_ok{$user->stream}) {
+            my $stream = $e->retrieve_serial_stream([
+                $user->stream, {
+                    "flesh" => 1,
+                    "flesh_fields" => {"sstr" => ["distribution"]}
+                }
+            ]) or return $e->die_event;
+            $e->allowed(
+                "ADMIN_SERIAL_STREAM", $stream->distribution->holding_lib
+            ) or return $e->die_event;
+
+            my $to_delete = $e->search_serial_routing_list_user(
+                {"stream" => $user->stream}
+            ) or return $e->die_event;
+
+            $logger->info(
+                "Deleting srlu: [" .
+                join(", ", map { $_->id; } @$to_delete) .
+                "]"
+            );
+
+            foreach (@$to_delete) {
+                $e->delete_serial_routing_list_user($_) or
+                    return $e->die_event;
+            }
+
+            $streams_ok{$user->stream} = 1;
+        }
+
+        next if $user->isdeleted;
+
+        $user->clear_id;
+        $user->pos($pos++);
+        $e->create_serial_routing_list_user($user) or return $e->die_event;
+    }
+
+    $e->commit or return $e->die_event;
+    undef;
+}
+
+__PACKAGE__->register_method(
+    "method" => "get_records_with_marc_85x",
+    "api_name"=>"open-ils.serial.caption_and_pattern.find_legacy_by_bib_record",
+    "stream" => 1,
+    "signature" => {
+        "desc" => "Return the specified BRE itself and/or any related SRE ".
+            "whenever they have 853-855 tags",
+        "params" => [
+            {"desc" => "Authtoken", "type" => "string"},
+            {"desc" => "bib record ID", "type" => "number"},
+        ],
+        "return" => {
+            "desc" => "objects, either bre or sre", "type" => "object"
+        }
+    }
+);
+
+sub get_records_with_marc_85x { # specifically, 853-855
+    my ($self, $client, $auth, $bre_id) = @_;
+
+    my $e = new_editor("authtoken" => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $bre = $e->search_biblio_record_entry([
+        {"id" => $bre_id, "deleted" => "f"}, {
+            "flesh" => 1,
+            "flesh_fields" => {"bre" => [qw/creator editor owner/]}
+        }
+    ]) or return $e->die_event;
+
+    return undef unless @$bre;
+    $bre = $bre->[0];
+
+    my $record = MARC::Record->new_from_xml($bre->marc);
+    $client->respond($bre) if $record->field("85[3-5]");
+    # XXX Is passing a regex to ->field() an abuse of MARC::Record ?
+
+    my $sres = $e->search_serial_record_entry([
+        {"record" => $bre_id, "deleted" => "f"}, {
+            "flesh" => 1,
+            "flesh_fields" => {"sre" => [qw/creator editor owning_lib/]}
+        }
+    ]) or return $e->die_event;
+
+    $e->disconnect;
+
+    foreach my $sre (@$sres) {
+        $client->respond($sre) if
+            MARC::Record->new_from_xml($sre->marc)->field("85[3-5]");
+    }
+
+    undef;
+}
+
+__PACKAGE__->register_method(
+    "method" => "create_scaps_from_marcxml",
+    "api_name" => "open-ils.serial.caption_and_pattern.create_from_records",
+    "stream" => 1,
+    "signature" => {
+        "desc" => "Create caption and pattern objects from 853-855 tags " .
+            "in MARCXML documents",
+        "params" => [
+            {"desc" => "Authtoken", "type" => "string"},
+            {"desc" => "Subscription ID", "type" => "number"},
+            {"desc" => "list of MARCXML documents as strings",
+                "type" => "array"},
+        ],
+        "return" => {
+            "desc" => "Newly created caption and pattern objects",
+            "type" => "object", "class" => "scap"
+        }
+    }
+);
+
+sub create_scaps_from_marcxml {
+    my ($self, $client, $auth, $sub_id, $docs) = @_;
+
+    return undef unless ref $docs eq "ARRAY";
+
+    my $e = new_editor("authtoken" => $auth, "xact" => 1);
+    return $e->die_event unless $e->checkauth;
+
+    # Retrieve the subscription just for perm checking (whether we can create
+    # scaps at the owning lib).
+    my $sub = $e->retrieve_serial_subscription($sub_id) or return $e->die_event;
+    return $e->die_event unless
+        $e->allowed("ADMIN_SERIAL_CAPTION_PATTERN", $sub->owning_lib);
+
+    foreach my $record (map { MARC::Record->new_from_xml($_) } @$docs) {
+        foreach my $field ($record->field("85[3-5]")) {
+            my $scap = new Fieldmapper::serial::caption_and_pattern;
+            $scap->subscription($sub_id);
+            $scap->type($MFHD_NAMES_BY_TAG{$field->tag});
+            $scap->pattern_code(
+                OpenSRF::Utils::JSON->perl2JSON(
+                    [ $field->indicator(1), $field->indicator(2),
+                        map { @$_ } $field->subfields ] # flattens nested array
+                )
+            );
+            $e->create_serial_caption_and_pattern($scap) or
+                return $e->die_event;
+            $client->respond($e->data);
+        }
+    }
+
+    $e->commit or return $e->die_event;
+    undef;
+}
+
+# All these _clone_foo() functions could possibly have been consolidated into
+# one clever function, but it's faster to get things working this way.
+sub _clone_subscription {
+    my ($sub, $bib_id, $e) = @_;
+
+    # clone sub itself
+    my $new_sub = $sub->clone;
+    $new_sub->record_entry(int $bib_id) if $bib_id;
+    $new_sub->clear_id;
+    $new_sub->clear_distributions;
+    $new_sub->clear_notes;
+    $new_sub->clear_scaps;
+
+    $e->create_serial_subscription($new_sub) or return $e->die_event;
+
+    my $new_sub_id = $e->data->id;
+    # clone dists
+    foreach my $dist (@{$sub->distributions}) {
+        my $r = _clone_distribution($dist, $new_sub_id, $e);
+        return $r if $U->event_code($r);
+    }
+
+    # clone sub notes
+    foreach my $note (@{$sub->notes}) {
+        my $r = _clone_subscription_note($note, $new_sub_id, $e);
+        return $r if $U->event_code($r);
+    }
+
+    # clone scaps
+    foreach my $scap (@{$sub->scaps}) {
+        my $r = _clone_caption_and_pattern($scap, $new_sub_id, $e);
+        return $r if $U->event_code($r);
+    }
+
+    return $new_sub_id;
+}
+
+sub _clone_distribution {
+    my ($dist, $sub_id, $e) = @_;
+
+    my $new_dist = $dist->clone;
+    $new_dist->clear_id;
+    $new_dist->clear_notes;
+    $new_dist->clear_streams;
+    $new_dist->subscription($sub_id);
+
+    $e->create_serial_distribution($new_dist) or return $e->die_event;
+    my $new_dist_id = $e->data->id;
+
+    # clone streams
+    foreach my $stream (@{$dist->streams}) {
+        my $r = _clone_stream($stream, $new_dist_id, $e);
+        return $r if $U->event_code($r);
+    }
+
+    # clone distribution notes
+    foreach my $note (@{$dist->notes}) {
+        my $r = _clone_distribution_note($note, $new_dist_id, $e);
+        return $r if $U->event_code($r);
+    }
+
+    return $new_dist_id;
+}
+
+sub _clone_subscription_note {
+    my ($note, $sub_id, $e) = @_;
+
+    my $new_note = $note->clone;
+    $new_note->clear_id;
+    $new_note->creator($e->requestor->id);
+    $new_note->create_date("now");
+    $new_note->subscription($sub_id);
+
+    $e->create_serial_subscription_note($new_note) or return $e->die_event;
+    return $e->data->id;
+}
+
+sub _clone_caption_and_pattern {
+    my ($scap, $sub_id, $e) = @_;
+
+    my $new_scap = $scap->clone;
+    $new_scap->clear_id;
+    $new_scap->subscription($sub_id);
+
+    $e->create_serial_caption_and_pattern($new_scap) or return $e->die_event;
+    return $e->data->id;
+}
+
+sub _clone_distribution_note {
+    my ($note, $dist_id, $e) = @_;
+
+    my $new_note = $note->clone;
+    $new_note->clear_id;
+    $new_note->creator($e->requestor->id);
+    $new_note->create_date("now");
+    $new_note->distribution($dist_id);
+
+    $e->create_serial_distribution_note($new_note) or return $e->die_event;
+    return $e->data->id;
+}
+
+sub _clone_stream {
+    my ($stream, $dist_id, $e) = @_;
+
+    my $new_stream = $stream->clone;
+    $new_stream->clear_id;
+    $new_stream->clear_routing_list_users;
+    $new_stream->distribution($dist_id);
+
+    $e->create_serial_stream($new_stream) or return $e->die_event;
+    my $new_stream_id = $e->data->id;
+
+    # clone routing list users
+    foreach my $user (@{$stream->routing_list_users}) {
+        my $r = _clone_routing_list_user($user, $new_stream_id, $e);
+        return $r if $U->event_code($r);
+    }
+
+    return $new_stream_id;
+}
+
+sub _clone_routing_list_user {
+    my ($user, $stream_id, $e) = @_;
+
+    my $new_user = $user->clone;
+    $new_user->clear_id;
+    $new_user->stream($stream_id);
+
+    $e->create_serial_routing_list_user($new_user) or return $e->die_event;
+    return $e->data->id;
+}
+
+__PACKAGE__->register_method(
+    "method" => "clone_subscription",
+    "api_name" => "open-ils.serial.subscription.clone",
+    "signature" => {
+        "desc" => q{Clone a subscription, including its attending distributions,
+            streams, captions and patterns, routing list users, distribution
+            notes and subscription notes. Do not include holdings-specific
+            things, like issuances, items, units, summaries. Attach the
+            clone either to the same bib record as the original, or to one
+            specified by ID.},
+        "params" => [
+            {"desc" => "Authtoken", "type" => "string"},
+            {"desc" => "Subscription ID", "type" => "number"},
+            {"desc" => "Bib Record ID (optional)", "type" => "number"}
+        ],
+        "return" => {
+            "desc" => "ID of the new subscription", "type" => "number"
+        }
+    }
+);
+
+sub clone_subscription {
+    my ($self, $client, $auth, $sub_id, $bib_id) = @_;
+
+    my $e = new_editor("authtoken" => $auth, "xact" => 1);
+    return $e->die_event unless $e->checkauth;
+
+    my $sub = $e->retrieve_serial_subscription([
+        int $sub_id, {
+            "flesh" => 3,
+            "flesh_fields" => {
+                "ssub" => [qw/distributions notes scaps/],
+                "sdist" => [qw/streams notes/],
+                "sstr" => ["routing_list_users"]
+            }
+        }
+    ]) or return $e->die_event;
+
+    # ADMIN_SERIAL_SUBSCRIPTION will have to be good enough as a
+    # catch-all permisison for this operation.
+    return $e->die_event unless
+        $e->allowed("ADMIN_SERIAL_SUBSCRIPTION", $sub->owning_lib);
+
+    my $result = _clone_subscription($sub, $bib_id, $e);
+
+    return $e->die_event($result) if $U->event_code($result);
+
+    $e->commit or return $e->die_event;
+    return $result;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage.pm
new file mode 100644
index 0000000000..b57a71820e
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage.pm
@@ -0,0 +1,200 @@
+package OpenILS::Application::Storage;
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+
+use OpenSRF::EX qw/:try/;
+use OpenSRF::Utils::Logger qw/:level/;
+
+# Pull this in so we can adjust it's @ISA
+use OpenILS::Application::Storage::CDBI (1);
+use OpenILS::Application::Storage::FTS;
+
+
+# the easy way to get to the logger...
+my $log = "OpenSRF::Utils::Logger";
+
+our $QParser;
+our $WRITE = 0;
+our $IGNORE_XACT_ID_FAILURE = 0;
+
+sub DESTROY {};
+
+sub initialize {
+
+	my $conf = OpenSRF::Utils::SettingsClient->new;
+
+	$log->debug('Initializing ' . __PACKAGE__ . '...', DEBUG);
+
+	my $db_driver = $conf->config_value( apps => 'open-ils.storage' => app_settings => databases => 'driver');
+	my $driver = "OpenILS::Application::Storage::Driver::$db_driver";
+
+	$log->debug("Attempting to load $driver ...", DEBUG);
+
+	$driver->use;
+	if ($@) {
+		$log->debug( "Can't load $driver!  :  $@", ERROR );
+		$log->error( "Can't load $driver!  :  $@");
+		throw OpenSRF::EX::PANIC ( "Can't load $driver!  :  $@" );
+	}
+
+	$log->debug("$driver loaded successfully", DEBUG);
+
+	# Suck in the method publishing modules
+	@OpenILS::Application::Storage::CDBI::ISA = ( $driver );
+
+	OpenILS::Application::Storage::Publisher->use;
+	if ($@) {
+		$log->debug("FAILURE LOADING Publisher!  $@", ERROR);
+		throw OpenSRF::EX::PANIC ( "FAILURE LOADING Publisher!  :  $@" );
+	}
+
+	$log->debug("We seem to be OK...",DEBUG);
+}
+
+sub child_init {
+
+	$log->debug('Running child_init for ' . __PACKAGE__ . '...', DEBUG);
+
+	my $conf = OpenSRF::Utils::SettingsClient->new;
+
+	$log->debug('Calling the Driver child_init', DEBUG);
+	OpenILS::Application::Storage::CDBI->child_init(
+		$conf->config_value( apps => 'open-ils.storage' => app_settings => databases => 'database')
+	);
+
+	if (OpenILS::Application::Storage::CDBI->db_Main()) {
+		$log->debug("Success initializing driver!", DEBUG);
+
+        my $db_driver = $conf->config_value( apps => 'open-ils.storage' => app_settings => databases => 'driver');
+        $QParser = 'OpenILS::Application::Storage::Driver::'.$db_driver.'::QueryParser';
+        $QParser->use;
+
+        if($@) {
+    		$log->debug( "Can't load $QParser!  :  $@", ERROR );
+    		$log->error( "Can't load $QParser!  :  $@");
+        } else {
+		    return 1;
+        }
+	}
+
+	$log->debug("FAILURE initializing driver!", ERROR);
+	return 0;
+}
+
+sub begin_xaction {
+	my $self = shift;
+	my $client = shift;
+
+	local $WRITE = 1;
+
+	$log->debug(" XACT --> 'BEGIN'ing transaction for session ".$client->session->session_id,DEBUG);
+	try {
+		OpenILS::Application::Storage::CDBI->db_Main->begin_work;
+		$client->session->session_data( xact_id => $client->session->session_id );
+	} catch Error with {
+		throw OpenSRF::DomainObject::oilsException->new(
+			statusCode => 500,
+			status => "Could not BEGIN transaction!",
+		);
+	};
+	return 1;
+
+}
+__PACKAGE__->register_method(
+	method		=> 'begin_xaction',
+	api_name	=> 'open-ils.storage.transaction.begin',
+	api_level	=> 1,
+	argc		=> 0,
+);
+
+sub savepoint_placeholder {
+	return 1;
+}
+__PACKAGE__->register_method(
+	method		=> 'savepoint_placeholder',
+	api_name	=> 'open-ils.storage.savepoint.set',
+	api_level	=> 1,
+	argc		=> 1,
+);
+__PACKAGE__->register_method(
+	method		=> 'savepoint_placeholder',
+	api_name	=> 'open-ils.storage.savepoint.release',
+	api_level	=> 1,
+	argc		=> 1,
+);
+__PACKAGE__->register_method(
+	method		=> 'savepoint_placeholder',
+	api_name	=> 'open-ils.storage.savepoint.rollback',
+	api_level	=> 1,
+	argc		=> 1,
+);
+
+sub commit_xaction {
+	my $self = shift;
+	my $client = shift;
+
+	local $WRITE = 1;
+
+	try {
+		OpenILS::Application::Storage::CDBI->db_Main->commit;
+		$client->session->session_data( xact_id => '' );
+	} catch Error with {
+		throw OpenSRF::DomainObject::oilsException->new(
+			statusCode => 500,
+			status => "Could not COMMIT  transaction!",
+		);
+	};
+	return 1;
+}
+__PACKAGE__->register_method(
+	method		=> 'commit_xaction',
+	api_name	=> 'open-ils.storage.transaction.commit',
+	api_level	=> 1,
+	argc		=> 0,
+);
+
+
+sub current_xact {
+	my $self = shift;
+	my $client = shift;
+
+	return $client->session->session_data( 'xact_id' );
+}
+__PACKAGE__->register_method(
+	method		=> 'current_xact',
+	api_name	=> 'open-ils.storage.transaction.current',
+	api_level	=> 1,
+	argc		=> 0,
+);
+
+sub rollback_xaction {
+	my $self = shift;
+	my $client = shift;
+
+	local $WRITE = 1;
+
+	$log->debug(" XACT --> 'ROLLBACK'ing transaction for session ".$client->session->session_id,DEBUG);
+	$client->session->session_data( xact_id => '' );
+	return OpenILS::Application::Storage::CDBI->db_Main->rollback;
+}
+__PACKAGE__->register_method(
+	method		=> 'rollback_xaction',
+	api_name	=> 'open-ils.storage.transaction.rollback',
+	api_level	=> 1,
+	argc		=> 0,
+);
+
+
+sub _cdbi2Hash {
+	my $self = shift;
+	my $obj = shift;
+	return { map { ( $_ => $obj->$_ ) } ($obj->columns('All')) };
+}
+
+sub _cdbi_list2AoH {
+	my $self = shift;
+	my @objs = @_;
+	return [ map { $self->_cdbi2Hash($_) } @objs ];
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI.pm
new file mode 100644
index 0000000000..d004f3898d
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI.pm
@@ -0,0 +1,781 @@
+package OpenILS::Application::Storage::CDBI;
+use UNIVERSAL::require; 
+BEGIN {                 
+	'Class::DBI::Frozen::301'->use or 'Class::DBI'->use or die $@;
+}     
+use base qw/Class::DBI/;
+use Class::DBI::AbstractSearch;
+
+use OpenILS::Application::Storage::CDBI::actor;
+use OpenILS::Application::Storage::CDBI::action;
+use OpenILS::Application::Storage::CDBI::booking;
+use OpenILS::Application::Storage::CDBI::asset;
+use OpenILS::Application::Storage::CDBI::serial;
+use OpenILS::Application::Storage::CDBI::authority;
+use OpenILS::Application::Storage::CDBI::biblio;
+use OpenILS::Application::Storage::CDBI::config;
+use OpenILS::Application::Storage::CDBI::metabib;
+use OpenILS::Application::Storage::CDBI::money;
+use OpenILS::Application::Storage::CDBI::permission;
+use OpenILS::Application::Storage::CDBI::container;
+
+use OpenSRF::Utils::JSON;
+use OpenSRF::Utils::Logger qw(:level);
+use OpenSRF::EX qw/:try/;
+
+our $VERSION = 1;
+my $log = 'OpenSRF::Utils::Logger';
+
+if ($Class::DBI::VERSION gt '3.0.1') {
+    $log->error("Your version of Class::DBI, $Class::DBI::VERSION, is too new and incompatible with Evergreen.  You will need to downgrade to version 3.0.1 or install Class::DBI::Frozen::301"); 
+    die("Your version of Class::DBI, $Class::DBI::VERSION, is too new and incompatible with Evergreen.  You will need to downgrade to version 3.0.1 or install Class::DBI::Frozen::301"); 
+}
+
+sub child_init {
+	my $self = shift;
+
+	$log->debug("Creating ImaDBI Querys", DEBUG);
+	__PACKAGE__->set_sql( 'OILSFastSearch', <<"	SQL", 'Main');
+		SELECT	%s
+		  FROM	%s
+		  WHERE	%s = ?
+	SQL
+
+	__PACKAGE__->set_sql( 'OILSFastOrderedSearchLike', <<"	SQL", 'Main');
+		SELECT	%s
+		  FROM	%s
+		  WHERE	%s LIKE ?
+		  ORDER BY %s
+	SQL
+
+	__PACKAGE__->set_sql( 'OILSFastOrderedSearch', <<"	SQL", 'Main');
+		SELECT	%s
+		  FROM	%s
+		  WHERE	%s = ?
+		  ORDER BY %s
+	SQL
+
+	$log->debug("Calling Driver child_init", DEBUG);
+	$self->SUPER::child_init(@_);
+
+}
+
+sub fast_flesh_sth {
+	my $class = shift;
+	$class = ref($class) || $class;
+
+	my $field = shift;
+	my $value = shift;
+	my $order = shift;
+	my $like = shift;
+
+
+	if (!(defined($order) and ref($order) and ref($order) eq 'HASH')) {
+		if (defined($value) and ref($value) and ref($value) eq 'HASH') {
+			$order = $value;
+			$value = undef;
+		} else {
+			$order = { order_by => $class->columns('Primary') }
+		}
+	}
+
+	unless (defined $value) {
+		$value = $field;
+		($field) = $class->columns('Primary');
+	}
+
+	unless (defined $field) {
+		($field) = $class->columns('Primary');
+	}
+
+	unless ($order->{order_by}) {
+		$order = { order_by => $class->columns('Primary') }
+	}
+
+	my $fm_class = 'Fieldmapper::'.$class;
+	my $field_list = join ',', $class->columns('Essential');
+	
+	my $sth;
+	if (!$like) {
+		$sth = $class->sql_OILSFastOrderedSearch( $field_list, $class->table, $field, $order->{order_by});
+	} else {
+		$sth = $class->sql_OILSFastOrderedSearchLike( $field_list, $class->table, $field, $order->{order_by});
+	}
+	$sth->execute($value);
+	return $sth;
+}
+
+sub fast_flesh {
+	my $self = shift;
+	return map $class->construct($_), $self->fast_flesh_sth(@_)->fetchall_hash;
+}
+
+sub fast_fieldmapper {
+	my $self = shift;
+	my $id = shift;
+	my $col = shift;
+	my $like = shift;
+	my $options = shift;
+	my $class = ref($self) || $self;
+	my $fm_class = 'Fieldmapper::'.$class;
+	my @fms;
+	$log->debug("fast_fieldmapper() ==> Retrieving $fm_class", INTERNAL);
+	if ($like < 2) {
+		for my $hash ($self->fast_flesh_sth( $col, "$id", { order_by => $col }, $like )->fetchall_hash) {
+			my $fm = $fm_class->new;
+			for my $field ( $fm_class->real_fields ) {
+				$fm->$field( $$hash{$field} );
+			}
+			push @fms, $fm;
+		}
+	} else {
+		my $search_type = 'search';
+		if ($like == 2) {
+			$search_type = 'search_fts'
+		} elsif ($like == 3) {
+			$search_type = 'search_regex'
+		}
+
+		for my $obj ($class->$search_type({ $col => $id}, $options)) {
+			push @fms, $obj->to_fieldmapper;
+		}
+	}
+	return @fms;
+}
+
+sub retrieve {
+	my $self = shift;
+	my $arg = shift;
+	if (ref($arg) &&
+		(UNIVERSAL::isa($arg => 'Fieldmapper') ||
+		 UNIVERSAL::isa($arg => 'Class::DBI')) ) {
+		my ($col) = $self->primary_column;
+		$log->debug("Using field $col as the primary key", INTERNAL);
+		$arg = $arg->$col;
+	} elsif (ref $arg) {
+		my ($col) = $self->primary_column;
+		$log->debug("Using field $col as the primary key", INTERNAL);
+		$arg = $arg->{$col};
+	}
+		
+	$log->debug("Retrieving $self with $arg", INTERNAL);
+	my $rec;
+	try {
+		$rec = $self->SUPER::retrieve("$arg");
+	} catch Error with {
+		$log->debug("Could not retrieve $self with $arg! -- ".shift(), DEBUG);
+		return undef;
+	};
+	return $rec;
+}
+
+sub to_fieldmapper {
+	my $obj = shift;
+	my $class = ref($obj) || $obj;
+
+	my $fm_class = 'Fieldmapper::'.$class;
+	my $fm = $fm_class->new;
+
+	if (ref($obj)) {
+		for my $field ( $fm->real_fields ) {
+			$fm->$field( ''.$obj->$field );
+		}
+	}
+
+	return $fm;
+}
+
+sub merge {
+	my $self = shift;
+	my $search = shift;
+	my $arg = shift;
+
+	delete $$arg{$_} for (keys %$search);
+
+	$log->debug("CDBI->merge: \$search is $search (".ref($search)." : ".join(',',map{"$_ => $$search{$_}"}keys(%$search)).")",DEBUG);
+	$log->debug("CDBI->merge: \$arg is $arg (".ref($arg)." : ".join(',',map{"$_ => $$arg{$_}"}keys(%$arg)).")",DEBUG);
+
+	my @objs = ($self);
+	@objs = $self->search_where($search) unless (ref $self);
+
+	if (@objs == 1) {
+		$objs[0]->update($arg);
+		return $objs[0];
+	} elsif (@objs == 0) {
+		return $self->create({%$search,%$arg});
+	} else {
+		throw OpenSRF::EX::WARN ("Non-unique search key for merge.  Perhaps you meant to use remote_update?");
+	}
+}
+
+sub remote_update {
+	my $self = shift;
+	my $search = shift;
+	my $arg = shift;
+
+	delete $$arg{$_} for (keys %$search);
+
+	$log->debug("CDBI->remote_update: \$search is $search (".ref($search)." : ".join(',',map{"$_ => $$search{$_}"}keys(%$search)).")",DEBUG);
+	$log->debug("CDBI->remote_update: \$arg is $arg (".ref($arg)." : ".join(',',map{"$_ => $$arg{$_}"}keys(%$arg)).")",DEBUG);
+
+#	my @objs = $self->search_where($search);
+#	throw OpenSRF::EX::WARN ("No objects found for remote_update.  Perhaps you meant to use merge?")
+#		if (@objs == 0);
+
+#	$_->update($arg) for (@objs);
+#	return scalar(@objs);
+
+	my @finds = sort keys %$search;
+	my @sets = sort keys %$arg;
+
+	my @find_vals = @$search{@finds};
+	my @set_vals = @$arg{@sets};
+
+	my $sql = 'UPDATE %s SET %s WHERE %s';
+
+	my $table = $self->table;
+	my $set = join(', ', map { "$_=?" } @sets);
+	my $where = join(', ', map { "$_=?" } @finds);
+
+	my $sth = $self->db_Main->prepare(sprintf($sql, $table, $set, $where));
+	$sth->execute(@set_vals,@find_vals);
+	return $sth->rows;
+
+}
+
+sub create {
+	my $self = shift;
+	my $arg = shift;
+
+	$log->debug("CDBI->create: \$arg is $arg (".ref($arg)." : ".OpenSRF::Utils::JSON->perl2JSON($arg).")",DEBUG);
+
+	if (ref($arg) && UNIVERSAL::isa($arg => 'Fieldmapper')) {
+		return $self->create_from_fieldmapper($arg,@_);
+	}
+
+	return $self->SUPER::create($arg,@_);
+}
+
+sub create_from_fieldmapper {
+	my $obj = shift;
+	my $fm = shift;
+	my @params = @_;
+
+	$log->debug("Creating node of type ".ref($fm), DEBUG);
+
+	my $class = ref($obj) || $obj;
+	my ($primary) = $class->columns('Primary');
+
+	if (ref($fm) &&UNIVERSAL::isa($fm => 'Fieldmapper')) {
+		my %hash = map { defined $fm->$_ ?
+					($_ => $fm->$_) :
+					()
+				} grep { $_ ne $primary } $class->columns('Essential');
+
+		if ($class->find_column( 'last_xact_id' )) {
+			if ($OpenILS::Application::Storage::IGNORE_XACT_ID_FAILURE) {
+				$hash{last_xact_id} = 'unknown.'.time.'.'.$$.'.'.rand($$);
+			} else {
+				my $xact_id = $class->current_xact_id;
+				throw Error unless ($xact_id);
+				$hash{last_xact_id} = $xact_id;
+			}
+		}
+
+		return $class->create( \%hash, @params );
+	} else {
+		return undef;
+	}
+}
+
+sub delete {
+	my $self = shift;
+	my $arg = shift;
+	my $orig = $self;
+
+	my $class = ref($self) || $self;
+
+	$self = $self->retrieve($arg) if (!ref($self));
+	unless (defined $self) {
+		$log->debug("ARG! Couldn't retrieve record ".$arg->id, DEBUG);
+		throw OpenSRF::EX::WARN ("ARG! Couldn't retrieve record ");
+	}
+
+	if ($class->find_column( 'last_xact_id' )) {
+		my $xact_id = $self->current_xact_id;
+		
+		throw Error ("Deleting from $class requires a transaction be established")
+			unless ($xact_id);
+		
+		throw Error ("The row you are attempting to delete has been changed since you read it")
+			unless ( $orig->last_xact_id eq $self->last_xact_id);
+
+		$self->last_xact_id( $class->current_xact_id );
+		$self->SUPER::update;
+	}
+
+	$self->SUPER::delete;
+
+	return 1;
+}
+
+sub debug_object {
+	my $obj = shift;
+	my $string = '';
+
+	$string .= "Object type:\t".ref($obj)."\n";
+	$string .= "Object string:\t$obj\n";
+
+	if (ref($obj) && UNIVERSAL::isa($obj => 'Fieldmapper')) {
+		$string .= "Object fields:\n";
+		for my $col ($obj->real_fields()) {
+			$string .= "\t$col\t=> ".$obj->$col."\n";
+		}
+	} elsif (ref($obj) && UNIVERSAL::isa($obj => 'Class::DBI')) {
+		$string .= "Object cols:\n";
+		for my $col ($obj->columns('All')) {
+			$string .= "\t$col\t=> ".$obj->$col."\n";
+		}
+	} elsif (ref($obj) && UNIVERSAL::isa($obj => 'HASH')) {
+		$string .= "Object keys and vals:\n";
+		for my $col (keys %$obj) {
+			$string .= "\t$col\t=> $$obj{$col}\n";
+		}
+	}
+
+	$string .= "\n";
+	
+	$log->debug($string,DEBUG);
+}
+
+
+sub update {
+	my $self = shift;
+	my $arg = shift;
+
+	$log->debug("Attempting to update using $arg", DEBUG) if ($arg);
+
+	if (ref($arg)) {
+		$self = $self->modify_from_fieldmapper($arg);
+		unless (defined $self) {
+			$log->debug("Modification of $arg seems to have failed....", DEBUG);
+			return undef;
+		}
+	}
+
+	$log->debug("Calling Class::DBI->update on modified object $self", DEBUG);
+
+	#debug_object($self);
+
+	return $self->SUPER::update if ($self->is_changed);
+	return 0;
+}
+
+sub modify_from_fieldmapper {
+	my $obj = shift;
+	my $fm = shift;
+	my $orig = $obj;
+
+	#debug_object($obj);
+	#debug_object($fm);
+
+	$log->debug("Modifying object using fieldmapper", DEBUG);
+
+	my $class = ref($obj) || $obj;
+	my ($primary) = $class->columns('Primary');
+
+
+	if (!ref($obj)) {
+		$obj = $class->retrieve($fm);
+		#debug_object($obj);
+		unless ($obj) {
+			$log->debug("Retrieve of $class using $fm (".$fm->id.") failed! -- ".shift(), ERROR);
+			throw OpenSRF::EX::WARN ("No $class with id of ".$fm->id."!!");
+		}
+	}
+
+	my %hash;
+	
+	if (ref($fm) and UNIVERSAL::isa($fm => 'Fieldmapper')) {
+		%hash = map { ($_ => $fm->$_) } grep { $_ ne $primary } $class->columns('Essential');
+		delete $hash{passwd} if ($fm->isa('Fieldmapper::actor::user'));
+	} else {
+		%hash = %{$fm};
+	}
+
+	my $au = $obj->autoupdate;
+	$obj->autoupdate(0);
+	
+	#debug_object($obj);
+
+	for my $field ( keys %hash ) {
+		$obj->$field( $hash{$field} ) if ($obj->$field ne $hash{$field});
+		$log->debug("Setting field $field on $obj to $hash{$field}",INTERNAL);
+	}
+
+	if ($class->find_column( 'last_xact_id' ) and $obj->is_changed) {
+		my ($xact_id) = OpenILS::Application::Storage->method_lookup('open-ils.storage.transaction.current')->run();
+		throw Error ("Updating $class requires a transaction be established")
+			unless ($xact_id);
+		throw Error ("The row you are attempting to delete has been changed since you read it")
+			unless ( $fm->last_xact_id eq $obj->last_xact_id);
+		$obj->last_xact_id( $xact_id );
+	} else {
+		$obj->autoupdate($au)
+	}
+
+	return $obj;
+}
+
+
+
+	#-------------------------------------------------------------------------------
+	actor::user->has_a( home_ou => 'actor::org_unit' );
+	actor::user->has_a( card => 'actor::card' );
+	actor::user->has_a( standing => 'config::standing' );
+	actor::user->has_a( profile => 'permission::grp_tree' );
+	actor::user->has_a( mailing_address => 'actor::user_address' );
+	actor::user->has_a( billing_address => 'actor::user_address' );
+	actor::user->has_a( ident_type => 'config::identification_type' );
+	actor::user->has_a( ident_type2 => 'config::identification_type' );
+	actor::user->has_a( net_access_level => 'config::net_access_level' );
+
+	actor::user_address->has_a( usr => 'actor::user' );
+	
+	actor::card->has_a( usr => 'actor::user' );
+	
+	actor::workstation->has_a( owning_lib => 'actor::org_unit' );
+	actor::org_unit::closed_date->has_a( org_unit => 'actor::org_unit' );
+	actor::org_unit_setting->has_a( org_unit => 'actor::org_unit' );
+
+	actor::usr_note->has_a( usr => 'actor::user' );
+	actor::user->has_many( notes => 'actor::usr_note' );
+
+	actor::user_standing_penalty->has_a( usr => 'actor::user' );
+	actor::user->has_many( standing_penalties => 'actor::user_standing_penalty' );
+
+	actor::org_unit->has_a( parent_ou => 'actor::org_unit' );
+	actor::org_unit->has_a( ou_type => 'actor::org_unit_type' );
+	actor::org_unit->has_a( ill_address => 'actor::org_address' );
+	actor::org_unit->has_a( holds_address => 'actor::org_address' );
+	actor::org_unit->has_a( mailing_address => 'actor::org_address' );
+	actor::org_unit->has_a( billing_address => 'actor::org_address' );
+	actor::org_unit->has_many( children => 'actor::org_unit' => 'parent_ou' );
+	actor::org_unit->has_many( workstations => 'actor::workstation' );
+	actor::org_unit->has_many( closed_dates => 'actor::org_unit::closed_date' );
+	actor::org_unit->has_many( settings => 'actor::org_unit_setting' );
+	#actor::org_unit->might_have( hours_of_operation => 'actor::org_unit::hours_of_operation' );
+
+	actor::org_unit_type->has_a( parent => 'actor::org_unit_type' );
+	actor::org_unit_type->has_many( children => 'actor::org_unit_type' => 'parent' );
+
+	actor::org_address->has_a( org_unit => 'actor::org_unit' );
+	actor::org_unit->has_many( addresses => 'actor::org_address' );
+
+	action::transit_copy->has_a( source => 'actor::org_unit' );
+	action::transit_copy->has_a( dest => 'actor::org_unit' );
+	action::transit_copy->has_a( copy_status => 'config::copy_status' );
+
+	action::hold_transit_copy->has_a( source => 'actor::org_unit' );
+	action::hold_transit_copy->has_a( dest => 'actor::org_unit' );
+	action::hold_transit_copy->has_a( copy_status => 'config::copy_status' );
+	action::hold_transit_copy->has_a( hold => 'action::hold_request' );
+
+	action::hold_request->has_many( transits => 'action::hold_transit_copy' );
+
+	actor::stat_cat_entry->has_a( stat_cat => 'actor::stat_cat' );
+	actor::stat_cat->has_a( owner => 'actor::org_unit' );
+	actor::stat_cat->has_many( entries => 'actor::stat_cat_entry' );
+	actor::stat_cat_entry_user_map->has_a( stat_cat => 'actor::stat_cat' );
+	actor::stat_cat_entry_user_map->has_a( stat_cat_entry => 'actor::stat_cat_entry' );
+	actor::stat_cat_entry_user_map->has_a( target_usr => 'actor::user' );
+
+	asset::stat_cat_entry->has_a( stat_cat => 'asset::stat_cat' );
+	asset::stat_cat->has_a( owner => 'actor::org_unit' );
+	asset::stat_cat->has_many( entries => 'asset::stat_cat_entry' );
+	asset::stat_cat_entry_copy_map->has_a( stat_cat => 'asset::stat_cat' );
+	asset::stat_cat_entry_copy_map->has_a( stat_cat_entry => 'asset::stat_cat_entry' );
+	asset::stat_cat_entry_copy_map->has_a( owning_copy => 'asset::copy' );
+
+	action::survey_response->has_a( usr => 'actor::user' );
+	action::survey_response->has_a( survey => 'action::survey' );
+	action::survey_response->has_a( question => 'action::survey_question' );
+	action::survey_response->has_a( answer => 'action::survey_answer' );
+
+	action::survey_question->has_a( survey => 'action::survey' );
+
+	action::survey_answer->has_a( question => 'action::survey_question' );
+
+	asset::copy_note->has_a( owning_copy => 'asset::copy' );
+	asset::copy_note->has_a( creator => 'actor::user' );
+
+	actor::user->has_many( stat_cat_entries => [ 'actor::stat_cat_entry_user_map' => 'stat_cat_entry' ] );
+	actor::user->has_many( stat_cat_entry_user_maps => 'actor::stat_cat_entry_user_map' );
+
+	asset::copy->has_many( stat_cat_entries => [ 'asset::stat_cat_entry_copy_map' => 'stat_cat_entry' ] );
+	asset::copy->has_many( stat_cat_entry_copy_maps => 'asset::stat_cat_entry_copy_map' );
+
+	asset::copy->has_a( call_number => 'asset::call_number' );
+	asset::copy->has_a( creator => 'actor::user' );
+	asset::copy->has_a( editor => 'actor::user' );
+	asset::copy->has_a( status => 'config::copy_status' );
+	asset::copy->has_a( location => 'asset::copy_location' );
+	asset::copy->has_a( circ_lib => 'actor::org_unit' );
+
+	serial::unit->has_a( call_number => 'asset::call_number' );
+	serial::unit->has_a( creator => 'actor::user' );
+	serial::unit->has_a( editor => 'actor::user' );
+	serial::unit->has_a( status => 'config::copy_status' );
+	serial::unit->has_a( location => 'asset::copy_location' );
+	serial::unit->has_a( circ_lib => 'actor::org_unit' );
+
+	serial::item->has_a( unit => 'serial::unit' );
+	serial::item->has_a( issuance => 'serial::issuance' );
+	serial::item->has_a( uri => 'asset::uri' );
+
+	serial::unit->has_many( items => 'serial::item' );
+
+	serial::issuance->has_a( subscription => 'serial::subscription' );
+	serial::issuance->has_many( items => 'serial::item' );
+
+	serial::subscription->has_a( record_entry => 'biblio::record_entry' );
+	serial::subscription->has_many( issuances => 'serial::issuance' );
+
+	asset::call_number_note->has_a( call_number => 'asset::call_number' );
+
+	asset::call_number->has_a( record => 'biblio::record_entry' );
+	asset::call_number->has_a( creator => 'actor::user' );
+	asset::call_number->has_a( editor => 'actor::user' );
+	asset::call_number->has_a( owning_lib => 'actor::org_unit' );
+
+	authority::record_note->has_a( record => 'authority::record_entry' );
+	biblio::record_note->has_a( record => 'biblio::record_entry' );
+	
+	authority::record_entry->has_a( creator => 'actor::user' );
+	authority::record_entry->has_a( editor => 'actor::user' );
+	biblio::record_entry->has_a( creator => 'actor::user' );
+	biblio::record_entry->has_a( editor => 'actor::user' );
+	
+	metabib::metarecord->has_a( master_record => 'biblio::record_entry' );
+	
+	authority::record_descriptor->has_a( record => 'authority::record_entry' );
+	metabib::record_descriptor->has_a( record => 'biblio::record_entry' );
+	
+	authority::full_rec->has_a( record => 'authority::record_entry' );
+	metabib::full_rec->has_a( record => 'biblio::record_entry' );
+	
+	metabib::title_field_entry->has_a( source => 'biblio::record_entry' );
+	metabib::title_field_entry->has_a( field => 'config::metabib_field' );
+
+	metabib::identifier_field_entry->has_a( source => 'biblio::record_entry' );
+	metabib::identifier_field_entry->has_a( field => 'config::metabib_field' );
+	
+	metabib::author_field_entry->has_a( source => 'biblio::record_entry' );
+	metabib::author_field_entry->has_a( field => 'config::metabib_field' );
+	
+	metabib::subject_field_entry->has_a( source => 'biblio::record_entry' );
+	metabib::subject_field_entry->has_a( field => 'config::metabib_field' );
+	
+	metabib::keyword_field_entry->has_a( source => 'biblio::record_entry' );
+	metabib::keyword_field_entry->has_a( field => 'config::metabib_field' );
+	
+	metabib::series_field_entry->has_a( source => 'biblio::record_entry' );
+	metabib::series_field_entry->has_a( field => 'config::metabib_field' );
+	
+	metabib::metarecord_source_map->has_a( metarecord => 'metabib::metarecord' );
+	metabib::metarecord_source_map->has_a( source => 'biblio::record_entry' );
+
+	action::circulation->has_a( usr => 'actor::user' );
+	actor::user->has_many( circulations => 'action::circulation' => 'usr' );
+
+	booking::resource_attr_map->has_a( resource => 'booking::resource' );
+
+	booking::resource->has_a( owner => 'actor::org_unit' );
+	booking::resource->has_a( type => 'booking::resource_type' );
+	booking::resource_type->has_a( owner => 'actor::org_unit' );
+
+	booking::reservation->has_a( usr => 'actor::user' );
+	actor::user->has_many( reservations => 'booking::reservation' => 'usr' );
+	
+	action::circulation->has_a( circ_staff => 'actor::user' );
+	actor::user->has_many( performed_circulations => 'action::circulation' => 'circ_staff' );
+
+	action::circulation->has_a( checkin_staff => 'actor::user' );
+	actor::user->has_many( checkins => 'action::circulation' => 'checkin_staff' );
+
+	action::circulation->has_a( target_copy => 'asset::copy' );
+	asset::copy->has_many( circulations => 'action::circulation' => 'target_copy' );
+	serial::unit->has_many( circulations => 'action::circulation' => 'target_copy' );
+
+	booking::reservation->has_a( pickup_lib => 'actor::org_unit' );
+
+	action::circulation->has_a( circ_lib => 'actor::org_unit' );
+	actor::org_unit->has_many( circulations => 'action::circulation' => 'circ_lib' );
+	
+	action::circulation->has_a( checkin_lib => 'actor::org_unit' );
+	actor::org_unit->has_many( checkins => 'action::circulation' => 'checkin_lib' );
+
+	money::billable_transaction->has_a( usr => 'actor::user' );
+	#money::billable_transaction->might_have( circulation => 'action::circulation' );
+	#money::billable_transaction->might_have( grocery => 'money::grocery' );
+	actor::user->has_many( billable_transactions => 'action::circulation' => 'usr' );
+	
+	
+	#-------------------------------------------------------------------------------
+	actor::user->has_many( survey_responses => 'action::survey_response' );
+	actor::user->has_many( addresses => 'actor::user_address' );
+	actor::user->has_many( cards => 'actor::card' );
+
+	actor::org_unit->has_many( users => 'actor::user' );
+
+	action::survey->has_many( questions => 'action::survey_question' );
+	action::survey->has_many( responses => 'action::survey_response' );
+	
+	action::survey_question->has_many( answers => 'action::survey_answer' );
+	action::survey_question->has_many( responses => 'action::survey_response' );
+
+	action::survey_answer->has_many( responses => 'action::survey_response' );
+
+	asset::copy->has_many( notes => 'asset::copy_note' );
+	asset::call_number->has_many( copies => 'asset::copy' );
+	asset::call_number->has_many( notes => 'asset::call_number_note' );
+
+	authority::record_entry->has_many( record_descriptor => 'authority::record_descriptor' );
+	authority::record_entry->has_many( notes => 'authority::record_note' );
+
+	biblio::record_entry->has_many( record_descriptor => 'metabib::record_descriptor' );
+	biblio::record_entry->has_many( notes => 'biblio::record_note' );
+	biblio::record_entry->has_many( call_numbers => 'asset::call_number' );
+	biblio::record_entry->has_many( full_record_entries => 'metabib::full_rec' );
+	biblio::record_entry->has_many( title_field_entries => 'metabib::title_field_entry' );
+	biblio::record_entry->has_many( identifier_field_entries => 'metabib::identifier_field_entry' );
+	biblio::record_entry->has_many( author_field_entries => 'metabib::author_field_entry' );
+	biblio::record_entry->has_many( subject_field_entries => 'metabib::subject_field_entry' );
+	biblio::record_entry->has_many( keyword_field_entries => 'metabib::keyword_field_entry' );
+	biblio::record_entry->has_many( series_field_entries => 'metabib::series_field_entry' );
+
+	metabib::metarecord->has_many( source_records => [ 'metabib::metarecord_source_map' => 'source'] );
+	biblio::record_entry->has_many( metarecords => [ 'metabib::metarecord_source_map' => 'metarecord'] );
+
+	money::billing->has_a( xact => 'money::billable_transaction' );
+	money::payment->has_a( xact => 'money::billable_transaction' );
+
+	money::billable_transaction->has_many( billings => 'money::billing' );
+	money::billable_transaction->has_many( payments => 'money::payment' );
+
+	action::circulation->has_many( billings => 'money::billing' => 'xact' );
+	action::circulation->has_many( payments => 'money::payment' => 'xact' );
+	#action::circulation->might_have( billable_transaction => 'money::billable_transaction' );
+	#action::open_circulation->might_have( circulation => 'action::circulation' );
+
+	booking::reservation->has_many( billings => 'money::billing' => 'xact' );
+	booking::reservation->has_many( payments => 'money::payment' => 'xact' );
+
+	action::in_house_use->has_a( org_unit => 'actor::org_unit' );
+	action::in_house_use->has_a( staff => 'actor::user' );
+	action::in_house_use->has_a( item => 'asset::copy' );
+
+	action::non_cataloged_circulation->has_a( circ_lib => 'actor::org_unit' );
+	action::non_cataloged_circulation->has_a( item_type => 'config::non_cataloged_type' );
+	action::non_cataloged_circulation->has_a( patron => 'actor::user' );
+	action::non_cataloged_circulation->has_a( staff => 'actor::user' );
+
+	money::grocery->has_many( billings => 'money::billing' => 'xact' );
+	money::grocery->has_many( payments => 'money::payment' => 'xact' );
+	#money::grocery->might_have( billable_transaction => 'money::billable_transaction' );
+
+	#money::payment->might_have( cash_payment => 'money::cash_payment' );
+	#money::payment->might_have( check_payment => 'money::check_payment' );
+	#money::payment->might_have( credit_card_payment => 'money::credit_card_payment' );
+	#money::payment->might_have( forgive_payment => 'money::forgive_payment' );
+	#money::payment->might_have( work_payment => 'money::work_payment' );
+	#money::payment->might_have( credit_payment => 'money::credit_payment' );
+
+	money::cash_payment->has_a( xact => 'money::billable_transaction' );
+	money::cash_payment->has_a( accepting_usr => 'actor::user' );
+	#money::cash_payment->might_have( payment => 'money::payment' );
+
+	money::check_payment->has_a( xact => 'money::billable_transaction' );
+	money::check_payment->has_a( accepting_usr => 'actor::user' );
+	#money::check_payment->might_have( payment => 'money::payment' );
+
+	money::credit_card_payment->has_a( xact => 'money::billable_transaction' );
+	money::credit_card_payment->has_a( accepting_usr => 'actor::user' );
+	#money::credit_card_payment->might_have( payment => 'money::payment' );
+
+	money::forgive_payment->has_a( xact => 'money::billable_transaction' );
+	money::forgive_payment->has_a( accepting_usr => 'actor::user' );
+	#money::forgive_payment->might_have( payment => 'money::payment' );
+
+	money::work_payment->has_a( xact => 'money::billable_transaction' );
+	money::work_payment->has_a( accepting_usr => 'actor::user' );
+	#money::work_payment->might_have( payment => 'money::payment' );
+
+	money::goods_payment->has_a( xact => 'money::billable_transaction' );
+	money::goods_payment->has_a( accepting_usr => 'actor::user' );
+	#money::goods_payment->might_have( payment => 'money::payment' );
+
+	money::credit_payment->has_a( xact => 'money::billable_transaction' );
+	money::credit_payment->has_a( accepting_usr => 'actor::user' );
+	#money::credit_payment->might_have( payment => 'money::payment' );
+
+	permission::grp_tree->has_a( parent => 'permission::grp_tree' );
+	permission::grp_tree->has_many( children => 'permission::grp_tree' => 'parent' );
+
+	permission::grp_perm_map->has_a( grp => 'permission::grp_tree' );
+	permission::grp_perm_map->has_a(  perm => 'permission::perm_list' );
+	permission::grp_perm_map->has_a(  depth => 'actor::org_unit_type' );
+	
+	permission::usr_perm_map->has_a( usr => 'actor::user' );
+	permission::usr_perm_map->has_a(  perm => 'permission::perm_list' );
+	permission::usr_perm_map->has_a(  depth => 'actor::org_unit_type' );
+	
+	permission::usr_grp_map->has_a(  usr => 'actor::user' );
+	permission::usr_grp_map->has_a(  grp => 'permission::grp_tree' );
+
+	action::hold_notification->has_a(  hold => 'action::hold_request' );
+	
+	action::hold_copy_map->has_a(  hold => 'action::hold_request' );
+	action::hold_copy_map->has_a(  target_copy => 'asset::copy' );
+
+	action::unfulfilled_hold_list->has_a(  current_copy => 'asset::copy' );
+	action::unfulfilled_hold_list->has_a(  hold => 'action::hold_request' );
+	action::unfulfilled_hold_list->has_a(  circ_lib => 'actor::org_unit' );
+
+	action::hold_request->has_a(  current_copy => 'asset::copy' );
+	action::hold_request->has_a(  requestor => 'actor::user' );
+	action::hold_request->has_a(  usr => 'actor::user' );
+	action::hold_request->has_a(  fulfillment_staff => 'actor::user' );
+	action::hold_request->has_a(  pickup_lib => 'actor::org_unit' );
+	action::hold_request->has_a(  request_lib => 'actor::org_unit' );
+	action::hold_request->has_a(  fulfillment_lib => 'actor::org_unit' );
+	action::hold_request->has_a(  selection_ou => 'actor::org_unit' );
+
+	action::hold_request->has_many(  notifications => 'action::hold_notification' );
+	action::hold_request->has_many(  eligible_copies => [ 'action::hold_copy_map' => 'target_copy' ] );
+
+	asset::copy->has_many(  holds => [ 'action::hold_copy_map' => 'hold' ] );
+	serial::unit->has_many(  holds => [ 'action::hold_copy_map' => 'hold' ] );
+
+	container::biblio_record_entry_bucket->has_a( owner => 'actor::user' );
+	container::biblio_record_entry_bucket_item->has_a( bucket => 'container::biblio_record_entry_bucket' );
+	container::biblio_record_entry_bucket_item->has_a( target_biblio_record_entry => 'biblio::record_entry' );
+	container::biblio_record_entry_bucket->has_many( items => 'container::biblio_record_entry_bucket_item' );
+
+	container::user_bucket->has_a( owner => 'actor::user' );
+	container::user_bucket_item->has_a( bucket => 'container::user_bucket' );
+	container::user_bucket_item->has_a( target_user => 'actor::user' );
+	container::user_bucket->has_many( items => 'container::user_bucket_item' );
+
+	container::call_number_bucket->has_a( owner => 'actor::user' );
+	container::call_number_bucket_item->has_a( bucket => 'container::call_number_bucket' );
+	container::call_number_bucket_item->has_a( target_call_number => 'asset::call_number' );
+	container::call_number_bucket->has_many( items => 'container::call_number_bucket_item' );
+
+	container::copy_bucket->has_a( owner => 'actor::user' );
+	container::copy_bucket_item->has_a( bucket => 'container::copy_bucket' );
+	container::copy_bucket_item->has_a( target_copy => 'asset::copy' );
+	container::copy_bucket->has_many( items => 'container::copy_bucket_item' );
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/action.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/action.pm
new file mode 100644
index 0000000000..8346ea4658
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/action.pm
@@ -0,0 +1,159 @@
+package OpenILS::Application::Storage::CDBI::action;
+our $VERSION = 1;
+
+#-------------------------------------------------------------------------------
+package action;
+use base qw/OpenILS::Application::Storage::CDBI/;
+#-------------------------------------------------------------------------------
+
+package action::in_house_use;
+use base qw/action/;
+__PACKAGE__->table('action_in_house_use');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/item staff org_unit use_time/);
+#-------------------------------------------------------------------------------
+
+package action::non_cat_in_house_use;
+use base qw/action/;
+__PACKAGE__->table('action_non_cat_in_house_use');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/item_type staff org_unit use_time/);
+#-------------------------------------------------------------------------------
+
+package action::non_cataloged_circulation;
+use base qw/action/;
+__PACKAGE__->table('action_non_cataloged_circulation');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/patron staff circ_lib item_type circ_time/);
+#-------------------------------------------------------------------------------
+
+package action::survey;
+use base qw/action/;
+__PACKAGE__->table('action_survey');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/name description owner start_date
+				     end_date usr_summary opac poll required/);
+#-------------------------------------------------------------------------------
+
+package action::survey_question;
+use base qw/action/;
+__PACKAGE__->table('action_survey_question');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/survey question/);
+#-------------------------------------------------------------------------------
+
+
+package action::survey_answer;
+use base qw/action/;
+__PACKAGE__->table('action_survey_answer');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/question answer/);
+#-------------------------------------------------------------------------------
+
+package action::survey_response;
+use base qw/action/;
+__PACKAGE__->table('action_survey_response');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/response_group_id usr survey question
+				     answer answer_date effective_date/);
+#-------------------------------------------------------------------------------
+
+package action::circulation;
+use base qw/action/;
+__PACKAGE__->table('action_circulation');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/xact_start usr target_copy circ_lib
+				     duration duration_rule renewal_remaining
+				     recurring_fine_rule recurring_fine stop_fines
+				     max_fine max_fine_rule fine_interval
+				     stop_fines xact_finish due_date opac_renewal
+				     checkin_staff circ_staff circ_lib checkin_lib
+				     stop_fines_time checkin_time desk_renewal
+				     phone_renewal create_time/);
+
+#-------------------------------------------------------------------------------
+
+package action::open_circulation;
+use base qw/action/;
+__PACKAGE__->table('action_open_circulation');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/xact_start usr target_copy circ_lib
+				     duration duration_rule renewal_remaining
+				     recurring_fine_rule recurring_fine stop_fines
+				     max_fine max_fine_rule fine_interval
+				     stop_fines xact_finish due_date opac_renewal
+				     checkin_staff circ_staff circ_lib checkin_lib
+				     stop_fines_time checkin_time desk_renewal
+				     phone_renewal/);
+
+#-------------------------------------------------------------------------------
+
+package action::hold_request;
+use base qw/action/;
+__PACKAGE__->table('action_hold_request');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/request_time capture_time fulfillment_time
+				     prev_check_time expire_time requestor usr cancel_cause
+				     hold_type holdable_formats target cancel_time shelf_time
+				     phone_notify email_notify selection_depth cancel_note
+				     pickup_lib current_copy request_lib frozen thaw_date mint_condition
+				     fulfillment_staff fulfillment_lib selection_ou cut_in_line/);
+
+#-------------------------------------------------------------------------------
+
+package action::hold_notification;
+use base qw/action/;
+__PACKAGE__->table('action_hold_notification');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/hold method notify_time note notify_staff/);
+
+#-------------------------------------------------------------------------------
+
+package action::hold_copy_map;
+use base qw/action/;
+__PACKAGE__->table('action_hold_copy_map');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/hold target_copy/);
+
+#-------------------------------------------------------------------------------
+
+package action::hold_transit_copy;
+use base qw/action/;
+__PACKAGE__->table('action_hold_transit_copy');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/source dest persistant_transfer target_copy
+				     source_send_time dest_recv_time prev_hop prev_dest
+				     copy_status hold/);
+
+#-------------------------------------------------------------------------------
+
+package action::reservation_transit_copy;
+use base qw/action/;
+__PACKAGE__->table('action_reservation_transit_copy');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/source dest persistant_transfer target_copy
+				     source_send_time dest_recv_time prev_hop prev_dest
+				     copy_status reservation/);
+
+#-------------------------------------------------------------------------------
+
+package action::transit_copy;
+use base qw/action/;
+__PACKAGE__->table('action_transit_copy');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/source dest persistant_transfer target_copy
+				     source_send_time dest_recv_time prev_hop prev_dest
+				     copy_status/);
+
+#-------------------------------------------------------------------------------
+
+package action::unfulfilled_hold_list;
+use base qw/action/;
+__PACKAGE__->table('action_unfulfilled_hold_list');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/hold current_copy circ_lib fail_time /);
+
+#-------------------------------------------------------------------------------
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/actor.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/actor.pm
new file mode 100644
index 0000000000..598fba9afa
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/actor.pm
@@ -0,0 +1,182 @@
+package OpenILS::Application::Storage::CDBI::actor;
+our $VERSION = 1;
+
+#-------------------------------------------------------------------------------
+package actor;
+use base qw/OpenILS::Application::Storage::CDBI/;
+#-------------------------------------------------------------------------------
+package actor::user;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_usr' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/usrname email first_given_name
+				second_given_name family_name billing_address
+				claims_returned_count home_ou dob deleted juvenile
+				active master_account ident_type ident_value
+				ident_type2 ident_value2 net_access_level alias
+				photo_url create_date expire_date credit_forward_balance
+				super_user usrgroup passwd card last_xact_id
+				standing barred profile prefix suffix alert_message
+				day_phone evening_phone other_phone mailing_address/ );
+
+#-------------------------------------------------------------------------------
+package actor::usr_org_unit_opt_in;
+use base qw/actor/;
+__PACKAGE__->table( 'actor_usr_org_unit_opt_in' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/org_unit usr staff opt_in_ts opt_in_ws/ );
+
+#-------------------------------------------------------------------------------
+package actor::org_unit_proximity;
+use base qw/actor/;
+__PACKAGE__->table( 'actor_org_unit_proximity' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/from_org to_org prox/ );
+
+#-------------------------------------------------------------------------------
+package actor::usr_note;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_usr_note' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/usr title creator create_date value pub/ );
+
+#-------------------------------------------------------------------------------
+package actor::workstation;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_workstation' );
+__PACKAGE__->columns( Primary => qw/id/);
+__PACKAGE__->columns( Essential => qw/name owning_lib/);
+
+#-------------------------------------------------------------------------------
+package actor::user_standing_penalty;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_user_standing_penalty' );
+__PACKAGE__->columns( Primary => qw/id/);
+__PACKAGE__->columns( Essential => qw/usr penalty_type/);
+
+#-------------------------------------------------------------------------------
+package actor::user_setting;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_user_setting' );
+__PACKAGE__->columns( Primary => qw/id/);
+__PACKAGE__->columns( Essential => qw/usr name value/);
+
+#-------------------------------------------------------------------------------
+package actor::org_unit_type;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_org_unit_type' );
+__PACKAGE__->columns( Primary => qw/id/);
+__PACKAGE__->columns( Essential => qw/name opac_label depth parent can_have_vols can_have_users/);
+
+#-------------------------------------------------------------------------------
+package actor::org_unit;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_org_unit' );
+__PACKAGE__->columns( Primary => qw/id/);
+__PACKAGE__->columns( Essential => qw/parent_ou ou_type mailing_address billing_address
+				ill_address holds_address shortname name email phone opac_visible fiscal_calendar/);
+
+#-------------------------------------------------------------------------------
+package actor::org_unit::hours_of_operation;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_hours_of_operation' );
+__PACKAGE__->columns( Primary => qw/id/);
+__PACKAGE__->columns( Essential => qw/dow_0_open dow_0_close dow_1_open dow_1_close dow_2_open dow_2_close
+					dow_3_open dow_3_close dow_4_open dow_4_close dow_5_open dow_5_close
+					dow_6_open dow_6_close/);
+
+#-------------------------------------------------------------------------------
+package actor::org_unit::closed_date;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_org_unit_closed' );
+__PACKAGE__->columns( Primary => qw/id/);
+__PACKAGE__->columns( Essential => qw/org_unit close_start close_end reason/);
+
+
+#-------------------------------------------------------------------------------
+package actor::org_unit_setting;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_org_unit_setting' );
+__PACKAGE__->columns( Primary => qw/id/);
+__PACKAGE__->columns( Essential => qw/org_unit name value/);
+
+
+#-------------------------------------------------------------------------------
+package actor::stat_cat;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_stat_cat' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/owner name opac_visible usr_summary/ );
+
+#-------------------------------------------------------------------------------
+package actor::stat_cat_entry;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_stat_cat_entry' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/stat_cat owner value/ );
+
+#-------------------------------------------------------------------------------
+package actor::stat_cat_entry_user_map;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_stat_cat_entry_usr_map' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/stat_cat stat_cat_entry target_usr/ );
+
+#-------------------------------------------------------------------------------
+package actor::card;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_card' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/usr barcode active/ );
+
+#-------------------------------------------------------------------------------
+package actor::user_access_entry;
+use base qw/actor/;
+#-------------------------------------------------------------------------------
+package actor::perm_group;
+use base qw/actor/;
+#-------------------------------------------------------------------------------
+package actor::permission;
+use base qw/actor/;
+#-------------------------------------------------------------------------------
+package actor::perm_group_permission_map;
+use base qw/actor/;
+#-------------------------------------------------------------------------------
+package actor::perm_group_user_map;
+use base qw/actor/;
+#-------------------------------------------------------------------------------
+package actor::user_address;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_usr_address' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/valid address_type usr street1 street2
+				      city county state country post_code
+				      within_city_limits/ );
+
+#-------------------------------------------------------------------------------
+package actor::org_address;
+use base qw/actor/;
+
+__PACKAGE__->table( 'actor_org_address' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/valid address_type org_unit street1 street2
+				      city county state country post_code/ );
+
+#-------------------------------------------------------------------------------
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/asset.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/asset.pm
new file mode 100644
index 0000000000..39eb01b2ad
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/asset.pm
@@ -0,0 +1,97 @@
+package OpenILS::Application::Storage::CDBI::asset;
+our $VERSION = 1;
+
+#-------------------------------------------------------------------------------
+package asset;
+use base qw/OpenILS::Application::Storage::CDBI/;
+#-------------------------------------------------------------------------------
+package asset::copy_location;
+use base qw/asset/;
+
+__PACKAGE__->table( 'asset_copy_location' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/name owning_lib holdable hold_verify opac_visible circulate label_prefix label_suffix/ );
+
+#-------------------------------------------------------------------------------
+package asset::copy_location_order;
+use base qw/asset/;
+
+__PACKAGE__->table( 'asset_copy_location_order' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/location org position/ );
+
+#-------------------------------------------------------------------------------
+package asset::call_number_class;
+use base qw/asset/;
+
+__PACKAGE__->table( 'asset_call_number_class' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/name normalizer field/ );
+
+#-------------------------------------------------------------------------------
+package asset::call_number;
+use base qw/asset/;
+
+__PACKAGE__->table( 'asset_call_number' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/record label creator create_date editor
+				   edit_date record label owning_lib deleted label_class label_sortkey/ );
+
+#-------------------------------------------------------------------------------
+package asset::call_number_note;
+use base qw/asset/;
+
+__PACKAGE__->table( 'asset_call_number_note' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/call_number title creator create_date value pub/ );
+
+#-------------------------------------------------------------------------------
+package asset::copy;
+use base qw/asset/;
+
+__PACKAGE__->table( 'asset_copy' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/call_number barcode creator create_date editor
+				   edit_date copy_number status loan_duration circ_lib dummy_isbn
+				   fine_level circulate deposit price ref opac_visible
+				   circ_as_type circ_modifier deposit_amount location mint_condition
+				   holdable dummy_title dummy_author deleted alert_message
+				   age_protect floating cost status_changed_time/ );
+
+#-------------------------------------------------------------------------------
+package asset::stat_cat;
+use base qw/asset/;
+
+__PACKAGE__->table( 'asset_stat_cat' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/owner name opac_visible required/ );
+
+#-------------------------------------------------------------------------------
+package asset::stat_cat_entry;
+use base qw/asset/;
+
+__PACKAGE__->table( 'asset_stat_cat_entry' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/stat_cat owner value/ );
+
+#-------------------------------------------------------------------------------
+package asset::stat_cat_entry_copy_map;
+use base qw/asset/;
+
+__PACKAGE__->table( 'asset_stat_cat_entry_copy_map' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/stat_cat stat_cat_entry owning_copy/ );
+
+#-------------------------------------------------------------------------------
+package asset::copy_note;
+use base qw/asset/;
+
+__PACKAGE__->table( 'asset_copy_note' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/owning_copy title creator create_date value pub/ );
+
+#-------------------------------------------------------------------------------
+
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/authority.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/authority.pm
new file mode 100644
index 0000000000..64a035032c
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/authority.pm
@@ -0,0 +1,47 @@
+package OpenILS::Application::Storage::CDBI::authority;
+our $VERSION = 1;
+
+#-------------------------------------------------------------------------------
+package authority;
+use base qw/OpenILS::Application::Storage::CDBI/;
+#-------------------------------------------------------------------------------
+package authority::record_entry;
+use base qw/authority/;
+
+authority::record_entry->table( 'authority_record_entry' );
+authority::record_entry->columns( Primary => qw/id/ );
+authority::record_entry->columns( Essential => qw/creator editor
+				      create_date edit_date source active
+				      deleted marc last_xact_id/ );
+
+#-------------------------------------------------------------------------------
+package authority::record_note;
+use base qw/authority/;
+
+authority::record_note->table( 'authority_record_note' );
+authority::record_note->columns( Primary => qw/id/ );
+authority::record_note->columns( Essential => qw/record value creator
+					editor create_date edit_date/ );
+#-------------------------------------------------------------------------------
+package authority::full_rec;
+use base qw/authority/;
+
+authority::full_rec->table( 'authority_full_rec' );
+authority::full_rec->columns( Primary => qw/id/ );
+authority::full_rec->columns( Essential => qw/record tag ind1 ind2 subfield value/ );
+
+#-------------------------------------------------------------------------------
+package authority::record_descriptor;
+use base qw/authority/;
+#use OpenILS::Application::Storage::CDBI::asset;
+
+authority::record_descriptor->table( 'authority_rec_descriptor' );
+authority::record_descriptor->columns( Primary => qw/id/ );
+authority::record_descriptor->columns( Essential => qw/record record_status
+						    char_encoding/ );
+
+#-------------------------------------------------------------------------------
+
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/biblio.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/biblio.pm
new file mode 100644
index 0000000000..46fefaab6e
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/biblio.pm
@@ -0,0 +1,26 @@
+package OpenILS::Application::Storage::CDBI::biblio;
+our $VERSION = 1;
+
+#-------------------------------------------------------------------------------
+package biblio;
+use base qw/OpenILS::Application::Storage::CDBI/;
+#-------------------------------------------------------------------------------
+package biblio::record_entry;
+use base qw/biblio/;
+
+biblio::record_entry->table( 'biblio_record_entry' );
+biblio::record_entry->columns( Essential => qw/id tcn_source tcn_value creator editor
+				      create_date edit_date source active quality owner share_depth
+				      deleted marc last_xact_id fingerprint/ );
+
+#-------------------------------------------------------------------------------
+package biblio::record_note;
+use base qw/biblio/;
+
+biblio::record_note->table( 'biblio_record_note' );
+biblio::record_note->columns( Essential => qw/id record value creator
+					editor create_date edit_date pub/ );
+#-------------------------------------------------------------------------------
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/booking.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/booking.pm
new file mode 100644
index 0000000000..e2b60fa5e1
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/booking.pm
@@ -0,0 +1,57 @@
+package OpenILS::Application::Storage::CDBI::booking;
+our $VERSION = 1;
+
+#-------------------------------------------------------------------------------
+package booking;
+use base qw/OpenILS::Application::Storage::CDBI/;
+#-------------------------------------------------------------------------------
+
+package booking::resource_type;
+use base qw/booking/;
+__PACKAGE__->table('booking_resource_type');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/name fine_interval fine_amount
+                     max_fine owner catalog_item record transferable elbow_room/);
+
+#-------------------------------------------------------------------------------
+
+package booking::resource;
+use base qw/booking/;
+__PACKAGE__->table('booking_resource');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/owner type overbook barcode deposit
+                     deposit_amount user_fee/);
+
+#-------------------------------------------------------------------------------
+
+package booking::reservation;
+use base qw/booking/;
+__PACKAGE__->table('booking_reservation');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/xact_start usr current_resource
+				     fine_amount max_fine fine_interval xact_finish 
+				     capture_staff pickup_lib request_time start_time end_time
+                     capture_time cancel_time pickup_time return_time
+                     booking_interval target_resource_type target_resource
+                     current_resource request_lib/);
+
+#-------------------------------------------------------------------------------
+
+package booking::resource_attr_map;
+use base qw/booking/;
+__PACKAGE__->table('booking_resource_attr_map');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/resource resource_attr value/);
+
+#-------------------------------------------------------------------------------
+
+package booking::reservation_attr_value_map;
+use base qw/booking/;
+__PACKAGE__->table('booking_reservation_attr_value_map');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/reservation attr_value/);
+
+#-------------------------------------------------------------------------------
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/config.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/config.pm
new file mode 100644
index 0000000000..bde4372981
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/config.pm
@@ -0,0 +1,137 @@
+package OpenILS::Application::Storage::CDBI::config;
+our $VERSION = 1;
+
+#-------------------------------------------------------------------------------
+package config;
+use base qw/OpenILS::Application::Storage::CDBI/;
+#-------------------------------------------------------------------------------
+
+package config::non_cataloged_type;
+use base qw/config/;
+__PACKAGE__->table('config_non_cataloged_type');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/owning_lib name circ_duration in_house/);
+#-------------------------------------------------------------------------------
+
+package config::standing;
+use base qw/config/;
+__PACKAGE__->table('config_standing');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/value/);
+#-------------------------------------------------------------------------------
+
+package config::bib_source;
+use base qw/config/;
+__PACKAGE__->table('config_bib_source');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/quality source transcendant/);
+#-------------------------------------------------------------------------------
+
+package config::metabib_field;
+use base qw/config/;
+__PACKAGE__->table('config_metabib_field');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/field_class name xpath weight format search_field facet_field/);
+#-------------------------------------------------------------------------------
+
+package config::identification_type;
+use base qw/config/;
+__PACKAGE__->table('config_identification_type');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/name/);
+#-------------------------------------------------------------------------------
+
+package config::rules::circ_duration;
+use base qw/config/;
+__PACKAGE__->table('config_rule_circ_duration');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/name extended normal shrt max_renewals/);
+#-------------------------------------------------------------------------------
+
+package config::rules::max_fine;
+use base qw/config/;
+__PACKAGE__->table('config_rule_max_fine');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/name amount is_percent/);
+#-------------------------------------------------------------------------------
+
+package config::rules::recurring_fine;
+use base qw/config/;
+__PACKAGE__->table('config_rule_recurring_fine');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/name high normal low recurrence_interval/);
+#-------------------------------------------------------------------------------
+
+package config::rules::age_hold_protect;
+use base qw/config/;
+__PACKAGE__->table('config_rule_age_hold_protect');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/name age prox/);
+#-------------------------------------------------------------------------------
+
+package config::copy_status;
+use base qw/config/;
+__PACKAGE__->table('config_copy_status');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/name holdable opac_visible/);
+#-------------------------------------------------------------------------------
+
+package config::net_access_level;
+use base qw/config/;
+__PACKAGE__->table('config_net_access_level');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/name/);
+#-------------------------------------------------------------------------------
+
+package config::audience_map;
+use base qw/config/;
+__PACKAGE__->table('config_audience_map');
+__PACKAGE__->columns(Primary => 'code');
+__PACKAGE__->columns(Essential => qw/value description/);
+#-------------------------------------------------------------------------------
+
+package config::lit_form_map;
+use base qw/config/;
+__PACKAGE__->table('config_lit_form_map');
+__PACKAGE__->columns(Primary => 'code');
+__PACKAGE__->columns(Essential => qw/value description/);
+#-------------------------------------------------------------------------------
+
+package config::item_form_map;
+use base qw/config/;
+__PACKAGE__->table('config_lit_form_map');
+__PACKAGE__->columns(Primary => 'code');
+__PACKAGE__->columns(Essential => qw/value/);
+#-------------------------------------------------------------------------------
+
+package config::item_type_map;
+use base qw/config/;
+__PACKAGE__->table('config_lit_form_map');
+__PACKAGE__->columns(Primary => 'code');
+__PACKAGE__->columns(Essential => qw/value/);
+#-------------------------------------------------------------------------------
+
+package config::language_map;
+use base qw/config/;
+__PACKAGE__->table('config_language_map');
+__PACKAGE__->columns(Primary => 'code');
+__PACKAGE__->columns(Essential => qw/value/);
+#-------------------------------------------------------------------------------
+
+package config::i18n_locale;
+use base qw/config/;
+__PACKAGE__->table('config_i18n_locale');
+__PACKAGE__->columns(Primary => 'code');
+__PACKAGE__->columns(Essential => qw/marc_code name description/);
+#-------------------------------------------------------------------------------
+
+package config::i18n_core;
+use base qw/config/;
+__PACKAGE__->table('config_i18n_core');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/fq_field identity_value translation string/);
+#-------------------------------------------------------------------------------
+
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/container.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/container.pm
new file mode 100644
index 0000000000..c26d7ae5f0
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/container.pm
@@ -0,0 +1,73 @@
+package OpenILS::Application::Storage::CDBI::container;
+our $VERSION = 1;
+
+#-------------------------------------------------------------------------------
+package container;
+use base qw/OpenILS::Application::Storage::CDBI/;
+#-------------------------------------------------------------------------------
+package container::user_bucket;
+use base qw/container/;
+
+container::user_bucket->table( 'container_user_bucket' );
+container::user_bucket->columns( Primary => qw/id/ );
+container::user_bucket->columns( Essential => qw/owner name btype pub/ );
+
+#-------------------------------------------------------------------------------
+package container::user_bucket_item;
+use base qw/container/;
+
+container::user_bucket_item->table( 'container_user_bucket_item' );
+container::user_bucket_item->columns( Primary => qw/id/ );
+container::user_bucket_item->columns( Essential => qw/bucket target_user/ );
+
+#-------------------------------------------------------------------------------
+package container::copy_bucket;
+use base qw/container/;
+
+container::copy_bucket->table( 'container_copy_bucket' );
+container::copy_bucket->columns( Primary => qw/id/ );
+container::copy_bucket->columns( Essential => qw/owner name btype pub/ );
+
+#-------------------------------------------------------------------------------
+package container::copy_bucket_item;
+use base qw/container/;
+
+container::copy_bucket_item->table( 'container_copy_bucket_item' );
+container::copy_bucket_item->columns( Primary => qw/id/ );
+container::copy_bucket_item->columns( Essential => qw/bucket target_copy/ );
+
+#-------------------------------------------------------------------------------
+package container::biblio_record_entry_bucket;
+use base qw/container/;
+
+container::biblio_record_entry_bucket->table( 'container_biblio_record_entry_bucket' );
+container::biblio_record_entry_bucket->columns( Primary => qw/id/ );
+container::biblio_record_entry_bucket->columns( Essential => qw/owner name btype pub/ );
+
+#-------------------------------------------------------------------------------
+package container::biblio_record_entry_bucket_item;
+use base qw/container/;
+
+container::biblio_record_entry_bucket_item->table( 'container_biblio_record_entry_bucket_item' );
+container::biblio_record_entry_bucket_item->columns( Primary => qw/id/ );
+container::biblio_record_entry_bucket_item->columns( Essential => qw/bucket target_biblio_record_entry/ );
+
+#-------------------------------------------------------------------------------
+package container::call_number_bucket;
+use base qw/container/;
+
+container::call_number_bucket->table( 'container_call_number_bucket' );
+container::call_number_bucket->columns( Primary => qw/id/ );
+container::call_number_bucket->columns( Essential => qw/owner name btype pub/ );
+
+#-------------------------------------------------------------------------------
+package container::call_number_bucket_item;
+use base qw/container/;
+
+container::call_number_bucket_item->table( 'container_call_number_bucket_item' );
+container::call_number_bucket_item->columns( Primary => qw/id/ );
+container::call_number_bucket_item->columns( Essential => qw/bucket target_call_number/ );
+
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/metabib.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/metabib.pm
new file mode 100644
index 0000000000..1316e93279
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/metabib.pm
@@ -0,0 +1,97 @@
+package OpenILS::Application::Storage::CDBI::metabib;
+our $VERSION = 1;
+
+#-------------------------------------------------------------------------------
+package metabib;
+use base qw/OpenILS::Application::Storage::CDBI/;
+#-------------------------------------------------------------------------------
+package metabib::metarecord;
+use base qw/metabib/;
+
+metabib::metarecord->table( 'metabib_metarecord' );
+metabib::metarecord->columns( Primary => qw/id/ );
+metabib::metarecord->columns( Essential => qw/fingerprint master_record mods/ );
+
+#-------------------------------------------------------------------------------
+package metabib::identifier_field_entry;
+use base qw/metabib/;
+
+metabib::identifier_field_entry->table( 'metabib_identifier_field_entry' );
+metabib::identifier_field_entry->columns( Primary => qw/id/ );
+metabib::identifier_field_entry->columns( Essential => qw/field value source/ );
+
+
+#-------------------------------------------------------------------------------
+package metabib::title_field_entry;
+use base qw/metabib/;
+
+metabib::title_field_entry->table( 'metabib_title_field_entry' );
+metabib::title_field_entry->columns( Primary => qw/id/ );
+metabib::title_field_entry->columns( Essential => qw/field value source/ );
+
+
+#-------------------------------------------------------------------------------
+package metabib::author_field_entry;
+use base qw/metabib/;
+
+metabib::author_field_entry->table( 'metabib_author_field_entry' );
+metabib::author_field_entry->columns( Primary => qw/id/ );
+metabib::author_field_entry->columns( Essential => qw/field value source/ );
+
+
+#-------------------------------------------------------------------------------
+package metabib::subject_field_entry;
+use base qw/metabib/;
+
+metabib::subject_field_entry->table( 'metabib_subject_field_entry' );
+metabib::subject_field_entry->columns( Primary => qw/id/ );
+metabib::subject_field_entry->columns( Essential => qw/field value source/ );
+
+
+#-------------------------------------------------------------------------------
+package metabib::keyword_field_entry;
+use base qw/metabib/;
+
+metabib::keyword_field_entry->table( 'metabib_keyword_field_entry' );
+metabib::keyword_field_entry->columns( Primary => qw/id/ );
+metabib::keyword_field_entry->columns( Essential => qw/field value source/ );
+
+#-------------------------------------------------------------------------------
+package metabib::series_field_entry;
+use base qw/metabib/;
+
+metabib::series_field_entry->table( 'metabib_series_field_entry' );
+metabib::series_field_entry->columns( Primary => qw/id/ );
+metabib::series_field_entry->columns( Essential => qw/field value source/ );
+
+#-------------------------------------------------------------------------------
+package metabib::metarecord_source_map;
+use base qw/metabib/;
+
+metabib::metarecord_source_map->table( 'metabib_metarecord_source_map' );
+metabib::metarecord_source_map->columns( Primary => qw/id/ );
+metabib::metarecord_source_map->columns( Essential => qw/metarecord source/ );
+
+#-------------------------------------------------------------------------------
+package metabib::full_rec;
+use base qw/metabib/;
+
+metabib::full_rec->table( 'metabib_full_rec' );
+metabib::full_rec->columns( Primary => qw/id/ );
+metabib::full_rec->columns( Essential => qw/record tag ind1 ind2 subfield value/ );
+
+#-------------------------------------------------------------------------------
+package metabib::record_descriptor;
+use base qw/metabib/;
+#use OpenILS::Application::Storage::CDBI::asset;
+
+metabib::record_descriptor->table( 'metabib_rec_descriptor' );
+metabib::record_descriptor->columns( Primary => qw/id/ );
+metabib::record_descriptor->columns( Essential => qw/record item_type item_form bib_level
+					 control_type char_encoding enc_level lit_form vr_format
+					 cat_form pub_status item_lang audience type_mat date1 date2/ );
+
+#-------------------------------------------------------------------------------
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/money.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/money.pm
new file mode 100644
index 0000000000..ab21f8495d
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/money.pm
@@ -0,0 +1,148 @@
+package OpenILS::Application::Storage::CDBI::money;
+our $VERSION = 1;
+
+#-------------------------------------------------------------------------------
+package money;
+use base qw/OpenILS::Application::Storage::CDBI/;
+#-------------------------------------------------------------------------------
+
+package money::collections_tracker;
+use base qw/money/;
+__PACKAGE__->table('money_collections_tracker');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/usr collector location enter_time/);
+#-------------------------------------------------------------------------------
+
+package money::billable_transaction;
+use base qw/money/;
+__PACKAGE__->table('money_billable_xact');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/xact_start usr xact_finish unrecovered/);
+#-------------------------------------------------------------------------------
+
+package money::grocery;
+use base qw/money/;
+__PACKAGE__->table('money_grocery');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/xact_start usr billing_location note xact_finish/);
+#-------------------------------------------------------------------------------
+
+package money::open_user_summary;
+use base qw/money/;
+__PACKAGE__->table('money_open_user_summary');
+__PACKAGE__->columns(Primary => 'usr');
+__PACKAGE__->columns(Essential => qw/total_paid total_owed balance_owed/);
+#-------------------------------------------------------------------------------
+
+package money::user_summary;
+use base qw/money/;
+__PACKAGE__->table('money_user_summary');
+__PACKAGE__->columns(Primary => 'usr');
+__PACKAGE__->columns(Essential => qw/total_paid total_owed balance_owed/);
+#-------------------------------------------------------------------------------
+
+package money::open_user_circulation_summary;
+use base qw/money/;
+__PACKAGE__->table('money_open_user_circulation_summary');
+__PACKAGE__->columns(Primary => 'usr');
+__PACKAGE__->columns(Essential => qw/total_paid total_owed balance_owed/);
+#-------------------------------------------------------------------------------
+
+package money::user_circulation_summary;
+use base qw/money/;
+__PACKAGE__->table('money_user_circulation_summary');
+__PACKAGE__->columns(Primary => 'usr');
+__PACKAGE__->columns(Essential => qw/total_paid total_owed balance_owed/);
+#-------------------------------------------------------------------------------
+
+package money::open_billable_transaction_summary;
+use base qw/money/;
+__PACKAGE__->table('money_open_billable_transaction_summary');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/xact_start usr xact_finish total_paid
+				     last_payment_ts total_owed last_billing_ts
+				     balance_owed xact_type last_billing_note last_billing_type
+				     last_payment_note last_payment_type/);
+#-------------------------------------------------------------------------------
+
+package money::billable_transaction_summary;
+use base qw/money/;
+__PACKAGE__->table('money_billable_transaction_summary');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/xact_start usr xact_finish total_paid
+				     last_payment_ts total_owed last_billing_ts
+				     balance_owed xact_type last_billing_note last_billing_type
+				     last_payment_note last_payment_type/);
+#-------------------------------------------------------------------------------
+
+package money::billing;
+use base qw/money/;
+__PACKAGE__->table('money_billing');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/xact amount billing_ts billing_type note
+                                     voided voider void_time btype/);
+#-------------------------------------------------------------------------------
+
+package money::payment;
+use base qw/money/;
+__PACKAGE__->table('money_payment');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/xact amount payment_ts payment_type note voided/);
+#-------------------------------------------------------------------------------
+
+package money::desk_payment;
+use base qw/money/;
+__PACKAGE__->table('money_desk_payment');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/xact amount payment_ts voided amount_collected accepting_usr cash_drawer payment_type note/);
+#-------------------------------------------------------------------------------
+
+package money::cash_payment;
+use base qw/money/;
+__PACKAGE__->table('money_cash_payment');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/xact amount payment_ts cash_drawer accepting_usr amount_collected note/);
+#-------------------------------------------------------------------------------
+
+package money::check_payment;
+use base qw/money/;
+__PACKAGE__->table('money_check_payment');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/xact amount payment_ts cash_drawer check_number accepting_usr amount_collected note/);
+#-------------------------------------------------------------------------------
+
+package money::credit_card_payment;
+use base qw/money/;
+__PACKAGE__->table('money_credit_card_payment');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/xact amount payment_ts cash_drawer
+				     accepting_usr amount_collected cc_type
+				     cc_number expire_month expire_year
+				     approval_code note/);
+#-------------------------------------------------------------------------------
+
+package money::forgive_payment;
+use base qw/money/;
+__PACKAGE__->table('money_forgive_payment');
+__PACKAGE__->columns(Primary => 'id');
+__PACKAGE__->columns(Essential => qw/xact amount payment_ts accepting_usr amount_collected note/);
+#-------------------------------------------------------------------------------
+
+package money::work_payment;
+use base qw/money::forgive_payment/;
+__PACKAGE__->table('money_work_payment');
+#-------------------------------------------------------------------------------
+
+package money::goods_payment;
+use base qw/money::forgive_payment/;
+__PACKAGE__->table('money_goods_payment');
+#-------------------------------------------------------------------------------
+
+package money::credit_payment;
+use base qw/money::forgive_payment/;
+__PACKAGE__->table('money_credit_payment');
+
+#-------------------------------------------------------------------------------
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/permission.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/permission.pm
new file mode 100644
index 0000000000..f56e1e585e
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/permission.pm
@@ -0,0 +1,46 @@
+package OpenILS::Application::Storage::CDBI::permission;
+our $VERSION = 1;
+
+#-------------------------------------------------------------------------------
+package permission;
+use base qw/OpenILS::Application::Storage::CDBI/;
+#-------------------------------------------------------------------------------
+package permission::perm_list;
+use base qw/permission/;
+__PACKAGE__->table('permission_perm_list');
+__PACKAGE__->columns(Primary => qw/id/);
+__PACKAGE__->columns(Essential => qw/code description/);
+#-------------------------------------------------------------------------------
+package permission::grp_tree;
+use base qw/permission/;
+__PACKAGE__->table('permission_grp_tree');
+__PACKAGE__->columns(Primary => qw/id/);
+__PACKAGE__->columns(Essential => qw/name parent description perm_interval
+				     application_perm usergroup hold_priority/);
+#-------------------------------------------------------------------------------
+package permission::usr_grp_map;
+use base qw/permission/;
+__PACKAGE__->table('permission_usr_grp_map');
+__PACKAGE__->columns(Primary => qw/id/);
+__PACKAGE__->columns(Essential => qw/usr grp/);
+#-------------------------------------------------------------------------------
+package permission::usr_perm_map;
+use base qw/permission/;
+__PACKAGE__->table('permission_usr_perm_map');
+__PACKAGE__->columns(Primary => qw/id/);
+__PACKAGE__->columns(Essential => qw/usr perm depth grantable/);
+#-------------------------------------------------------------------------------
+package permission::grp_perm_map;
+use base qw/permission/;
+__PACKAGE__->table('permission_grp_perm_map');
+__PACKAGE__->columns(Primary => qw/id/);
+__PACKAGE__->columns(Essential => qw/grp perm depth grantable/);
+#-------------------------------------------------------------------------------
+package permission::usr_work_ou_map;
+use base qw/permission/;
+__PACKAGE__->table('permission_usr_work_ou_map');
+__PACKAGE__->columns(Primary => qw/id/);
+__PACKAGE__->columns(Essential => qw/usr work_ou/);
+#-------------------------------------------------------------------------------
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/serial.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/serial.pm
new file mode 100644
index 0000000000..431c6729e8
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/CDBI/serial.pm
@@ -0,0 +1,62 @@
+package OpenILS::Application::Storage::CDBI::serial;
+our $VERSION = 1;
+
+#-------------------------------------------------------------------------------
+package serial;
+use base qw/OpenILS::Application::Storage::CDBI/;
+#-------------------------------------------------------------------------------
+package serial::subscription;
+use base qw/serial/;
+
+__PACKAGE__->table( 'serial_subscription' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/record_entry start_date end_date
+				   expected_date_offset owning_lib/ );
+
+#-------------------------------------------------------------------------------
+package serial::issuance;
+use base qw/serial/;
+
+__PACKAGE__->table( 'serial_issuance' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/creator editor create_date edit_date
+                                      subscription label date_published
+                                      caption_and_pattern holding_code
+                                      holding_type holding_link_id/ );
+
+#-------------------------------------------------------------------------------
+package serial::item;
+use base qw/serial/;
+
+__PACKAGE__->table( 'serial_item' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/creator editor create_date edit_date
+                                      issuance stream unit uri date_expected
+                                      date_received/ );
+
+#-------------------------------------------------------------------------------
+package serial::unit;
+use base qw/serial/;
+
+__PACKAGE__->table( 'serial_unit' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/call_number barcode creator create_date editor
+				   edit_date copy_number status loan_duration circ_lib
+				   fine_level circulate deposit price ref opac_visible dummy_isbn
+				   circ_as_type circ_modifier deposit_amount location mint_condition
+				   holdable dummy_title dummy_author deleted alert_message
+				   age_protect floating summary_contents detailed_contents/ );
+
+#-------------------------------------------------------------------------------
+package serial::record_entry;
+use base qw/serial/;
+
+__PACKAGE__->table( 'serial_record_entry' );
+__PACKAGE__->columns( Primary => qw/id/ );
+__PACKAGE__->columns( Essential => qw/active record create_date creator
+                        deleted edit_date editor id last_xact_id marc source
+                        owning_lib/ );
+
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg.pm
new file mode 100644
index 0000000000..8fd85155d3
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg.pm
@@ -0,0 +1,195 @@
+
+{ # The driver package itself just needs a db_Main method (or db_Slaves if
+  #Class::DBI::Replication is in use) for Class::DBI to call.
+  #
+  # Any other fixups can go in here too... Also, the drivers should subclass the
+  # DBI driver that they are wrapping, or provide a 'quote()' method that calls
+  # the DBD::xxx::quote() method on FTI's behalf.
+  #
+  # The dirver MUST be a subclass of Class::DBI(::Replication) and
+  # OpenILS::Application::Storage.
+  #-------------------------------------------------------------------------------
+	package OpenILS::Application::Storage::Driver::Pg;
+	use OpenILS::Application::Storage::Driver::Pg::cdbi;
+	use OpenILS::Application::Storage::Driver::Pg::fts;
+	use OpenILS::Application::Storage::Driver::Pg::storage;
+	use OpenILS::Application::Storage::Driver::Pg::dbi;
+	use UNIVERSAL::require; 
+	BEGIN {                 
+		'Class::DBI::Frozen::301'->use or 'Class::DBI'->use or die $@;
+	}     
+	use base qw/Class::DBI OpenILS::Application::Storage/;
+	use DBI;
+	use OpenSRF::EX qw/:try/;
+	use OpenSRF::DomainObject::oilsResponse;
+	use OpenSRF::Utils::Logger qw/:level/;
+	my $log = 'OpenSRF::Utils::Logger';
+
+	__PACKAGE__->set_sql( retrieve_limited => 'SELECT * FROM __TABLE__ ORDER BY id LIMIT ?' );
+	__PACKAGE__->set_sql( copy_start => 'COPY %s (%s) FROM STDIN;' );
+	__PACKAGE__->set_sql( copy_end => '\.' );
+
+	my $master_db;
+	my @slave_dbs;
+	my $_db_params;
+
+	sub db_Handles {
+		return ($master_db, @slave_dbs);
+	}
+
+	sub child_init {
+		my $self = shift;
+		$_db_params = shift;
+
+		$log->debug("Running child_init inside ".__PACKAGE__, INTERNAL);
+
+		$_db_params = [ $_db_params ] unless (ref($_db_params) eq 'ARRAY');
+
+		my %attrs = (	%{$self->_default_attributes},
+				RootClass => 'DBIx::ContextualFetch',
+				ShowErrorStatement => 1,
+				RaiseError => 1,
+				AutoCommit => 1,
+				PrintError => 1,
+				Taint => 1,
+				#TraceLevel => "1|SQL",
+				pg_enable_utf8 => 1,
+				pg_server_prepare => 0,
+				FetchHashKeyName => 'NAME_lc',
+				ChopBlanks => 1,
+		);
+
+		my $master = shift @$_db_params;
+		$$master{port} ||= '5432';
+		$$master{host} ||= 'localhost';
+		$$master{db} ||= 'openils';
+
+		$log->debug("Attempting to connect to $$master{db} at $$master{host}", INFO);
+
+		try {
+			$master_db = DBI->connect(
+				"dbi:Pg:".
+					"host=$$master{host};".
+					"port=$$master{port};".
+					"dbname=$$master{db}",
+				$$master{user},
+				$$master{pw},
+				\%attrs)
+			|| do { sleep(1);
+				DBI->connect(
+					"dbi:Pg:".
+						"host=$$master{host};".
+						"port=$$master{port};".
+						"dbname=$$master{db}",
+					$$master{user},
+					$$master{pw},
+					\%attrs) }
+			|| throw OpenSRF::EX::ERROR
+				("Couldn't connect to $$master{db}".
+				 " on $$master{host}::$$master{port}".
+				 " as $$master{user}!!");
+		} catch Error with {
+			my $e = shift;
+			$log->debug("Error connecting to database:\n\t$e\n\t$DBI::errstr", ERROR);
+			throw $e;
+		};
+
+		$log->debug("Connected to MASTER db $$master{db} at $$master{host}", INFO);
+		
+		$master_db->do("SET NAMES '$$master{client_encoding}';") if ($$master{client_encoding});
+
+		for my $db (@$_db_params) {
+			try {
+				push @slave_dbs, DBI->connect("dbi:Pg:host=$$db{host};port=$$db{port};dbname=$$db{db}",$$db{user},$$db{pw}, \%attrs)
+					|| do { sleep(1); DBI->connect("dbi:Pg:host=$$db{host};port=$$db{port};dbname=$$db{db}",$$db{user},$$db{pw}, \%attrs) }
+					|| throw OpenSRF::EX::ERROR
+						("Couldn't connect to $$db{db}".
+				 		" on $$db{host}::$$db{port}".
+				 		" as $$db{user}!!");
+			} catch Error with {
+				my $e = shift;
+				$log->debug("Error connecting to database:\n\t$e\n\t$DBI::errstr", ERROR);
+				throw $e;
+			};
+
+			$slave_dbs[-1]->do("SET NAMES '$$db{client_encoding}';") if ($$master{client_encoding});
+
+			$log->debug("Connected to MASTER db '$$master{db} at $$master{host}", INFO);
+		}
+
+		$log->debug("All is well on the western front", INTERNAL);
+	}
+
+	sub db_Main {
+		my $self = shift;
+		return $master_db if ($self->current_xact_session || $OpenILS::Application::Storage::WRITE);
+		return $master_db unless (@slave_dbs);
+		return ($master_db, @slave_dbs)[rand(scalar(@slave_dbs))];
+	}
+
+	sub quote {
+		my $self = shift;
+		return $self->db_Main->quote(@_)
+	}
+
+#	sub tsearch2_trigger {
+#		my $self = shift;
+#		return unless ($self->value);
+#		$self->index_vector(
+#			$self->db_Slaves->selectrow_array(
+#				"SELECT to_tsvector('default',?);",
+#				{},
+#				$self->value
+#			)
+#		);
+#	}
+
+	my $_xact_session;
+
+	sub current_xact_session {
+		my $self = shift;
+		if (defined($_xact_session)) {
+			return $_xact_session;
+		}
+		return undef;
+	}
+
+	sub current_xact_is_auto {
+		my $self = shift;
+		my $auto = shift;
+		if (defined($_xact_session) and ref($_xact_session)) {
+			if (defined $auto) {
+				$_xact_session->session_data(autocommit => $auto);
+			}
+			return $_xact_session->session_data('autocommit'); 
+		}
+	}
+
+	sub current_xact_id {
+		my $self = shift;
+		if (defined($_xact_session) and ref($_xact_session)) {
+			return $_xact_session->session_id;
+		}
+		return undef;
+	}
+
+	sub set_xact_session {
+		my $self = shift;
+		my $ses = shift;
+		if (!defined($ses)) {
+			return undef;
+		}
+		$_xact_session = $ses;
+		return $_xact_session;
+	}
+
+	sub unset_xact_session {
+		my $self = shift;
+		my $ses = $_xact_session;
+		undef $_xact_session;
+		return $ses;
+	}
+
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm
new file mode 100644
index 0000000000..a27081e1d0
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/QueryParser.pm
@@ -0,0 +1,837 @@
+package OpenILS::Application::Storage::Driver::Pg::QueryParser;
+use OpenILS::Application::Storage::QueryParser;
+use base 'QueryParser';
+use OpenSRF::Utils::JSON;
+use OpenILS::Application::AppUtils;
+my $U = 'OpenILS::Application::AppUtils';
+
+sub quote_value {
+    my $self = shift;
+    my $value = shift;
+
+    if ($value =~ /^\d/) { # may have to use non-$ quoting
+        $value =~ s/'/''/g;
+        $value =~ s/\\/\\\\/g;
+        return "E'$value'";
+    }
+    return "\$_$$\$$value\$_$$\$";
+}
+
+sub quote_phrase_value {
+    my $self = shift;
+    my $value = shift;
+
+    my $left_anchored  = $value =~ m/^\^/;
+    my $right_anchored = $value =~ m/\$$/;
+    $value =~ s/\^//   if $left_anchored;
+    $value =~ s/\$$//  if $right_anchored;
+    $value =~ quotemeta($value);
+    $value = '^' . $value if $left_anchored;
+    $value = "$value\$"   if $right_anchored;
+    return $self->quote_value($value);
+}
+
+sub init {
+    my $class = shift;
+
+}
+
+sub default_preferred_language {
+    my $self = shift;
+    my $lang = shift;
+
+    $self->custom_data->{default_preferred_language} = $lang if ($lang);
+    return $self->custom_data->{default_preferred_language};
+}
+
+sub default_preferred_language_multiplier {
+    my $self = shift;
+    my $lang = shift;
+
+    $self->custom_data->{default_preferred_language_multiplier} = $lang if ($lang);
+    return $self->custom_data->{default_preferred_language_multiplier};
+}
+
+sub simple_plan {
+    my $self = shift;
+
+    return 0 unless $self->parse_tree;
+    return 0 if @{$self->parse_tree->filters};
+    return 0 if @{$self->parse_tree->modifiers};
+    for my $node ( @{ $self->parse_tree->query_nodes } ) {
+        return 0 if (!ref($node) && $node eq '|');
+        next unless (ref($node));
+        return 0 if ($node->isa('QueryParser::query_plan'));
+    }
+
+    return 1;
+}
+
+sub toSQL {
+    my $self = shift;
+    return $self->parse_tree->toSQL;
+}
+
+sub facet_field_id_map {
+    my $self = shift;
+    my $map = shift;
+
+    $self->custom_data->{facet_field_id_map} ||= {};
+    $self->custom_data->{facet_field_id_map} = $map if ($map);
+    return $self->custom_data->{facet_field_id_map};
+}
+
+sub add_facet_field_id_map {
+    my $self = shift;
+    my $class = shift;
+    my $field = shift;
+    my $id = shift;
+    my $weight = shift;
+
+    $self->add_facet_field( $class => $field );
+    $self->facet_field_id_map->{by_id}{$id} = { classname => $class, field => $field, weight => $weight };
+    $self->facet_field_id_map->{by_class}{$class}{$field} = $id;
+
+    return {
+        by_id => { $id => { classname => $class, field => $field, weight => $weight } },
+        by_class => { $class => { $field => $id } }
+    };
+}
+
+sub facet_field_class_by_id {
+    my $self = shift;
+    my $id = shift;
+
+    return $self->facet_field_id_map->{by_id}{$id};
+}
+
+sub facet_field_ids_by_class {
+    my $self = shift;
+    my $class = shift;
+    my $field = shift;
+
+    return undef unless ($class);
+
+    if ($field) {
+        return [$self->facet_field_id_map->{by_class}{$class}{$field}];
+    }
+
+    return [values( %{ $self->facet_field_id_map->{by_class}{$class} } )];
+}
+
+sub search_field_id_map {
+    my $self = shift;
+    my $map = shift;
+
+    $self->custom_data->{search_field_id_map} ||= {};
+    $self->custom_data->{search_field_id_map} = $map if ($map);
+    return $self->custom_data->{search_field_id_map};
+}
+
+sub add_search_field_id_map {
+    my $self = shift;
+    my $class = shift;
+    my $field = shift;
+    my $id = shift;
+    my $weight = shift;
+
+    $self->add_search_field( $class => $field );
+    $self->search_field_id_map->{by_id}{$id} = { classname => $class, field => $field, weight => $weight };
+    $self->search_field_id_map->{by_class}{$class}{$field} = $id;
+
+    return {
+        by_id => { $id => { classname => $class, field => $field, weight => $weight } },
+        by_class => { $class => { $field => $id } }
+    };
+}
+
+sub search_field_class_by_id {
+    my $self = shift;
+    my $id = shift;
+
+    return $self->search_field_id_map->{by_id}{$id};
+}
+
+sub search_field_ids_by_class {
+    my $self = shift;
+    my $class = shift;
+    my $field = shift;
+
+    return undef unless ($class);
+
+    if ($field) {
+        return [$self->search_field_id_map->{by_class}{$class}{$field}];
+    }
+
+    return [values( %{ $self->search_field_id_map->{by_class}{$class} } )];
+}
+
+sub relevance_bumps {
+    my $self = shift;
+    my $bumps = shift;
+
+    $self->custom_data->{rel_bumps} ||= {};
+    $self->custom_data->{rel_bumps} = $bumps if ($bumps);
+    return $self->custom_data->{rel_bumps};
+}
+
+sub find_relevance_bumps {
+    my $self = shift;
+    my $class = shift;
+    my $field = shift;
+
+    return $self->relevance_bumps->{$class}{$field};
+}
+
+sub add_relevance_bump {
+    my $self = shift;
+    my $class = shift;
+    my $field = shift;
+    my $type = shift;
+    my $multiplier = shift;
+    my $active = shift;
+
+    $active = 1 if (!defined($active));
+
+    $self->relevance_bumps->{$class}{$field}{$type} = { multiplier => $multiplier, active => $active };
+
+    return { $class => { $field => { $type => { multiplier => $multiplier, active => $active } } } };
+}
+
+
+sub initialize_search_field_id_map {
+    my $self = shift;
+    my $cmf_list = shift;
+
+    for my $cmf (@$cmf_list) {
+        __PACKAGE__->add_search_field_id_map( $cmf->field_class, $cmf->name, $cmf->id, $cmf->weight ) if ($U->is_true($cmf->search_field));
+        __PACKAGE__->add_facet_field_id_map( $cmf->field_class, $cmf->name, $cmf->id, $cmf->weight ) if ($U->is_true($cmf->facet_field));
+    }
+
+    return $self->search_field_id_map;
+}
+
+sub initialize_aliases {
+    my $self = shift;
+    my $cmsa_list = shift;
+
+    for my $cmsa (@$cmsa_list) {
+        if (!$cmsa->field) {
+            __PACKAGE__->add_search_class_alias( $cmsa->field_class, $cmsa->alias );
+        } else {
+            my $c = $self->search_field_class_by_id( $cmsa->field );
+            __PACKAGE__->add_search_field_alias( $cmsa->field_class, $c->{field}, $cmsa->alias );
+        }
+    }
+}
+
+sub initialize_relevance_bumps {
+    my $self = shift;
+    my $sra_list = shift;
+
+    for my $sra (@$sra_list) {
+        my $c = $self->search_field_class_by_id( $sra->field );
+        __PACKAGE__->add_relevance_bump( $c->{classname}, $c->{field}, $sra->bump_type, $sra->multiplier );
+    }
+
+    return $self->relevance_bumps;
+}
+
+sub initialize_normalizers {
+    my $self = shift;
+    my $tree = shift; # open-ils.cstore.direct.config.metabib_field_index_norm_map.search.atomic { "id" : { "!=" : null } }, { "flesh" : 1, "flesh_fields" : { "cmfinm" : ["norm"] }, "order_by" : [{ "class" : "cmfinm", "field" : "pos" }] }
+
+    for my $cmfinm ( @$tree ) {
+        my $field_info = $self->search_field_class_by_id( $cmfinm->field );
+        __PACKAGE__->add_query_normalizer( $field_info->{classname}, $field_info->{field}, $cmfinm->norm->func, OpenSRF::Utils::JSON->JSON2perl($cmfinm->params) );
+    }
+}
+
+our $_complete = 0;
+sub initialization_complete {
+    return $_complete;
+}
+
+sub initialize {
+    my $self = shift;
+    my %args = @_;
+
+    return $_complete if ($_complete);
+
+    $self->initialize_search_field_id_map( $args{config_metabib_field} )
+        if ($args{config_metabib_field});
+
+    $self->initialize_aliases( $args{config_metabib_search_alias} )
+        if ($args{config_metabib_search_alias});
+
+    $self->initialize_relevance_bumps( $args{search_relevance_adjustment} )
+        if ($args{search_relevance_adjustment});
+
+    $self->initialize_normalizers( $args{config_metabib_field_index_norm_map} )
+        if ($args{config_metabib_field_index_norm_map});
+
+    $_complete = 1 if (
+        $args{config_metabib_field_index_norm_map} &&
+        $args{search_relevance_adjustment} &&
+        $args{config_metabib_search_alias} &&
+        $args{config_metabib_field}
+    );
+
+    return $_complete;
+}
+
+sub TEST_SETUP {
+    
+    __PACKAGE__->add_search_field_id_map( series => seriestitle => 1 => 1 );
+
+    __PACKAGE__->add_search_field_id_map( series => seriestitle => 1 => 1 );
+    __PACKAGE__->add_relevance_bump( series => seriestitle => first_word => 1.5 );
+    __PACKAGE__->add_relevance_bump( series => seriestitle => full_match => 20 );
+    
+    __PACKAGE__->add_search_field_id_map( title => abbreviated => 2 => 1 );
+    __PACKAGE__->add_relevance_bump( title => abbreviated => first_word => 1.5 );
+    __PACKAGE__->add_relevance_bump( title => abbreviated => full_match => 20 );
+    
+    __PACKAGE__->add_search_field_id_map( title => translated => 3 => 1 );
+    __PACKAGE__->add_relevance_bump( title => translated => first_word => 1.5 );
+    __PACKAGE__->add_relevance_bump( title => translated => full_match => 20 );
+    
+    __PACKAGE__->add_search_field_id_map( title => proper => 6 => 1 );
+    __PACKAGE__->add_query_normalizer( title => proper => 'naco_normalize' );
+    __PACKAGE__->add_relevance_bump( title => proper => first_word => 1.5 );
+    __PACKAGE__->add_relevance_bump( title => proper => full_match => 20 );
+    __PACKAGE__->add_relevance_bump( title => proper => word_order => 10 );
+    
+    __PACKAGE__->add_search_field_id_map( author => coporate => 7 => 1 );
+    __PACKAGE__->add_relevance_bump( author => coporate => first_word => 1.5 );
+    __PACKAGE__->add_relevance_bump( author => coporate => full_match => 20 );
+    
+    __PACKAGE__->add_facet_field_id_map( author => personal => 8 => 1 );
+
+    __PACKAGE__->add_search_field_id_map( author => personal => 8 => 1 );
+    __PACKAGE__->add_relevance_bump( author => personal => first_word => 1.5 );
+    __PACKAGE__->add_relevance_bump( author => personal => full_match => 20 );
+    __PACKAGE__->add_query_normalizer( author => personal => 'naco_normalize' );
+    __PACKAGE__->add_query_normalizer( author => personal => 'split_date_range' );
+    
+    __PACKAGE__->add_facet_field_id_map( subject => topic => 14 => 1 );
+
+    __PACKAGE__->add_search_field_id_map( subject => topic => 14 => 1 );
+    __PACKAGE__->add_relevance_bump( subject => topic => first_word => 1 );
+    __PACKAGE__->add_relevance_bump( subject => topic => full_match => 1 );
+    
+    __PACKAGE__->add_search_field_id_map( subject => complete => 16 => 1 );
+    __PACKAGE__->add_relevance_bump( subject => complete => first_word => 1 );
+    __PACKAGE__->add_relevance_bump( subject => complete => full_match => 1 );
+    
+    __PACKAGE__->add_search_field_id_map( keyword => keyword => 15 => 1 );
+    __PACKAGE__->add_relevance_bump( keyword => keyword => first_word => 1 );
+    __PACKAGE__->add_relevance_bump( keyword => keyword => full_match => 1 );
+    
+    
+    __PACKAGE__->add_search_class_alias( keyword => 'kw' );
+    __PACKAGE__->add_search_class_alias( title => 'ti' );
+    __PACKAGE__->add_search_class_alias( author => 'au' );
+    __PACKAGE__->add_search_class_alias( author => 'name' );
+    __PACKAGE__->add_search_class_alias( author => 'dc.contributor' );
+    __PACKAGE__->add_search_class_alias( subject => 'su' );
+    __PACKAGE__->add_search_class_alias( subject => 'bib.subject(?:Title|Place|Occupation)' );
+    __PACKAGE__->add_search_class_alias( series => 'se' );
+    __PACKAGE__->add_search_class_alias( keyword => 'dc.identifier' );
+    
+    __PACKAGE__->add_query_normalizer( author => corporate => 'naco_normalize' );
+    __PACKAGE__->add_query_normalizer( keyword => keyword => 'naco_normalize' );
+    
+    __PACKAGE__->add_search_field_alias( subject => name => 'bib.subjectName' );
+    
+}
+
+__PACKAGE__->default_search_class( 'keyword' );
+
+__PACKAGE__->add_search_filter( 'audience' );
+__PACKAGE__->add_search_filter( 'vr_format' );
+__PACKAGE__->add_search_filter( 'format' );
+__PACKAGE__->add_search_filter( 'item_type' );
+__PACKAGE__->add_search_filter( 'item_form' );
+__PACKAGE__->add_search_filter( 'lit_form' );
+__PACKAGE__->add_search_filter( 'locations' );
+__PACKAGE__->add_search_filter( 'site' );
+__PACKAGE__->add_search_filter( 'lasso' );
+__PACKAGE__->add_search_filter( 'my_lasso' );
+__PACKAGE__->add_search_filter( 'depth' );
+__PACKAGE__->add_search_filter( 'sort' );
+__PACKAGE__->add_search_filter( 'language' );
+__PACKAGE__->add_search_filter( 'preferred_language' );
+__PACKAGE__->add_search_filter( 'preferred_language_weight' );
+__PACKAGE__->add_search_filter( 'preferred_language_multiplier' );
+__PACKAGE__->add_search_filter( 'statuses' );
+__PACKAGE__->add_search_filter( 'bib_level' );
+__PACKAGE__->add_search_filter( 'before' );
+__PACKAGE__->add_search_filter( 'after' );
+__PACKAGE__->add_search_filter( 'between' );
+__PACKAGE__->add_search_filter( 'during' );
+__PACKAGE__->add_search_filter( 'offset' );
+__PACKAGE__->add_search_filter( 'limit' );
+__PACKAGE__->add_search_filter( 'core_limit' );
+__PACKAGE__->add_search_filter( 'check_limit' );
+__PACKAGE__->add_search_filter( 'skip_check' );
+__PACKAGE__->add_search_filter( 'superpage' );
+__PACKAGE__->add_search_filter( 'superpage_size' );
+__PACKAGE__->add_search_filter( 'estimation_strategy' );
+
+__PACKAGE__->add_search_modifier( 'available' );
+__PACKAGE__->add_search_modifier( 'descending' );
+__PACKAGE__->add_search_modifier( 'ascending' );
+__PACKAGE__->add_search_modifier( 'metarecord' );
+__PACKAGE__->add_search_modifier( 'metabib' );
+__PACKAGE__->add_search_modifier( 'staff' );
+
+
+#-------------------------------
+package OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan;
+use base 'QueryParser::query_plan';
+use OpenSRF::Utils::Logger qw($logger);
+use Data::Dumper;
+
+sub toSQL {
+    my $self = shift;
+
+    my %filters;
+    my ($format) = $self->find_filter('format');
+    if ($format) {
+        my ($t,$f) = split('-', $format->args->[0]);
+        $self->new_filter( item_type => [ split '', $t ] ) if ($t);
+        $self->new_filter( item_form => [ split '', $f ] ) if ($f);
+    }
+
+    for my $f ( qw/preferred_language preferred_language_multiplier preferred_language_weight core_limit check_limit skip_check superpage superpage_size/ ) {
+        my $col = $f;
+        $col = 'preferred_language_multiplier' if ($f eq 'preferred_language_weight');
+        my ($filter) = $self->find_filter($f);
+        if ($filter and @{$filter->args}) {
+            $filters{$col} = $filter->args->[0];
+        }
+    }
+
+    $self->QueryParser->superpage($filters{superpage}) if ($filters{superpage});
+    $self->QueryParser->superpage_size($filters{superpage_size}) if ($filters{superpage_size});
+    $self->QueryParser->core_limit($filters{core_limit}) if ($filters{core_limit});
+
+    $logger->debug("Query plan:\n".Dumper($self));
+
+    my $flat_plan = $self->flatten;
+
+    # generate the relevance ranking
+    my $rel = "AVG(\n\t\t(" . join(")+\n\t\t(", @{$$flat_plan{rank_list}}) . ")\n\t)";
+
+    # find any supplied sort option
+    my ($sort_filter) = $self->find_filter('sort');
+    if ($sort_filter) {
+        $sort_filter = $sort_filter->args->[0];
+    } else {
+        $sort_filter = 'rel';
+    }
+
+    if (($filters{preferred_language} || $self->QueryParser->default_preferred_language) && ($filters{preferred_language_multiplier} || $self->QueryParser->default_preferred_language_multiplier)) {
+        my $pl = $self->QueryParser->quote_value( $filters{preferred_language} ? $filters{preferred_language} : $self->QueryParser->default_preferred_language );
+        my $plw = $filters{preferred_language_multiplier} ? $filters{preferred_language_multiplier} : $self->QueryParser->default_preferred_language_multiplier;
+        $rel = "($rel * COALESCE( NULLIF( FIRST(mrd.item_lang) = $pl , FALSE )::INT * $plw, 1))";
+    }
+    $rel .= '::NUMERIC';
+
+    for my $f ( qw/audience vr_format item_type item_form lit_form language bib_level/ ) {
+        my $col = $f;
+        $col = 'item_lang' if ($f eq 'language');
+        $filters{$f} = '';
+        my ($filter) = $self->find_filter($f);
+        if ($filter) {
+            $filters{$f} = "AND mrd.$col in (" . join(",",map { $self->QueryParser->quote_value($_) } @{$filter->args}) . ")";
+        }
+    }
+
+    my $audience = $filters{audience};
+    my $vr_format = $filters{vr_format};
+    my $item_type = $filters{item_type};
+    my $item_form = $filters{item_form};
+    my $lit_form = $filters{lit_form};
+    my $language = $filters{language};
+    my $bib_level = $filters{bib_level};
+
+    my $rank = $rel;
+
+    my $desc = 'ASC';
+    $desc = 'DESC' if ($self->find_modifier('descending'));
+
+    if ($sort_filter eq 'rel') { # relevance ranking flips sort dir
+        if ($desc eq  'ASC') {
+            $desc = 'DESC';
+        } else {
+            $desc = 'ASC';
+        }
+    } else {
+        if ($sort_filter eq 'title') {
+            $rank = "FIRST((SELECT frt.value FROM metabib.full_rec frt WHERE frt.record = m.source AND frt.tag = 'tnf' AND frt.subfield = 'a' LIMIT 1))";
+        } elsif ($sort_filter eq 'pubdate') {
+            $rank = "FIRST(mrd.date1)::NUMERIC";
+        } elsif ($sort_filter eq 'create_date') {
+            $rank = "FIRST((SELECT create_date FROM biblio.record_entry rbr WHERE rbr.id = m.source))";
+        } elsif ($sort_filter eq 'edit_date') {
+            $rank = "FIRST((SELECT edit_date FROM biblio.record_entry rbr WHERE rbr.id = m.source))";
+        } elsif ($sort_filter eq 'author') {
+            $rank = "FIRST((SELECT fra.value FROM metabib.full_rec fra WHERE fra.record = m.source AND fra.tag LIKE '1%' AND fra.subfield = 'a' ORDER BY fra.tag LIMIT 1))";
+        } else {
+            # default to rel ranking
+            $rank = $rel;
+        }
+    }
+
+    my $key = 'm.source';
+    $key = 'm.metarecord' if (grep {$_->name eq 'metarecord' or $_->name eq 'metabib'} @{$self->modifiers});
+
+    my ($before) = $self->find_filter('before');
+    my ($after) = $self->find_filter('after');
+    my ($during) = $self->find_filter('during');
+    my ($between) = $self->find_filter('between');
+
+    if ($before and @{$before->args} == 1) {
+        $before = "AND mrd.date1 <= " . $self->QueryParser->quote_value($before->args->[0]);
+    } else {
+        $before = '';
+    }
+
+    if ($after and @{$after->args} == 1) {
+        $after = "AND mrd.date1 >= " . $self->QueryParser->quote_value($after->args->[0]);
+    } else {
+        $after = '';
+    }
+
+    if ($during and @{$during->args} == 1) {
+        $during = "AND " . $self->QueryParser->quote_value($during->args->[0]) . " BETWEEN mrd.date1 AND mrd.date2";
+    } else {
+        $during = '';
+    }
+
+    if ($between and @{$between->args} == 2) {
+        $between = "AND mrd.date1 BETWEEN " . $self->QueryParser->quote_value($between->args->[0]) . " AND " . $self->QueryParser->quote_value($between->args->[1]);
+    } else {
+        $between = '';
+    }
+
+    my $core_limit = $self->QueryParser->core_limit || 25000;
+
+    my $sql = <QueryParser->debug;
+    return $sql;
+
+}
+
+
+sub rel_bump {
+    my $self = shift;
+    my $node = shift;
+    my $bump = shift;
+    my $multiplier = shift;
+
+    my $only_atoms = $node->only_atoms;
+    return '' if (!@$only_atoms);
+
+    if ($bump eq 'first_word') {
+        return " /* first_word */ COALESCE(NULLIF( (naco_normalize(".$node->table_alias.".value) ~ ('^'||naco_normalize(".$self->QueryParser->quote_value($only_atoms->[0]->content)."))), FALSE )::INT * $multiplier, 1)";
+    } elsif ($bump eq 'full_match') {
+        return " /* full_match */ COALESCE(NULLIF( (naco_normalize(".$node->table_alias.".value) ~ ('^'||".
+                    join( "||' '||", map { "naco_normalize(".$self->QueryParser->quote_value($_->content).")" } @$only_atoms )."||'\$')), FALSE )::INT * $multiplier, 1)";
+    } elsif ($bump eq 'word_order') {
+        return " /* word_order */ COALESCE(NULLIF( (naco_normalize(".$node->table_alias.".value) ~ (".
+                    join( "||'.*'||", map { "naco_normalize(".$self->QueryParser->quote_value($_->content).")" } @$only_atoms ).")), FALSE )::INT * $multiplier, 1)";
+    }
+
+    return '';
+}
+
+sub flatten {
+    my $self = shift;
+
+    my $from = shift || '';
+    my $where = shift || '(';
+
+    my @rank_list;
+    for my $node ( @{$self->query_nodes} ) {
+        if (ref($node)) {
+            if ($node->isa( 'QueryParser::query_plan::node' )) {
+
+                unless (@{$node->only_atoms}) {
+                    push @rank_list, '1';
+                    $where .= 'TRUE';
+                    next;
+                }
+
+                my $table = $node->table;
+                my $talias = $node->table_alias;
+
+                my $node_rank = $node->rank . " * ${talias}.weight";
+
+                my $core_limit = $self->QueryParser->core_limit || 25000;
+                $from .= "\n\tLEFT JOIN (\n\t\tSELECT fe.*, fe_weight.weight, x.tsq /* search */\n\t\t  FROM  $table AS fe";
+                $from .= "\n\t\t\tJOIN config.metabib_field AS fe_weight ON (fe_weight.id = fe.field)";
+                $from .= "\n\t\t\tJOIN (SELECT ".$node->tsquery ." AS tsq ) AS x ON (fe.index_vector @@ x.tsq)";
+
+                my @bump_fields;
+                if (@{$node->fields} > 0) {
+                    @bump_fields = @{$node->fields};
+
+                    my @field_ids;
+                    push(@field_ids, $self->QueryParser->search_field_ids_by_class( $node->classname, $_ )->[0]) for (@bump_fields);
+                    $from .= "\n\t\t\tWHERE fe_weight.id IN  (". join(',', @field_ids) .")";
+
+                } else {
+                    @bump_fields = @{$self->QueryParser->search_fields->{$node->classname}};
+                }
+
+                ###$from .= "\n\t\tLIMIT $core_limit";
+                $from .= "\n\t) AS $talias ON (m.source = ${talias}.source)";
+
+
+                my %used_bumps;
+                for my $field ( @bump_fields ) {
+                    my $bumps = $self->QueryParser->find_relevance_bumps( $node->classname => $field );
+                    for my $b (keys %$bumps) {
+                        next if (!$$bumps{$b}{active});
+                        next if ($used_bumps{$b});
+                        $used_bumps{$b} = 1;
+
+                        next if ($$bumps{$b}{multiplier} == 1); # optimization to remove unneeded bumps
+
+                        my $bump_case = $self->rel_bump( $node, $b, $$bumps{$b}{multiplier} );
+                        $node_rank .= "\n\t\t\t\t * " . $bump_case if ($bump_case);
+                    }
+                }
+
+                $where .= '(' . $talias . ".id IS NOT NULL";
+                $where .= ' AND ' . join(' AND ', map {"${talias}.value ~* ".$self->QueryParser->quote_phrase_value($_)} @{$node->phrases}) if (@{$node->phrases});
+                $where .= ')';
+
+                push @rank_list, $node_rank;
+
+            } elsif ($node->isa( 'QueryParser::query_plan::facet' )) {
+
+                my $table = $node->table;
+                my $talias = $node->table_alias;
+
+                my @field_ids;
+                if (@{$node->fields} > 0) {
+                    push(@field_ids, $self->QueryParser->facet_field_ids_by_class( $node->classname, $_ )->[0]) for (@{$node->fields});
+                } else {
+                    @field_ids = @{ $self->QueryParser->facet_field_ids_by_class( $node->classname ) };
+                }
+
+                $from .= "\n\tJOIN /* facet */ metabib.facet_entry $talias ON (\n\t\tm.source = ${talias}.source\n\t\t".
+                         "AND SUBSTRING(${talias}.value,1,1024) IN (" . join(",", map { $self->QueryParser->quote_value($_) } @{$node->values}) . ")\n\t\t".
+                         "AND ${talias}.field IN (". join(',', @field_ids) . ")\n\t)";
+
+                $where .= 'TRUE';
+
+            } else {
+                my $subnode = $node->flatten;
+
+                push(@rank_list, @{$$subnode{rank_list}});
+                $from .= $$subnode{from};
+                $where .= "($$subnode{where})";
+            }
+        } else {
+            $where .= ' AND ' if ($node eq '&');
+            $where .= ' OR ' if ($node eq '|');
+            # ... stitching the WHERE together ...
+        }
+    }
+
+    return { rank_list => \@rank_list, from => $from, where => $where.')' };
+
+}
+
+
+#-------------------------------
+package OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan::filter;
+use base 'QueryParser::query_plan::filter';
+
+#-------------------------------
+package OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan::facet;
+use base 'QueryParser::query_plan::facet';
+
+sub classname {
+    my $self = shift;
+    my ($classname) = split '\|', $self->name;
+    return $classname;
+}
+
+sub table {
+    my $self = shift;
+    return 'metabib.' . $self->classname . '_field_entry';
+}
+
+sub fields {
+    my $self = shift;
+    my ($classname,@fields) = split '\|', $self->name;
+    return \@fields;
+}
+
+sub table_alias {
+    my $self = shift;
+
+    my $table_alias = "$self";
+    $table_alias =~ s/^.*\(0(x[0-9a-fA-F]+)\)$/$1/go;
+    $table_alias .= '_' . $self->name;
+    $table_alias =~ s/\|/_/go;
+
+    return $table_alias;
+}
+
+
+#-------------------------------
+package OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan::modifier;
+use base 'QueryParser::query_plan::modifier';
+
+#-------------------------------
+package OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan::node::atom;
+use base 'QueryParser::query_plan::node::atom';
+
+sub sql {
+    my $self = shift;
+    my $sql = shift;
+
+    $self->{sql} = $sql if ($sql);
+    
+    return $self->{sql} if ($self->{sql});
+    return $self->buildSQL;
+}
+
+sub buildSQL {
+    my $self = shift;
+
+    my $classname = $self->node->classname;
+
+    my $normalizers = $self->node->plan->QueryParser->query_normalizers( $classname );
+    my $fields = $self->node->fields;
+
+    $fields = $self->node->plan->QueryParser->search_fields->{$classname} if (!@$fields);
+
+    my %norms;
+    my $pos = 0;
+    for my $field (@$fields) {
+        for my $nfield (keys %$normalizers) {
+            for my $nizer ( @{$$normalizers{$nfield}} ) {
+                if ($field eq $nfield) {
+                    if (!exists($norms{$nizer->{function}})) {
+                        $norms{$nizer->{function}} = {p=>$pos++,n=>$nizer};
+                    }
+                }
+            }
+        }
+    }
+
+    my $sql = $self->node->plan->QueryParser->quote_value($self->content);
+
+    for my $n ( map { $$_{n} } sort { $$a{p} <=> $$b{p} } values %norms ) {
+        $sql = join(', ', $sql, map { $self->node->plan->QueryParser->quote_value($_) } @{ $n->{params} });
+        $sql = $n->{function}."($sql)";
+    }
+
+    my $prefix = $self->prefix || '';
+    my $suffix = $self->suffix || '';
+
+    $prefix = "'$prefix' ||" if $prefix;
+    my $suffix_op = ":$suffix" if $suffix;
+    my $suffix_after = "|| '$suffix_op'" if $suffix;
+
+    $sql = "to_tsquery('$classname', COALESCE(NULLIF($prefix '(' || btrim(regexp_replace($sql,E'(?:\\\\s+|:)','$suffix_op&','g'),'&|') $suffix_after || ')', '()'), ''))";
+
+    return $self->sql($sql);
+}
+
+#-------------------------------
+package OpenILS::Application::Storage::Driver::Pg::QueryParser::query_plan::node;
+use base 'QueryParser::query_plan::node';
+
+sub only_atoms {
+    my $self = shift;
+
+    my $atoms = $self->query_atoms;
+    my @only_atoms;
+    for my $a (@$atoms) {
+        push(@only_atoms, $a) if (ref($a) && $a->isa('QueryParser::query_plan::node::atom'));
+    }
+
+    return \@only_atoms;
+}
+
+sub table {
+    my $self = shift;
+    my $table = shift;
+    $self->{table} = $table if ($table);
+    return $self->{table} if $self->{table};
+    return $self->table( 'metabib.' . $self->classname . '_field_entry' );
+}
+
+sub table_alias {
+    my $self = shift;
+    my $table_alias = shift;
+    $self->{table_alias} = $table_alias if ($table_alias);
+    return $self->{table_alias} if ($self->{table_alias});
+
+    $table_alias = "$self";
+    $table_alias =~ s/^.*\(0(x[0-9a-fA-F]+)\)$/$1/go;
+    $table_alias .= '_' . $self->requested_class;
+    $table_alias =~ s/\|/_/go;
+
+    return $self->table_alias( $table_alias );
+}
+
+sub tsquery {
+    my $self = shift;
+    return $self->{tsquery} if ($self->{tsquery});
+
+    for my $atom (@{$self->query_atoms}) {
+        if (ref($atom)) {
+            $self->{tsquery} .= "\n\t\t\t" .$atom->sql;
+        } else {
+            $self->{tsquery} .= $atom x 2;
+        }
+    }
+
+    return $self->{tsquery};
+}
+
+sub rank {
+    my $self = shift;
+    return $self->{rank} if ($self->{rank});
+    return $self->{rank} = 'rank(' . $self->table_alias . '.index_vector, ' . $self->table_alias . '.tsq)';
+}
+
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/cdbi.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/cdbi.pm
new file mode 100644
index 0000000000..20d88c5662
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/cdbi.pm
@@ -0,0 +1,37 @@
+{ # Based on the change to Class::DBI in OpenILS::Application::Storage.  This will
+  # allow us to use TSearch2 via a simple cdbi "search" interface.
+	#-------------------------------------------------------------------------------
+	use UNIVERSAL::require; 
+	BEGIN {                 
+		'Class::DBI::Frozen::301'->use or 'Class::DBI'->use or die $@;
+	}     
+	package Class::DBI;
+
+	sub search_fts {
+		my $self = shift;
+		my @args = @_;
+
+		if (ref($args[-1]) eq 'HASH' && @args > 1) {
+			$args[-1]->{_placeholder} = "to_tsquery('default',?)";
+		} else {
+			push @args, {_placeholder => "to_tsquery('default',?)"};
+		}
+		
+		$self->_do_search("@@"  => @args);
+	}
+
+	sub search_regex {
+		my $self = shift;
+		my @args = @_;
+		$self->_do_search("~*"  => @args);
+	}
+
+	sub search_ilike {
+		my $self = shift;
+		my @args = @_;
+		$self->_do_search("ILIKE"  => @args);
+	}
+
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm
new file mode 100644
index 0000000000..5ca6fd008b
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/dbi.pm
@@ -0,0 +1,828 @@
+{
+
+	#-------------------------------------------------------------------------------
+	package container::user_bucket;
+
+	container::user_bucket->table( 'container.user_bucket' );
+	container::user_bucket->sequence( 'container.user_bucket_id_seq' );
+
+	#-------------------------------------------------------------------------------
+	package container::user_bucket_item;
+
+	container::user_bucket_item->table( 'container.user_bucket_item' );
+	container::user_bucket_item->sequence( 'container.user_bucket_item_id_seq' );
+
+	#-------------------------------------------------------------------------------
+	package container::copy_bucket;
+
+	container::copy_bucket->table( 'container.copy_bucket' );
+	container::copy_bucket->sequence( 'container.copy_bucket_id_seq' );
+
+	#-------------------------------------------------------------------------------
+	package container::copy_bucket_item;
+
+	container::copy_bucket_item->table( 'container.copy_bucket_item' );
+	container::copy_bucket_item->sequence( 'container.copy_bucket_item_id_seq' );
+
+	#-------------------------------------------------------------------------------
+	package container::call_number_bucket;
+
+	container::call_number_bucket->table( 'container.call_number_bucket' );
+	container::call_number_bucket->sequence( 'container.call_number_bucket_id_seq' );
+
+	#-------------------------------------------------------------------------------
+	package container::call_number_bucket_item;
+
+	container::call_number_bucket_item->table( 'container.call_number_bucket_item' );
+	container::call_number_bucket_item->sequence( 'container.call_number_bucket_item_id_seq' );
+
+	#-------------------------------------------------------------------------------
+	package container::biblio_record_entry_bucket;
+
+	container::biblio_record_entry_bucket->table( 'container.biblio_record_entry_bucket' );
+	container::biblio_record_entry_bucket->sequence( 'container.biblio_record_entry_bucket_id_seq' );
+
+	#-------------------------------------------------------------------------------
+	package container::biblio_record_entry_bucket_item;
+
+	container::biblio_record_entry_bucket_item->table( 'container.biblio_record_entry_bucket_item' );
+	container::biblio_record_entry_bucket_item->sequence( 'container.biblio_record_entry_bucket_item_id_seq' );
+
+	#---------------------------------------------------------------------
+	package money::grocery;
+	
+	money::grocery->table( 'money.grocery' );
+	money::grocery->sequence( 'money.billable_xact_id_seq' );
+
+	#---------------------------------------------------------------------
+	package money::collections_tracker;
+	
+	money::collections_tracker->table( 'money.collections_tracker' );
+	money::collections_tracker->sequence( 'money.collections_tracker_id_seq' );
+
+	#---------------------------------------------------------------------
+	package money::billable_transaction;
+	
+	money::billable_transaction->table( 'money.billable_xact' );
+	money::billable_transaction->sequence( 'money.billable_xact_id_seq' );
+
+	#---------------------------------------------------------------------
+	package money::billing;
+	
+	money::billing->table( 'money.billing' );
+	money::billing->sequence( 'money.billing_id_seq' );
+
+	#---------------------------------------------------------------------
+	package money::desk_payment;
+	
+	money::desk_payment->table( 'money.desk_payment_view' );
+
+	#---------------------------------------------------------------------
+	package money::payment;
+	
+	money::payment->table( 'money.payment_view' );
+
+	#---------------------------------------------------------------------
+	package money::cash_payment;
+	
+	money::cash_payment->table( 'money.cash_payment' );
+	money::cash_payment->sequence( 'money.payment_id_seq' );
+
+	#---------------------------------------------------------------------
+	package money::check_payment;
+	
+	money::check_payment->table( 'money.check_payment' );
+	money::check_payment->sequence( 'money.payment_id_seq' );
+
+	#---------------------------------------------------------------------
+	package money::credit_payment;
+	
+	money::credit_payment->table( 'money.credit_payment' );
+	money::credit_payment->sequence( 'money.payment_id_seq' );
+
+	#---------------------------------------------------------------------
+	package money::credit_card_payment;
+	
+	money::credit_card_payment->table( 'money.credit_card_payment' );
+	money::credit_card_payment->sequence( 'money.payment_id_seq' );
+
+	#---------------------------------------------------------------------
+	package money::work_payment;
+	
+	money::work_payment->table( 'money.work_payment' );
+	money::work_payment->sequence( 'money.payment_id_seq' );
+
+	#---------------------------------------------------------------------
+	package money::goods_payment;
+	
+	money::goods_payment->table( 'money.goods_payment' );
+	money::goods_payment->sequence( 'money.payment_id_seq' );
+
+	#---------------------------------------------------------------------
+	package money::forgive_payment;
+	
+	money::forgive_payment->table( 'money.forgive_payment' );
+	money::forgive_payment->sequence( 'money.payment_id_seq' );
+
+	#---------------------------------------------------------------------
+	package money::open_billable_transaction_summary;
+	
+	money::open_billable_transaction_summary->table( 'money.open_billable_xact_summary' );
+
+	#---------------------------------------------------------------------
+	package money::billable_transaction_summary;
+	
+	money::billable_transaction_summary->table( 'money.billable_xact_summary' );
+
+	#---------------------------------------------------------------------
+	package money::open_user_summary;
+	
+	money::open_user_summary->table( 'money.open_usr_summary' );
+
+	#---------------------------------------------------------------------
+	package money::user_summary;
+	
+	money::user_summary->table( 'money.usr_summary' );
+
+	#---------------------------------------------------------------------
+	package money::open_user_circulation_summary;
+	
+	money::open_user_circulation_summary->table( 'money.open_usr_circulation_summary' );
+
+	#---------------------------------------------------------------------
+	package money::user_circulation_summary;
+	
+	money::user_circulation_summary->table( 'money.usr_circulation_summary' );
+
+	#---------------------------------------------------------------------
+	package action::circulation;
+	
+	action::circulation->table( 'action.circulation' );
+	action::circulation->sequence( 'money.billable_xact_id_seq' );
+
+	#---------------------------------------------------------------------
+	package booking::resource_type;
+	
+	booking::resource_type->table( 'booking.resource_type' );
+	booking::resource_type->sequence( 'booking.resource_type_id_seq' );
+
+	#---------------------------------------------------------------------
+	package booking::resource;
+	
+	booking::resource->table( 'booking.resource' );
+	booking::resource->sequence( 'booking.resource_id_seq' );
+
+	#---------------------------------------------------------------------
+	package booking::reservation;
+	
+	booking::reservation->table( 'booking.reservation' );
+	booking::reservation->sequence( 'money.billable_xact_id_seq' );
+
+	#---------------------------------------------------------------------
+	package booking::reservation_attr_value_map;
+	
+	booking::reservation_attr_value_map->table( 'booking.reservation_attr_value_map' );
+	booking::reservation_attr_value_map->sequence( 'booking.reservation_attr_value_map_id_seq' );
+
+	#---------------------------------------------------------------------
+	package booking::resource_attr_map;
+	
+	booking::resource_attr_map->table( 'booking.resource_attr_map' );
+	booking::resource_attr_map->sequence( 'booking.resource_attr_map_id_seq' );
+
+	#---------------------------------------------------------------------
+	package action::non_cat_in_house_use;
+	
+	action::non_cat_in_house_use->table( 'action.non_cat_in_house_use' );
+	action::non_cat_in_house_use->sequence( 'action.non_cat_in_house_use_id_seq' );
+
+	#---------------------------------------------------------------------
+	package action::in_house_use;
+	
+	action::in_house_use->table( 'action.in_house_use' );
+	action::in_house_use->sequence( 'action.in_house_use_id_seq' );
+
+	#---------------------------------------------------------------------
+	package action::non_cataloged_circulation;
+	
+	action::non_cataloged_circulation->table( 'action.non_cataloged_circulation' );
+	action::non_cataloged_circulation->sequence( 'action.non_cataloged_circulation_id_seq' );
+
+	#---------------------------------------------------------------------
+	package action::open_circulation;
+	
+	action::open_circulation->table( 'action.open_circulation' );
+
+	#---------------------------------------------------------------------
+	package action::survey;
+	
+	action::survey->table( 'action.survey' );
+	action::survey->sequence( 'action.survey_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package action::survey_question;
+	
+	action::survey_question->table( 'action.survey_question' );
+	action::survey_question->sequence( 'action.survey_question_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package action::survey_answer;
+	
+	action::survey_answer->table( 'action.survey_answer' );
+	action::survey_answer->sequence( 'action.survey_answer_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package action::survey_response;
+	
+	action::survey_response->table( 'action.survey_response' );
+	action::survey_response->sequence( 'action.survey_response_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package config::non_cataloged_type;
+	
+	config::non_cataloged_type->table( 'config.non_cataloged_type' );
+	config::non_cataloged_type->sequence( 'config.non_cataloged_type_id_seq' );
+
+	#---------------------------------------------------------------------
+	package config::copy_status;
+	
+	config::copy_status->table( 'config.copy_status' );
+	config::copy_status->sequence( 'config.copy_status_id_seq' );
+
+	#---------------------------------------------------------------------
+	package config::rules::circ_duration;
+	
+	config::rules::circ_duration->table( 'config.rule_circ_duration' );
+	config::rules::circ_duration->sequence( 'config.rule_circ_duration_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package config::rules::age_hold_protect;
+	
+	config::rules::age_hold_protect->table( 'config.rule_age_hold_protect' );
+	config::rules::age_hold_protect->sequence( 'config.rule_age_hold_protect_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package config::rules::max_fine;
+	
+	config::rules::max_fine->table( 'config.rule_max_fine' );
+	config::rules::max_fine->sequence( 'config.rule_max_fine_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package config::rules::recurring_fine;
+	
+	config::rules::recurring_fine->table( 'config.rule_recurring_fine' );
+	config::rules::recurring_fine->sequence( 'config.rule_recurring_fine_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package config::net_access_level;
+	
+	config::net_access_level->table( 'config.net_access_level' );
+	config::net_access_level->sequence( 'config.net_access_level_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package config::standing;
+	
+	config::standing->table( 'config.standing' );
+	config::standing->sequence( 'config.standing_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package config::metabib_field;
+	
+	config::metabib_field->table( 'config.metabib_field' );
+	config::metabib_field->sequence( 'config.metabib_field_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package config::bib_source;
+	
+	config::bib_source->table( 'config.bib_source' );
+	config::bib_source->sequence( 'config.bib_source_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package config::identification_type;
+	
+	config::identification_type->table( 'config.identification_type' );
+	config::identification_type->sequence( 'config.identification_type_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package asset::call_number_note;
+	
+	asset::call_number_note->table( 'asset.call_number_note' );
+	asset::call_number_note->sequence( 'asset.call_number_note_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package asset::copy_note;
+	
+	asset::copy_note->table( 'asset.copy_note' );
+	asset::copy_note->sequence( 'asset.copy_note_id_seq' );
+
+	#---------------------------------------------------------------------
+	package asset::call_number;
+	
+	asset::call_number->table( 'asset.call_number' );
+	asset::call_number->sequence( 'asset.call_number_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package asset::call_number_class;
+	
+	asset::call_number_class->table( 'asset.call_number_class' );
+	asset::call_number_class->sequence( 'asset.call_number_class_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package asset::copy_location_order;
+	
+	asset::copy_location_order->table( 'asset.copy_location_order' );
+	asset::copy_location_order->sequence( 'asset.copy_location_order_id_seq' );
+
+	#---------------------------------------------------------------------
+	package asset::copy_location;
+	
+	asset::copy_location->table( 'asset.copy_location' );
+	asset::copy_location->sequence( 'asset.copy_location_id_seq' );
+
+	#---------------------------------------------------------------------
+	package asset::copy;
+	
+	asset::copy->table( 'asset.copy' );
+	asset::copy->sequence( 'asset.copy_id_seq' );
+
+	#---------------------------------------------------------------------
+	package asset::stat_cat;
+	
+	asset::stat_cat->table( 'asset.stat_cat' );
+	asset::stat_cat->sequence( 'asset.stat_cat_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package asset::stat_cat_entry;
+	
+	asset::stat_cat_entry->table( 'asset.stat_cat_entry' );
+	asset::stat_cat_entry->sequence( 'asset.stat_cat_entry_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package asset::stat_cat_entry_copy_map;
+	
+	asset::stat_cat_entry_copy_map->table( 'asset.stat_cat_entry_copy_map' );
+	asset::stat_cat_entry_copy_map->sequence( 'asset.stat_cat_entry_copy_map_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package authority::record_entry;
+	
+	authority::record_entry->table( 'authority.record_entry' );
+	authority::record_entry->sequence( 'authority.record_entry_id_seq' );
+
+	#---------------------------------------------------------------------
+	package biblio::record_entry;
+	
+	biblio::record_entry->table( 'biblio.record_entry' );
+	biblio::record_entry->sequence( 'biblio.record_entry_id_seq' );
+
+	#---------------------------------------------------------------------
+	#package biblio::record_marc;
+	#
+	#biblio::record_marc->table( 'biblio.record_marc' );
+	#biblio::record_marc->sequence( 'biblio.record_marc_id_seq' );
+	#
+	#---------------------------------------------------------------------
+	package authority::record_note;
+	
+	authority::record_note->table( 'authority.record_note' );
+	authority::record_note->sequence( 'authority.record_note_id_seq' );
+
+	#---------------------------------------------------------------------
+	package biblio::record_note;
+	
+	biblio::record_note->table( 'biblio.record_note' );
+	biblio::record_note->sequence( 'biblio.record_note_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package actor::workstation;
+	
+	actor::workstation->table( 'actor.workstation' );
+	actor::workstation->sequence( 'actor.workstation_id_seq' );
+
+	#---------------------------------------------------------------------
+	package actor::user;
+	
+	actor::user->table( 'actor.usr' );
+	actor::user->sequence( 'actor.usr_id_seq' );
+
+	#---------------------------------------------------------------------
+	package actor::org_unit::closed_date;
+	
+	actor::org_unit::closed_date->table( 'actor.org_unit_closed' );
+	actor::org_unit::closed_date->sequence( 'actor.org_unit_closed_id_seq' );
+
+	#---------------------------------------------------------------------
+	package actor::org_unit_setting;
+	
+	actor::org_unit_setting->table( 'actor.org_unit_setting' );
+	actor::org_unit_setting->sequence( 'actor.org_unit_setting_id_seq' );
+
+	#---------------------------------------------------------------------
+	package actor::user_standing_penalty;
+	
+	actor::user_standing_penalty->table( 'actor.usr_standing_penalty' );
+	actor::user_standing_penalty->sequence( 'actor.usr_standing_penalty_id_seq' );
+
+	#---------------------------------------------------------------------
+	package actor::user_setting;
+	
+	actor::user_setting->table( 'actor.usr_setting' );
+	actor::user_setting->sequence( 'actor.usr_setting_id_seq' );
+
+	#---------------------------------------------------------------------
+	package actor::user_address;
+	
+	actor::user_address->table( 'actor.usr_address' );
+	actor::user_address->sequence( 'actor.usr_address_id_seq' );
+
+	#---------------------------------------------------------------------
+	package actor::org_address;
+	
+	actor::org_address->table( 'actor.org_address' );
+	actor::org_address->sequence( 'actor.org_address_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package actor::usr_org_unit_opt_in;
+	
+	actor::usr_org_unit_opt_in->table( 'actor.usr_org_unit_opt_in' );
+	actor::usr_org_unit_opt_in->sequence( 'actor.usr_org_unit_opt_in_id_seq' );
+
+	#---------------------------------------------------------------------
+	package actor::org_unit_proximity;
+	
+	actor::org_unit_proximity->table( 'actor.org_unit_proximity' );
+	actor::org_unit_proximity->sequence( 'actor.org_unit_proximity_id_seq' );
+
+	#---------------------------------------------------------------------
+	package actor::org_unit_type;
+	
+	actor::org_unit_type->table( 'actor.org_unit_type' );
+	actor::org_unit_type->sequence( 'actor.org_unit_type_id_seq' );
+
+	#---------------------------------------------------------------------
+	package actor::org_unit::hours_of_operation;
+	
+	actor::org_unit::hours_of_operation->table( 'actor.hours_of_operation' );
+
+	#---------------------------------------------------------------------
+	package actor::org_unit;
+	
+	actor::org_unit->table( 'actor.org_unit' );
+	actor::org_unit->sequence( 'actor.org_unit_id_seq' );
+
+	#---------------------------------------------------------------------
+	package actor::stat_cat;
+	
+	actor::stat_cat->table( 'actor.stat_cat' );
+	actor::stat_cat->sequence( 'actor.stat_cat_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package actor::stat_cat_entry;
+	
+	actor::stat_cat_entry->table( 'actor.stat_cat_entry' );
+	actor::stat_cat_entry->sequence( 'actor.stat_cat_entry_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package actor::stat_cat_entry_user_map;
+	
+	actor::stat_cat_entry_user_map->table( 'actor.stat_cat_entry_usr_map' );
+	actor::stat_cat_entry_user_map->sequence( 'actor.stat_cat_entry_usr_map_id_seq' );
+	
+	#---------------------------------------------------------------------
+	package actor::card;
+	
+	actor::card->table( 'actor.card' );
+	actor::card->sequence( 'actor.card_id_seq' );
+
+	#---------------------------------------------------------------------
+	package actor::usr_note;
+	
+	actor::usr_note->table( 'actor.usr_note' );
+	actor::usr_note->sequence( 'actor.usr_note_id_seq' );
+
+	#---------------------------------------------------------------------
+
+	#-------------------------------------------------------------------------------
+	package metabib::metarecord;
+
+	metabib::metarecord->table( 'metabib.metarecord' );
+	metabib::metarecord->sequence( 'metabib.metarecord_id_seq' );
+
+
+	#-------------------------------------------------------------------------------
+
+	#-------------------------------------------------------------------------------
+	package metabib::identifier_field_entry;
+
+	metabib::identifier_field_entry->table( 'metabib.identifier_field_entry' );
+	metabib::identifier_field_entry->sequence( 'metabib.identifier_field_entry_id_seq' );
+	metabib::identifier_field_entry->columns( 'FTS' => 'index_vector' );
+
+	#-------------------------------------------------------------------------------
+
+	#-------------------------------------------------------------------------------
+	package metabib::title_field_entry;
+
+	metabib::title_field_entry->table( 'metabib.title_field_entry' );
+	metabib::title_field_entry->sequence( 'metabib.title_field_entry_id_seq' );
+	metabib::title_field_entry->columns( 'FTS' => 'index_vector' );
+
+#	metabib::title_field_entry->add_trigger(
+#		before_create => \&OpenILS::Application::Storage::Driver::Pg::tsearch2_trigger
+#	);
+#	metabib::title_field_entry->add_trigger(
+#		before_update => \&OpenILS::Application::Storage::Driver::Pg::tsearch2_trigger
+#	);
+
+	#-------------------------------------------------------------------------------
+
+	#-------------------------------------------------------------------------------
+	package metabib::author_field_entry;
+
+	metabib::author_field_entry->table( 'metabib.author_field_entry' );
+	metabib::author_field_entry->sequence( 'metabib.author_field_entry_id_seq' );
+	metabib::author_field_entry->columns( 'FTS' => 'index_vector' );
+
+	#-------------------------------------------------------------------------------
+
+	#-------------------------------------------------------------------------------
+	package metabib::subject_field_entry;
+
+	metabib::subject_field_entry->table( 'metabib.subject_field_entry' );
+	metabib::subject_field_entry->sequence( 'metabib.subject_field_entry_id_seq' );
+	metabib::subject_field_entry->columns( 'FTS' => 'index_vector' );
+
+	#-------------------------------------------------------------------------------
+
+	#-------------------------------------------------------------------------------
+	package metabib::keyword_field_entry;
+
+	metabib::keyword_field_entry->table( 'metabib.keyword_field_entry' );
+	metabib::keyword_field_entry->sequence( 'metabib.keyword_field_entry_id_seq' );
+	metabib::keyword_field_entry->columns( 'FTS' => 'index_vector' );
+
+	#-------------------------------------------------------------------------------
+	package metabib::series_field_entry;
+
+	metabib::series_field_entry->table( 'metabib.series_field_entry' );
+	metabib::series_field_entry->sequence( 'metabib.series_field_entry_id_seq' );
+	metabib::series_field_entry->columns( 'FTS' => 'index_vector' );
+
+	#-------------------------------------------------------------------------------
+
+	#-------------------------------------------------------------------------------
+	#package metabib::title_field_entry_source_map;
+
+	#metabib::title_field_entry_source_map->table( 'metabib.title_field_entry_source_map' );
+
+	#-------------------------------------------------------------------------------
+
+	#-------------------------------------------------------------------------------
+	#package metabib::author_field_entry_source_map;
+
+	#metabib::author_field_entry_source_map->table( 'metabib.author_field_entry_source_map' );
+
+	#-------------------------------------------------------------------------------
+
+	#-------------------------------------------------------------------------------
+	#package metabib::subject_field_entry_source_map;
+
+	#metabib::subject_field_entry_source_map->table( 'metabib.subject_field_entry_source_map' );
+
+	#-------------------------------------------------------------------------------
+
+	#-------------------------------------------------------------------------------
+	#package metabib::keyword_field_entry_source_map;
+
+	#metabib::keyword_field_entry_source_map->table( 'metabib.keyword_field_entry_source_map' );
+
+	#-------------------------------------------------------------------------------
+
+	#-------------------------------------------------------------------------------
+	package metabib::metarecord_source_map;
+
+	metabib::metarecord_source_map->table( 'metabib.metarecord_source_map' );
+	metabib::metarecord_source_map->sequence( 'metabib.metarecord_source_map_id_seq' );
+
+	#-------------------------------------------------------------------------------
+	package authority::record_descriptor;
+
+	authority::record_descriptor->table( 'authority.rec_descriptor' );
+	authority::record_descriptor->sequence( 'authority.rec_descriptor_id_seq' );
+
+	#-------------------------------------------------------------------------------
+	package metabib::record_descriptor;
+
+	metabib::record_descriptor->table( 'metabib.rec_descriptor' );
+	metabib::record_descriptor->sequence( 'metabib.rec_descriptor_id_seq' );
+
+	#-------------------------------------------------------------------------------
+
+
+	#-------------------------------------------------------------------------------
+	package authority::full_rec;
+
+	authority::full_rec->table( 'authority.full_rec' );
+	authority::full_rec->sequence( 'authority.full_rec_id_seq' );
+	authority::full_rec->columns( 'FTS' => 'index_vector' );
+
+	#-------------------------------------------------------------------------------
+	package metabib::full_rec;
+
+	metabib::full_rec->table( 'metabib.full_rec' );
+	metabib::full_rec->sequence( 'metabib.full_rec_id_seq' );
+	metabib::full_rec->columns( 'FTS' => 'index_vector' );
+
+	#-------------------------------------------------------------------------------
+
+	package permission::perm_list;
+
+	permission::perm_list->sequence( 'permission.perm_list_id_seq' );
+	permission::perm_list->table('permission.perm_list');
+
+	#-------------------------------------------------------------------------------
+
+	package permission::grp_tree;
+
+	permission::grp_tree->sequence( 'permission.grp_tree_id_seq' );
+	permission::grp_tree->table('permission.grp_tree');
+
+	#-------------------------------------------------------------------------------
+
+	package permission::usr_grp_map;
+
+	permission::usr_grp_map->sequence( 'permission.usr_grp_map_id_seq' );
+	permission::usr_grp_map->table('permission.usr_grp_map');
+
+	#-------------------------------------------------------------------------------
+
+	package permission::usr_work_ou_map;
+	permission::usr_work_ou_map->sequence('permission.usr_work_ou_map_id_seq');
+	permission::usr_work_ou_map->table('permission.usr_work_ou_map');
+
+	#-------------------------------------------------------------------------------
+
+	package permission::usr_perm_map;
+
+	permission::usr_perm_map->sequence( 'permission.usr_perm_map_id_seq' );
+	permission::usr_perm_map->table('permission.usr_perm_map');
+
+	#-------------------------------------------------------------------------------
+
+	package permission::grp_perm_map;
+
+	permission::grp_perm_map->sequence( 'permission.grp_perm_map_id_seq' );
+	permission::grp_perm_map->table('permission.grp_perm_map');
+
+	#-------------------------------------------------------------------------------
+
+	package action::hold_request;
+
+	action::hold_request->sequence( 'action.hold_request_id_seq' );
+	action::hold_request->table('action.hold_request');
+
+	#-------------------------------------------------------------------------------
+
+	package action::hold_notification;
+
+	action::hold_notification->sequence( 'action.hold_notification_id_seq' );
+	action::hold_notification->table('action.hold_notification');
+
+	#-------------------------------------------------------------------------------
+
+	package action::hold_copy_map;
+
+	action::hold_copy_map->sequence( 'action.hold_copy_map_id_seq' );
+	action::hold_copy_map->table('action.hold_copy_map');
+
+	#-------------------------------------------------------------------------------
+
+	package action::hold_transit_copy;
+
+	action::hold_transit_copy->sequence( 'action.transit_copy_id_seq' );
+	action::hold_transit_copy->table('action.hold_transit_copy');
+
+	#-------------------------------------------------------------------------------
+
+	package action::reservation_transit_copy;
+
+	action::reservation_transit_copy->sequence( 'action.transit_copy_id_seq' );
+	action::reservation_transit_copy->table('action.reservation_transit_copy');
+
+	#-------------------------------------------------------------------------------
+
+	package action::transit_copy;
+
+	action::transit_copy->sequence( 'action.transit_copy_id_seq' );
+	action::transit_copy->table('action.transit_copy');
+
+	#-------------------------------------------------------------------------------
+
+	package action::unfulfilled_hold_list;
+
+	action::unfulfilled_hold_list->sequence( 'action.unfulfilled_hold_list_id_seq' );
+	action::unfulfilled_hold_list->table('action.unfulfilled_hold_list');
+
+	#-------------------------------------------------------------------------------
+
+	package serial::subscription;
+
+	serial::subscription->sequence( 'serial.subscription_id_seq' );
+	serial::subscription->table('serial.subscription');
+
+	#-------------------------------------------------------------------------------
+
+	package serial::issuance;
+
+	serial::issuance->sequence( 'serial.issuance_id_seq' );
+	serial::issuance->table('serial.issuance');
+
+	#-------------------------------------------------------------------------------
+
+	package serial::item;
+
+	serial::item->sequence( 'serial.item_id_seq' );
+	serial::item->table('serial.item');
+
+	#-------------------------------------------------------------------------------
+
+	package serial::unit;
+
+	serial::unit->sequence( 'asset.copy_id_seq' );
+	serial::unit->table('serial.unit');
+
+	#-------------------------------------------------------------------------------
+
+	package config::language_map;
+	config::language_map->table('config.language_map');
+
+	#-------------------------------------------------------------------------------
+
+	package config::i18n_locale;
+	config::i18n_locale->table('config.i18n_locale');
+
+	#-------------------------------------------------------------------------------
+
+	package config::i18n_core;
+	config::i18n_core->sequence( 'config.i18n_core_id_seq' );
+	config::i18n_core->table('config.i18n_core');
+
+	#-------------------------------------------------------------------------------
+
+	package config::item_form_map;
+	config::item_form_map->table('config.item_form_map');
+
+	#-------------------------------------------------------------------------------
+
+	package config::lit_form_map;
+	config::lit_form_map->table('config.lit_form_map');
+
+	#-------------------------------------------------------------------------------
+
+	package config::item_type_map;
+	config::item_type_map->table('config.item_type_map');
+
+	#-------------------------------------------------------------------------------
+	package config::audience_map;
+	config::audience_map->table('config.audience_map');
+
+	#-------------------------------------------------------------------------------
+
+
+}
+
+for my $class ( qw/
+			biblio::record_entry
+			metabib::metarecord
+			metabib::title_field_entry
+			metabib::author_field_entry
+			metabib::subject_field_entry
+			metabib::keyword_field_entry
+			metabib::series_field_entry
+			metabib::metarecord_source_map
+			metabib::record_descriptor
+			metabib::full_rec
+			authority::record_descriptor
+			authority::full_rec
+		/ ) {
+
+	(my $method_class = $class) =~ s/::/./go;
+
+	for my $type ( qw/create create_start create_push create_finish/ ) {
+		my ($name,$part) = split('_', $type);
+
+		my $apiname = "open-ils.storage.direct.$method_class.batch.$name";
+		$apiname .= ".$part" if ($part);
+
+		OpenILS::Application::Storage->register_method(
+			api_name	=> $apiname,
+			method		=> "copy_$type",
+			api_level	=> 1,
+			'package'	=> 'OpenILS::Application::Storage',
+			cdbi		=> $class,
+		);
+	}
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/fts.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/fts.pm
new file mode 100644
index 0000000000..055266a8fe
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/fts.pm
@@ -0,0 +1,89 @@
+{ # Every driver needs to provide a 'compile()' method to OpenILS::Application::Storage::FTS.
+  # If that driver wants to support FTI, that is...
+	#-------------------------------------------------------------------------------
+	package OpenILS::Application::Storage::FTS;
+	use OpenSRF::Utils::Logger qw/:level/;
+	use Unicode::Normalize;
+	my $log = 'OpenSRF::Utils::Logger';
+
+	sub compile {
+		my $self = shift;
+		my $class = shift;
+		my $term = NFD(shift());
+
+		$log->debug("Raw term: $term",DEBUG);
+		$log->debug("Search class: $class",DEBUG);
+
+		$term =~ s/\&//go;
+		$term =~ s/\|//go;
+
+		$self = ref($self) || $self;
+		$self = bless {} => $self;
+		$self->{class} = $class;
+
+		$term =~ s/(\pM+)//gos;
+		$term =~ s/(\b\.\b)//gos;
+
+		# hack to normalize ratio-like strings
+		while ($term =~ /\b\d{1}:[, ]?\d+(?:[ ,]\d+[^:])+/o) {
+			$term = $` . join ('', split(/[, ]/, $&)) . $';
+		}
+
+		$self->decompose($term);
+
+		my $newterm = '';
+		$newterm = join('&', $self->words) if ($self->words);
+
+		if (@{$self->nots}) {
+			$newterm = '('.$newterm.')&' if ($newterm);
+			$newterm .= '!('. join('|', $self->nots) . ')';
+		}
+
+		$log->debug("Compiled term is [$newterm]", DEBUG);
+		$newterm = OpenILS::Application::Storage::Driver::Pg->quote($newterm);
+		$log->debug("Quoted term is [$newterm]", DEBUG);
+
+		$self->{fts_query} = ["to_tsquery('$$self{class}',$newterm)"];
+		$self->{fts_query_nots} = [];
+		$self->{fts_op} = '@@';
+		$self->{text_col} = shift;
+		$self->{fts_col} = shift;
+
+		return $self;
+	}
+
+	sub sql_where_clause {
+		my $self = shift;
+		my $column = $self->fts_col;
+		my @output;
+	
+		my @ranks;
+		for my $fts ( $self->fts_query ) {
+			push @output, join(' ', $self->fts_col, $self->{fts_op}, $fts);
+			push @ranks, "rank($column, $fts)";
+		}
+		$self->{fts_rank} = \@ranks;
+	
+		my $phrase_match = $self->sql_exact_phrase_match();
+		return join(' AND ', @output) . $phrase_match;
+	}
+
+	sub sql_exact_phrase_match {
+		my $self = shift;
+		my $column = $self->text_col;
+		my $output = '';
+		for my $phrase ( $self->phrases ) {
+			$phrase =~ s/\*/\\*/go;
+			$phrase =~ s/\./\\./go;
+			$phrase =~ s/'/\\'/go;
+			$phrase =~ s/\s+/\\s+/go;
+			$log->debug("Adding phrase [$phrase] to the match list", DEBUG);
+			$output .= " AND $column ~* \$\$(^|\\W+)$phrase(\\W+|\$)\$\$";
+		}
+		$log->debug("Phrase list is [$output]", DEBUG);
+		return $output;
+	}
+
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/storage.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/storage.pm
new file mode 100644
index 0000000000..d7623d0d18
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg/storage.pm
@@ -0,0 +1,315 @@
+
+{
+	package OpenILS::Application::Storage;
+	use OpenSRF::Utils::Logger;
+
+	our $NOPRIMARY = 0;
+	my $log = 'OpenSRF::Utils::Logger';
+	my $pg = 'OpenILS::Application::Storage::Driver::Pg';
+
+	sub child_exit {
+		$_->disconnect for $pg->db_Handles;
+	}
+
+	sub current_xact {
+		my $self = shift;
+		my $client = shift;
+		return $pg->current_xact_id;
+	}
+	__PACKAGE__->register_method(
+		method		=> 'current_xact',
+		api_name	=> 'open-ils.storage.transaction.current',
+		api_level	=> 1,
+		argc		=> 0,
+	);
+
+
+	sub pg_begin_xaction {
+		my $self = shift;
+		my $client = shift;
+
+		local $OpenILS::Application::Storage::WRITE = 1;
+
+		if (my $old_xact = $pg->current_xact_session) {
+			if ($pg->current_xact_is_auto) {
+				$log->debug("Commiting old autocommit transaction with Open-ILS XACT-ID [$old_xact]", INFO);
+				$self->method_lookup("open-ils.storage.transaction.commit")->run();
+			} else {
+				$log->debug("Rolling back old NON-autocommit transaction with Open-ILS XACT-ID [$old_xact]", INFO);
+				$self->method_lookup("open-ils.storage.transaction.rollback")->run();
+				throw OpenSRF::DomainObject::oilsException->new(
+						statusCode => 500,
+						status => "Previous transaction rolled back!",
+				);
+			}
+		}
+		
+		$pg->set_xact_session( $client->session );
+		my $xact_id = $pg->current_xact_id;
+
+		$log->debug("Beginning a new transaction with Open-ILS XACT-ID [$xact_id]", INFO);
+
+		my $dbh = OpenILS::Application::Storage::CDBI->db_Main;
+		
+		try {
+			$dbh->begin_work;
+
+		} catch Error with {
+			my $e = shift;
+			$log->debug("Failed to begin a new transaction with Open-ILS XACT-ID [$xact_id]: ".$e, INFO);
+			throw $e;
+		};
+
+
+		my $death_cb = $client->session->register_callback(
+			death => sub {
+				__PACKAGE__->pg_rollback_xaction;
+			}
+		);
+
+		$log->debug("Registered 'death' callback [$death_cb] for new transaction with Open-ILS XACT-ID [$xact_id]", DEBUG);
+
+		$client->session->session_data( death_cb => $death_cb );
+
+		if ($self->api_name =~ /autocommit$/o) {
+			$pg->current_xact_is_auto(1);
+			my $dc_cb = $client->session->register_callback(
+				disconnect => sub {
+					my $ses = shift;
+					$ses->unregister_callback(death => $death_cb);
+					__PACKAGE__->pg_commit_xaction;
+				}
+			);
+			$log->debug("Registered 'disconnect' callback [$dc_cb] for new transaction with Open-ILS XACT-ID [$xact_id]", DEBUG);
+			if ($client and $client->session) {
+				$client->session->session_data( disconnect_cb => $dc_cb );
+			}
+		}
+
+		return 1;
+
+	}
+	__PACKAGE__->register_method(
+		method		=> 'pg_begin_xaction',
+		api_name	=> 'open-ils.storage.transaction.begin',
+		api_level	=> 1,
+		argc		=> 0,
+	);
+	__PACKAGE__->register_method(
+		method		=> 'pg_begin_xaction',
+		api_name	=> 'open-ils.storage.transaction.begin.autocommit',
+		api_level	=> 1,
+		argc		=> 0,
+	);
+
+	sub pg_commit_xaction {
+		my $self = shift;
+
+		local $OpenILS::Application::Storage::WRITE = 1;
+
+		my $xact_id = $pg->current_xact_id;
+
+		my $success = 1;
+		try {
+			$log->debug("Committing transaction with Open-ILS XACT-ID [$xact_id]", INFO) if ($xact_id);
+			my $dbh = OpenILS::Application::Storage::CDBI->db_Main;
+			$dbh->commit;
+
+		} catch Error with {
+			my $e = shift;
+			$log->debug("Failed to commit transaction with Open-ILS XACT-ID [$xact_id]: ".$e, INFO);
+			$success = 0;
+		};
+		
+		$pg->current_xact_session->unregister_callback( death => 
+			$pg->current_xact_session->session_data( 'death_cb' )
+		) if ($pg->current_xact_session);
+
+		if ($pg->current_xact_is_auto) {
+			$pg->current_xact_session->unregister_callback( disconnect => 
+				$pg->current_xact_session->session_data( 'disconnect_cb' )
+			);
+		}
+
+		$pg->unset_xact_session;
+
+		return $success;
+		
+	}
+	__PACKAGE__->register_method(
+		method		=> 'pg_commit_xaction',
+		api_name	=> 'open-ils.storage.transaction.commit',
+		api_level	=> 1,
+		argc		=> 0,
+	);
+
+	sub pg_rollback_xaction {
+		my $self = shift;
+
+		local $OpenILS::Application::Storage::WRITE = 1;
+
+		my $xact_id = $pg->current_xact_id;
+
+		my $success = 1;
+		try {
+			my $dbh = OpenILS::Application::Storage::CDBI->db_Main;
+			$log->debug("Rolling back a transaction with Open-ILS XACT-ID [$xact_id]", INFO);
+			$dbh->rollback;
+
+		} catch Error with {
+			my $e = shift;
+			$log->debug("Failed to roll back transaction with Open-ILS XACT-ID [$xact_id]: ".$e, INFO);
+			$success = 0;
+		};
+	
+		$pg->current_xact_session->unregister_callback( death =>
+			$pg->current_xact_session->session_data( 'death_cb' )
+		) if ($pg->current_xact_session);
+
+		if ($pg->current_xact_is_auto) {
+			$pg->current_xact_session->unregister_callback( disconnect =>
+				$pg->current_xact_session->session_data( 'disconnect_cb' )
+			);
+		}
+
+		$pg->unset_xact_session;
+
+		return $success;
+	}
+	__PACKAGE__->register_method(
+		method		=> 'pg_rollback_xaction',
+		api_name	=> 'open-ils.storage.transaction.rollback',
+		api_level	=> 1,
+		argc		=> 0,
+	);
+
+	sub set_savepoint {
+		my $self = shift;
+		my $client = shift;
+		my $sp = shift || 'osrf_savepoint';
+		return OpenILS::Application::Storage::CDBI->db_Main->pg_savepoint($sp);
+	}
+	__PACKAGE__->register_method(
+        	method          => 'set_savepoint',
+	        api_name        => 'open-ils.storage.savepoint.set',
+        	api_level       => 1,
+	        argc            => 1,
+	);
+
+	sub release_savepoint {
+		my $self = shift;
+		my $client = shift;
+		my $sp = shift || 'osrf_savepoint';
+		return OpenILS::Application::Storage::CDBI->db_Main->pg_release($sp);
+	}
+	__PACKAGE__->register_method(
+        	method          => 'release_savepoint',
+	        api_name        => 'open-ils.storage.savepoint.release',
+        	api_level       => 1,
+	        argc            => 1,
+	);
+
+	sub rollback_to_savepoint {
+		my $self = shift;
+		my $client = shift;
+		my $sp = shift || 'osrf_savepoint';
+		return OpenILS::Application::Storage::CDBI->db_Main->pg_rollback_to($sp);
+	}
+	__PACKAGE__->register_method(
+        	method          => 'rollback_to_savepoint',
+	        api_name        => 'open-ils.storage.savepoint.rollback',
+        	api_level       => 1,
+	        argc            => 1,
+	);
+
+
+	sub copy_create_start {
+		my $self = shift;
+		my $client = shift;
+
+		local $OpenILS::Application::Storage::WRITE = 1;
+
+		#return undef unless ($pg->current_xact_session);
+
+		my @cols = $self->{cdbi}->columns('Essential');
+		if ($NOPRIMARY) {
+			my ($p) = $self->{cdbi}->columns('Primary');
+			@cols = grep { $_ ne $p } @cols;
+		}
+
+		my $col_list = join ',', @cols;
+
+		$log->debug('Starting COPY import for '.$self->{cdbi}->table." ($col_list)", DEBUG);
+		$self->{cdbi}->sql_copy_start($self->{cdbi}->table, $col_list)->execute;
+
+		return 1;
+	}
+
+	sub copy_create_push {
+		my $self = shift;
+		my $client = shift;
+		my @fm_nodes = @_;
+
+		local $OpenILS::Application::Storage::WRITE = 1;
+
+		#return undef unless ($pg->current_xact_session);
+
+		my @cols = $self->{cdbi}->columns('Essential');
+		if ($NOPRIMARY) {
+			my ($p) = $self->{cdbi}->columns('Primary');
+			@cols = grep { $_ ne $p } @cols;
+		}
+
+		my $dbh = $self->{cdbi}->db_Main;
+		for my $node ( @fm_nodes ) {
+			next unless ($node);
+			my $line = join("\t", map { defined($node->$_()) ? $node->$_() : '\N' } @cols);
+			$log->debug("COPY line: [$line]",DEBUG);
+			$dbh->pg_putline($line."\n");
+		}
+
+		return scalar(@fm_nodes);
+	}
+
+	sub copy_create_finish {
+		my $self = shift;
+		my $client = shift;
+		my @fm_nodes = @_;
+
+		local $OpenILS::Application::Storage::WRITE = 1;
+
+		#return undef unless ($pg->current_xact_session);
+
+		my $dbh = $self->{cdbi}->db_Main;
+
+		$dbh->pg_endcopy || $log->debug("Could not end COPY with pg_endcopy", WARN);
+
+		$log->debug('COPY import for '.$self->{cdbi}->table." ($col_list) complete", DEBUG);
+
+		return 1;
+	}
+
+	sub copy_create {
+		my $self = shift;
+		my $client = shift;
+		my @fm_nodes = @_;
+
+		local $NOPRIMARY = 1;
+
+		copy_create_start(  $self => $client );
+		copy_create_push(   $self => $client => @fm_nodes );
+		copy_create_finish( $self => $client );
+
+		return scalar(@fm_nodes);
+	}
+
+	sub autoprimary {
+		my $class = shift;
+		my $val = shift;
+		$NOPRIMARY = $val if (defined $val);
+		return $NOPRIMARY;
+	}
+
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/FTS.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/FTS.pm
new file mode 100644
index 0000000000..05c4decc8c
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/FTS.pm
@@ -0,0 +1,252 @@
+use OpenSRF::Utils::Logger qw/:level/;
+my $log = 'OpenSRF::Utils::Logger';
+
+#-------------------------------------------------------------------------------
+package OpenILS::Application::Storage::FTS;
+use OpenSRF::Utils::Logger qw/:level/;
+use Parse::RecDescent;
+use OpenILS::Utils::Normalize qw( naco_normalize );
+
+my $_default_grammar_parser = new Parse::RecDescent ( <<'GRAMMAR' );
+
+
+
+search_expression: or_expr(s) | and_expr(s) | expr(s)
+or_expr: lexpr '||' rexpr
+and_expr: lexpr '&&' rexpr
+lexpr: expr
+rexpr: expr
+expr: phrase(s) | group(s) | word(s)
+joiner: '||' | '&&'
+phrase: '"' token(s) '"'
+group : '(' search_expression ')'
+word: numeric_range | negative_token | token
+negative_token: '-' .../\D+/ token
+token: /[-\w]+/
+numeric_range: /\d+-\d*/
+
+GRAMMAR
+
+sub compile {
+
+	$log->debug("You must override me somewhere, or I will make searching really slow!!!!",ERROR);;
+
+	my $self = shift;
+	my $class = shift;
+	my $term = shift;
+
+	$self = ref($self) || $self;
+	$self = bless {} => $self;
+
+	$self->decompose($term);
+
+	for my $part ( $self->words, $self->phrases ) {
+		$part = OpenILS::Application::Storage::CDBI->quote($part);
+		push @{ $self->{ fts_query } },   "'\%$part\%'";
+	}
+
+	for my $part ( $self->nots ) {
+		$part = OpenILS::Application::Storage::CDBI->quote($part);
+		push @{ $self->{ fts_query_not } },   "'\%$part\%'";
+	}
+}
+
+sub decompose {
+	my $self = shift;
+	my $term = shift;
+	my $parser = shift || $_default_grammar_parser;
+
+	$term =~ s/:/ /go;
+	$term =~ s/\s+--\s+/ /go;
+	$term =~ s/(?:&[^;]+;)//go;
+	$term =~ s/\s+/ /go;
+	$term =~ s/(^|\s+)-(\w+)/$1!$2/go;
+	$term =~ s/\b(\+)(\w+)/$2/go;
+	$term =~ s/^\s*\b(.+)\b\s*$/$1/o;
+	$term =~ s/(\d{4})-(\d{4})/$1 $2/go;
+	#$term =~ s/^(?:an?|the)\b(.*)/$1/o;
+
+	$log->debug("Stripped search term string is [$term]",DEBUG);
+
+	my $parsetree = $parser->search_expression( $term );
+	my @words = $term =~ /\b((?debug("Stripped words are[".join(', ',@words)."]",DEBUG);
+	$log->debug("Stripped nots are[".join(', ',@nots)."]",DEBUG);
+
+	my @parts;
+	while ($term =~ s/ ((?{ fts_op } = 'ILIKE';
+	$self->{ fts_col } = $self->{ text_col } = 'value';
+	$self->{ raw } = $term;
+	$self->{ parsetree } = $parsetree;
+	$self->{ words } = \@words;
+	$self->{ nots } = \@nots;
+	$self->{ phrases } = \@parts;
+
+	return $self;
+}
+
+sub fts_query_not {
+	my $self = shift;
+	return wantarray ? @{ $self->{fts_query_not} } : $self->{fts_query_not};
+}
+
+sub fts_rank {
+	my $self = shift;
+	return wantarray ? @{ $self->{fts_rank} } : $self->{fts_rank};
+}
+
+sub fts_query {
+	my $self = shift;
+	return wantarray ? @{ $self->{fts_query} } : $self->{fts_query};
+}
+
+sub raw {
+	my $self = shift;
+	return $self->{raw};
+}
+
+sub parse_tree {
+	my $self = shift;
+	return $self->{parsetree};
+}
+
+sub fts_col {
+	my $self = shift;
+	return $self->{fts_col};
+}
+
+sub text_col {
+	my $self = shift;
+	return $self->{text_col};
+}
+
+sub phrases {
+	my $self = shift;
+	return wantarray ? @{ $self->{phrases} } : $self->{phrases};
+}
+
+sub words {
+	my $self = shift;
+	return wantarray ? @{ $self->{words} } : $self->{words};
+}
+
+sub nots {
+	my $self = shift;
+	return wantarray ? @{ $self->{nots} } : $self->{nots};
+}
+
+sub sql_exact_phrase_match {
+	my $self = shift;
+	my $column = $self->text_col;
+	my $output = '';
+	for my $phrase ( $self->phrases ) {
+		$phrase =~ s/%/\\%/go;
+		$phrase =~ s/_/\\_/go;
+		$phrase =~ s/'/\\'/go;
+		$log->debug("Adding phrase [$phrase] to the match list", DEBUG);
+		$output .= " AND $column ILIKE '\%$phrase\%'";
+	}
+	$log->debug("Phrase list is [$output]", DEBUG);
+	return $output;
+}
+
+sub sql_exact_word_bump {
+	my $self = shift;
+	my $bump = shift || '0.1';
+
+	my $column = $self->text_col;
+	my $output = '';
+	for my $word ( $self->words ) {
+		$word =~ s/%/\\%/go;
+		$word =~ s/_/\\_/go;
+		$word =~ s/'/''/go;
+		$log->debug("Adding word [$word] to the relevancy bump list", DEBUG);
+		$output .= " + CASE WHEN $column ILIKE '\%$word\%' THEN $bump ELSE 0 END";
+	}
+	$log->debug("Word bump list is [$output]", DEBUG);
+	return $output;
+}
+
+sub sql_where_clause {
+	my $self = shift;
+	my @output;
+
+	for my $fts ( $self->fts_query ) {
+		push @output, join(' ', $self->fts_col, $self->{fts_op}, $fts);
+	}
+
+	for my $fts ( $self->fts_query_not ) {
+		push @output, 'NOT (' . join(' ', $self->fts_col, $self->{fts_op}, $fts) . ')';
+	}
+
+	my $phrase_match = $self->sql_exact_phrase_match();
+	return join(' AND ', @output); 
+}
+
+#-------------------------------------------------------------------------------
+use UNIVERSAL::require; 
+BEGIN {                 
+	'Class::DBI::Frozen::301'->use or 'Class::DBI'->use or die $@;
+}     
+
+package Class::DBI;
+
+{
+	no warnings;
+	no strict;
+	sub _do_search {
+		my ($proto, $search_type, @args) = @_;
+		my $class = ref $proto || $proto;
+		
+		my (@cols, @vals);
+		my $search_opts = (@args > 1 and ref($args[-1]) eq 'HASH') ? pop @args : {};
+
+		@args = %{ $args[0] } if ref $args[0] eq "HASH";
+
+		$search_opts->{offset} = int($search_opts->{page} - 1) * int($search_opts->{page_size})  if ($search_opts->{page_size});
+		$search_opts->{_placeholder} ||= '?';
+
+		my @frags;
+		while (my ($col, $val) = splice @args, 0, 2) {
+			my $column = $class->find_column($col)
+				|| (List::Util::first { $_->accessor eq $col } $class->columns)
+				|| $class->_croak("$col is not a column of $class");
+
+			if (!defined($val)) {
+				push @frags, "$col IS NULL";
+			} elsif (ref($val) and ref($val) eq 'ARRAY') {
+				push @frags, "$col IN (".join(',',map{'?'}@$val).")";
+				for my $v (@$val) {
+					push @vals, ''.$class->_deflated_column($column, $v);
+				}
+			} else {
+				push @frags, "$col $search_type $$search_opts{_placeholder}";
+				push @vals, $class->_deflated_column($column, $val);
+			}
+		}
+
+		my $frag = join " AND ", @frags;
+
+		$frag .= " ORDER BY $search_opts->{order_by}"
+			if $search_opts->{order_by};
+		$frag .= " LIMIT $search_opts->{limit}"
+			if $search_opts->{limit};
+		$frag .= " OFFSET $search_opts->{offset}"
+			if ($search_opts->{limit} && defined($search_opts->{offset}));
+
+		return $class->sth_to_objects($class->sql_Retrieve($frag), \@vals);
+	}
+}
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher.pm
new file mode 100644
index 0000000000..fb685d69b2
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher.pm
@@ -0,0 +1,757 @@
+package OpenILS::Application::Storage::Publisher;
+use base qw/OpenILS::Application::Storage/;
+our $VERSION = 1;
+
+use Digest::MD5 qw/md5_hex/;
+use OpenSRF::EX qw/:try/;
+use OpenSRF::Utils;
+use OpenSRF::Utils::Logger qw/:level/;
+use OpenILS::Utils::Fieldmapper;
+
+my $log = 'OpenSRF::Utils::Logger';
+
+
+sub register_method {
+	my $class = shift;
+	my %args = @_;
+	my %dup_args = %args;
+
+	$class = ref($class) || $class;
+
+	$args{package} ||= $class;
+	__PACKAGE__->SUPER::register_method( %args );
+
+	if (exists($dup_args{cachable}) and $dup_args{cachable}) {
+		(my $name = $dup_args{api_name}) =~ s/^open-ils\.storage/open-ils.storage.cachable/o;
+		if ($name ne $dup_args{api_name}) {
+			$dup_args{real_api_name} = $dup_args{api_name};
+			$dup_args{method} = 'cachable_wrapper';
+			$dup_args{api_name} = $name;
+			$dup_args{package} = __PACKAGE__;
+			__PACKAGE__->SUPER::register_method( %dup_args );
+		}
+	}
+
+	if ($dup_args{real_api_name} =~ /^open-ils\.storage\.direct\..+\.search.+/o ||
+	    $dup_args{api_name} =~ /^open-ils\.storage\.direct\..+\.search.+/o) {
+		$dup_args{api_name} = $dup_args{real_api_name} if ($dup_args{real_api_name});
+
+		(my $name = $dup_args{api_name}) =~ s/\.direct\./.id_list./o;
+
+		$dup_args{notes} = $dup_args{real_api_name};
+		$dup_args{real_api_name} = $dup_args{api_name};
+		$dup_args{method} = 'search_ids';
+		$dup_args{api_name} = $name;
+		$dup_args{package} = __PACKAGE__;
+
+		__PACKAGE__->SUPER::register_method( %dup_args );
+	}
+}
+
+sub cachable_wrapper {
+	my $self = shift;
+	my $client = shift;
+	my @args = @_;
+
+	my %cache_args = (
+		limit		=> 100,
+		offset		=> 0,
+		timeout		=> 7200,
+		cache_page_size	=> 1000,
+	);
+
+	my @real_args;
+	my $key_string = $self->api_name;
+	for (my $ind = 0; $ind < scalar(@args); $ind++) {
+		if (	$args[$ind] eq 'limit' ||
+			$args[$ind] eq 'offset' ||
+			$args[$ind] eq 'cache_page_size' ||
+			$args[$ind] eq 'timeout' ) {
+
+			my $key_ind = $ind;
+			$ind++;
+			my $value_ind = $ind;
+			$cache_args{$args[$key_ind]} = $args[$value_ind];
+			$log->debug("Cache limiter value for $args[$key_ind] is $args[$value_ind]", INTERNAL);
+			next;
+		}
+		$key_string .= $args[$ind];
+		$log->debug("Partial cache key value is $args[$ind]", INTERNAL);
+		push @real_args, $args[$ind];
+	}
+
+	my $cache_page = int($cache_args{offset} / $cache_args{cache_page_size});
+	my $cache_key;
+	{	use bytes;
+		$cache_key = md5_hex($key_string.$cache_page);
+	}
+
+	$log->debug("Key string for cache lookup is $key_string -> $cache_key", DEBUG);
+	$log->debug("Cache page is $cache_page", DEBUG);
+
+	my $cached_res = OpenSRF::Utils::Cache->new->get_cache( $cache_key );
+	if (defined $cached_res) {
+		$log->debug("Found ".scalar(@$cached_res)." records in the cache", INFO);
+		$log->debug("Values from cache: ".join(', ', @$cached_res), INTERNAL);
+		my $start = int($cache_args{offset} - ($cache_page * $cache_args{cache_page_size}));
+		my $end = int($start + $cache_args{limit} - 1);
+		$log->debug("Responding with values from ".$start.' to '.$end,DEBUG);
+        	$client->respond( $_ ) for ( grep { defined } @$cached_res[ $start .. $end ]);
+		return undef;
+	}
+
+	my $method = $self->method_lookup($self->{real_api_name});
+	my @res = $method->run(@real_args);
+
+
+        $client->respond( $_ ) for ( grep { defined } @res[$cache_args{offset} .. int($cache_args{offset} + $cache_args{limit} - 1)] );
+
+	$log->debug("Saving values from ".int($cache_page * $cache_args{cache_page_size})." to ".
+		int(($cache_page + 1) * $cache_args{cache_page_size}). "to the cache", INTERNAL);
+	try {
+		OpenSRF::Utils::Cache->new->put_cache(
+			$cache_key =>
+			[@res[int($cache_page * $cache_args{cache_page_size}) .. int(($cache_page + 1) * $cache_args{cache_page_size}) ]] =>
+			OpenSRF::Utils->interval_to_seconds( $cache_args{timeout} )
+		);
+	} catch Error with {
+		my $e = shift;
+		$log->error("Cache seems to be down, $e");
+	};
+
+	return undef;
+}
+
+sub random_object {
+	my $self = shift;
+	my $client = shift;
+
+	my $cdbi = $self->{cdbi};
+	my $table = $cdbi->table;
+	my $sql = <<"	SQL";
+		SELECT	id
+		  FROM	$table
+		  WHERE	id IN (( SELECT	(RANDOM() * (SELECT MAX(id) FROM $table))::INT LIMIT 1 ));
+	SQL
+
+	my $trys = 100;
+	while ($trys--) {
+
+		my $id = $cdbi->db_Main->selectcol_arrayref($sql);
+		next unless (@$id);
+
+		return ($cdbi->fast_fieldmapper(@$id))[0];
+	}
+	return undef;
+}
+
+sub retrieve_node {
+	my $self = shift;
+	my $client = shift;
+	my @ids = @_;
+
+	my $cdbi = $self->{cdbi};
+
+	for my $id ( @ids ) {
+		next unless ($id);
+
+		my ($rec) = $cdbi->fast_fieldmapper($id);
+		if ($self->api_name !~ /batch/o) {
+			return $rec if ($rec);
+		}
+		$client->respond($rec);
+	}
+	return undef;
+}
+
+sub search_ids {
+	my $self = shift;
+	my $client = shift;
+	my @args = @_;
+
+	my @res = $self->method_lookup($self->{real_api_name})->run(@args);
+
+	if (ref($res[0]) eq 'ARRAY') {
+		return [ map { $_->id } @{ $res[0] } ];
+	}
+
+	$client->respond($_) for ( map { $_->id } @res );
+	return undef;
+}
+
+sub search_where {
+	my $self = shift;
+	my $client = shift;
+	my @args = @_;
+
+	if (ref($args[0]) eq 'HASH') {
+		if ($args[1]) {
+			$args[1]{limit_dialect} = $self->{cdbi}->db_Main;
+		} else {
+			$args[1] = {limit_dialect => $self->{cdbi}->db_Main };
+		}
+	} else {
+		$args[0] = { @args };
+		$args[1] = {limit_dialect => $self->{cdbi} };
+	}
+
+	my $cdbi = $self->{cdbi};
+
+	for my $obj ($cdbi->search_where(@args)) {
+		next unless ref($obj);
+		$client->respond( $obj->to_fieldmapper );
+	}
+	return undef;
+}
+
+sub search {
+	my $self = shift;
+	my $client = shift;
+	my @args = @_;
+
+	my $cdbi = $self->{cdbi};
+
+	(my $search_type = $self->api_name) =~ s/.*\.(search[^.]*).*/$1/o;
+
+	for my $obj ($cdbi->$search_type(@args)) {
+		next unless ref($obj);
+		$client->respond( $obj->to_fieldmapper );
+	}
+	return undef;
+}
+
+sub search_one_field {
+	my $self = shift;
+	my $client = shift;
+	my @args = @_;
+
+	(my $field = $self->api_name) =~ s/.*\.([^\.]+)$/$1/o;
+
+	return search( $self, $client, $field, @args );
+}
+
+sub old_search_one_field {
+	my $self = shift;
+	my $client = shift;
+	my @terms = @_;
+
+	(my $search_type = $self->api_name) =~ s/.*\.(search[^.]*).*/$1/o;
+	(my $col = $self->api_name) =~ s/.*\.$search_type\.([^.]+).*/$1/;
+	my $cdbi = $self->{cdbi};
+
+	my $like = 0;
+	$like = 1 if ($search_type =~ /like$/o);
+	$like = 2 if ($search_type =~ /fts$/o);
+	$like = 3 if ($search_type =~ /regex$/o);
+
+	for my $term (@terms) {
+		$log->debug("Searching $cdbi for $col using type $search_type, value '$term'",DEBUG);
+		if (@terms == 1) {
+			return [ $cdbi->fast_fieldmapper($term,$col,$like) ];
+		}
+		$client->respond( [ $cdbi->fast_fieldmapper($term,$col,$like) ] );
+	}
+	return undef;
+}
+
+
+sub create_node {
+	my $self = shift;
+	my $client = shift;
+	my $node = shift;
+
+	local $OpenILS::Application::Storage::WRITE = 1;
+
+	my $cdbi = $self->{cdbi};
+
+	my $success;
+	try {
+		my $rec = $cdbi->create($node);
+		$success = $rec->id if ($rec);
+	} catch Error with {
+		$success = 0;
+	};
+
+	return $success;
+}
+
+sub update_node {
+	my $self = shift;
+	my $client = shift;
+	my $node = shift;
+
+	local $OpenILS::Application::Storage::WRITE = 1;
+
+	my $cdbi = $self->{cdbi};
+
+	return $cdbi->update($node);
+}
+
+sub mass_delete {
+	my $self = shift;
+	my $client = shift;
+	my $search = shift;
+
+	local $OpenILS::Application::Storage::WRITE = 1;
+
+	my $where = 'WHERE ';
+
+	my $cdbi = $self->{cdbi};
+	my $table = $cdbi->table;
+
+	my @keys = sort keys %$search;
+	
+	my @binds;
+	my @wheres;
+	for my $col ( @keys ) {
+		if (ref($$search{$col}) and ref($$search{$col}) =~ /ARRAY/o) {
+			push @wheres, "$col IN (" . join(',', map { '?' } @{ $$search{$col} }) . ')';
+			push @binds, map { "$_" } @{ $$search{$col} };
+		} else {
+			push @wheres, "$col = ?";
+			push @binds, $$search{$col};
+		}
+	}
+	$where .= join ' AND ', @wheres;
+
+	my $delete = "DELETE FROM $table $where";
+
+	$log->debug("Performing MASS deletion : $delete",DEBUG);
+
+	my $dbh = $cdbi->db_Main;
+	my $success = 1;
+	try {
+		my $sth = $dbh->prepare($delete);
+		$sth->execute( @binds );
+		$sth->finish;
+		$log->debug("MASS Delete succeeded",DEBUG);
+	} catch Error with {
+		$log->debug("MASS Delete FAILED : ".shift(),DEBUG);
+		$success = 0;
+	};
+	return $success;
+}
+
+sub remote_update_node {
+	my $self = shift;
+	my $client = shift;
+	my $keys = shift;
+	my $vals = shift;
+
+	local $OpenILS::Application::Storage::WRITE = 1;
+
+	my $cdbi = $self->{cdbi};
+
+	my $success = 1;
+	try {
+		$success = $cdbi->remote_update($keys,$vals);
+	} catch Error with {
+		$success = 0;
+	};
+	return $success;
+}
+
+sub merge_node {
+	my $self = shift;
+	my $client = shift;
+	my $keys = shift;
+	my $vals = shift;
+
+	local $OpenILS::Application::Storage::WRITE = 1;
+
+	my $cdbi = $self->{cdbi};
+
+	my $success = 1;
+	try {
+		$success = $cdbi->merge($keys,$vals)->id;
+	} catch Error with {
+		$success = 0;
+	};
+	return $success;
+}
+
+sub delete_node {
+	my $self = shift;
+	my $client = shift;
+	my $node = shift;
+
+	local $OpenILS::Application::Storage::WRITE = 1;
+
+	my $cdbi = $self->{cdbi};
+
+	my $success = 1;
+	try {
+		$success = $cdbi->delete($node);
+	} catch Error with {
+		$success = 0;
+	};
+	return $success;
+}
+
+sub batch_call {
+	my $self = shift;
+	my $client = shift;
+	my @nodes = @_;
+
+	my $unwrap = $self->{unwrap};
+
+	my $cdbi = $self->{cdbi};
+	my $api_name = $self->api_name;
+	(my $single_call_api_name = $api_name) =~ s/batch\.//o;
+
+	$log->debug("Default $api_name looking up $single_call_api_name...",INTERNAL);
+	my $method = $self->method_lookup($single_call_api_name);
+
+	my @success;
+	while ( my $node = shift(@nodes) ) {
+		my ($res) = $method->run( ($unwrap ? (@$node) : ($node)) ); 
+		push(@success, 1) if ($res >= 0);
+	}
+
+	my $insert_total = 0;
+	$insert_total += $_ for (@success);
+
+	return $insert_total;
+}
+
+
+# --------------------- End of generic methods -----------------------
+
+
+for my $pkg ( qw/actor action asset biblio config metabib authority money permission container/ ) {
+	"OpenILS::Application::Storage::Publisher::$pkg"->use;
+	if ($@) {
+		$log->debug("ARG! Couldn't load $pkg class Publisher: $@", ERROR);
+		throw OpenSRF::EX::ERROR ("ARG! Couldn't load $pkg class Publisher: $@");
+	}
+}
+
+for my $fmclass ( (Fieldmapper->classes) ) {
+
+	$log->debug("Generating methods for Fieldmapper class $fmclass", DEBUG);
+
+	next if ($fmclass->is_virtual);
+
+	(my $cdbi = $fmclass) =~ s/^Fieldmapper:://o;
+	(my $class = $cdbi) =~ s/::.*//o;
+	(my $api_class = $cdbi) =~ s/::/./go;
+	my $registration_class = __PACKAGE__ . "::$class";
+	my $api_prefix = 'open-ils.storage.direct.'.$api_class;
+
+	# Create the search methods
+	unless ( __PACKAGE__->is_registered( $api_prefix.'.search' ) ) {
+		__PACKAGE__->register_method(
+			api_name	=> $api_prefix.'.search',
+			method		=> 'search',
+			api_level	=> 1,
+			argc		=> 2,
+			stream		=> 1,
+			cdbi		=> $cdbi,
+			cachable	=> 1,
+		);
+	}
+
+	unless ( __PACKAGE__->is_registered( $api_prefix.'.search_where' ) ) {
+		__PACKAGE__->register_method(
+			api_name	=> $api_prefix.'.search_where',
+			method		=> 'search_where',
+			api_level	=> 1,
+			stream		=> 1,
+			argc		=> 1,
+			cdbi		=> $cdbi,
+			cachable	=> 1,
+		);
+	}
+
+=comment
+
+	unless ( __PACKAGE__->is_registered( $api_prefix.'.search_like' ) ) {
+		__PACKAGE__->register_method(
+			api_name	=> $api_prefix.'.search_like',
+			method		=> 'search',
+			api_level	=> 1,
+			stream		=> 1,
+			cdbi		=> $cdbi,
+			cachable	=> 1,
+			argc		=> 2,
+		);
+	}
+
+	if (\&Class::DBI::search_fts and $cdbi->columns('FTS')) {
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.search_fts' ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.search_fts',
+				method		=> 'search',
+				api_level	=> 1,
+				stream		=> 1,
+				cdbi		=> $cdbi,
+				cachable	=> 1,
+				argc		=> 2,
+			);
+		}
+	}
+
+	if (\&Class::DBI::search_regex) {
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.search_regex' ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.search_regex',
+				method		=> 'search',
+				api_level	=> 1,
+				stream		=> 1,
+				cdbi		=> $cdbi,
+				cachable	=> 1,
+				argc		=> 2,
+			);
+		}
+	}
+
+	if (\&Class::DBI::search_ilike) {
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.search_ilike' ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.search_ilike',
+				method		=> 'search',
+				api_level	=> 1,
+				stream		=> 1,
+				cdbi		=> $cdbi,
+				cachable	=> 1,
+				argc		=> 2,
+			);
+		}
+	}
+
+=cut
+
+	# Create the random method
+	unless ( __PACKAGE__->is_registered( $api_prefix.'.random' ) ) {
+		__PACKAGE__->register_method(
+			api_name	=> $api_prefix.'.random',
+			method		=> 'random_object',
+			api_level	=> 1,
+			cdbi		=> $cdbi,
+			argc		=> 0,
+		);
+	}
+
+	# Create the retrieve method
+	unless ( __PACKAGE__->is_registered( $api_prefix.'.retrieve' ) ) {
+		__PACKAGE__->register_method(
+			api_name	=> $api_prefix.'.retrieve',
+			method		=> 'retrieve_node',
+			api_level	=> 1,
+			cdbi		=> $cdbi,
+			cachable	=> 1,
+			argc		=> 1,
+		);
+	}
+
+	# Create the batch retrieve method
+	unless ( __PACKAGE__->is_registered( $api_prefix.'.batch.retrieve' ) ) {
+		__PACKAGE__->register_method(
+			api_name	=> $api_prefix.'.batch.retrieve',
+			method		=> 'retrieve_node',
+			api_level	=> 1,
+			stream		=> 1,
+			cdbi		=> $cdbi,
+			cachable	=> 1,
+			argc		=> 1,
+		);
+	}
+
+	for my $field ($fmclass->real_fields) {
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.search.'.$field ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.search.'.$field,
+				method		=> 'search_one_field',
+				api_level	=> 1,
+				cdbi		=> $cdbi,
+				cachable	=> 1,
+				stream		=> 1,
+				argc		=> 1,
+			);
+		}
+
+=comment
+
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.search_like.'.$field ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.search_like.'.$field,
+				method		=> 'search_one_field',
+				api_level	=> 1,
+				cdbi		=> $cdbi,
+				cachable	=> 1,
+				stream		=> 1,
+				argc		=> 1,
+			);
+		}
+		if (\&Class::DBI::search_fts and grep { $field eq $_ } $cdbi->columns('FTS')) {
+			unless ( __PACKAGE__->is_registered( $api_prefix.'.search_fts.'.$field ) ) {
+				__PACKAGE__->register_method(
+					api_name	=> $api_prefix.'.search_fts.'.$field,
+					method		=> 'search_one_field',
+					api_level	=> 1,
+					cdbi		=> $cdbi,
+					cachable	=> 1,
+					stream		=> 1,
+					argc		=> 1,
+				);
+			}
+		}
+		if (\&Class::DBI::search_regex) {
+			unless ( __PACKAGE__->is_registered( $api_prefix.'.search_regex.'.$field ) ) {
+				__PACKAGE__->register_method(
+					api_name	=> $api_prefix.'.search_regex.'.$field,
+					method		=> 'search_one_field',
+					api_level	=> 1,
+					cdbi		=> $cdbi,
+					cachable	=> 1,
+					stream		=> 1,
+					argc		=> 1,
+				);
+			}
+		}
+		if (\&Class::DBI::search_ilike) {
+			unless ( __PACKAGE__->is_registered( $api_prefix.'.search_ilike.'.$field ) ) {
+				__PACKAGE__->register_method(
+					api_name	=> $api_prefix.'.search_ilike.'.$field,
+					method		=> 'search_one_field',
+					api_level	=> 1,
+					cdbi		=> $cdbi,
+					cachable	=> 1,
+					stream		=> 1,
+					argc		=> 1,
+				);
+			}
+		}
+
+=cut
+
+	}
+
+
+	unless ($fmclass->is_readonly) {
+		# Create the create method
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.create' ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.create',
+				method		=> 'create_node',
+				api_level	=> 1,
+				cdbi		=> $cdbi,
+				argc		=> 1,
+			);
+		}
+
+		# Create the batch create method
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.batch.create' ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.batch.create',
+				method		=> 'batch_call',
+				api_level	=> 1,
+				cdbi		=> $cdbi,
+				argc		=> 1,
+			);
+		}
+
+		# Create the update method
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.update' ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.update',
+				method		=> 'update_node',
+				api_level	=> 1,
+				cdbi		=> $cdbi,
+				argc		=> 1,
+			);
+		}
+
+		# Create the batch update method
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.batch.update' ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.batch.update',
+				method		=> 'batch_call',
+				api_level	=> 1,
+				cdbi		=> $cdbi,
+				argc		=> 1,
+			);
+		}
+
+		# Create the delete method
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.delete' ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.delete',
+				method		=> 'delete_node',
+				api_level	=> 1,
+				cdbi		=> $cdbi,
+				argc		=> 1,
+			);
+		}
+
+		# Create the batch delete method
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.batch.delete' ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.batch.delete',
+				method		=> 'batch_call',
+				api_level	=> 1,
+				cdbi		=> $cdbi,
+				argc		=> 1,
+			);
+		}
+
+		# Create the merge method
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.merge' ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.merge',
+				method		=> 'merge_node',
+				api_level	=> 1,
+				cdbi		=> $cdbi,
+				argc		=> 1,
+			);
+		}
+
+		# Create the batch merge method
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.batch.merge' ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.batch.merge',
+				method		=> 'batch_call',
+				unwrap		=> 1,
+				api_level	=> 1,
+				cdbi		=> $cdbi,
+				argc		=> 1,
+			);
+		}
+
+		# Create the remote_update method
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.remote_update' ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.remote_update',
+				method		=> 'remote_update_node',
+				api_level	=> 1,
+				cdbi		=> $cdbi,
+				argc		=> 1,
+			);
+		}
+
+		# Create the batch remote_update method
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.batch.remote_update' ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.batch.remote_update',
+				method		=> 'batch_call',
+				api_level	=> 1,
+				unwrap		=> 1,
+				cdbi		=> $cdbi,
+				argc		=> 1,
+			);
+		}
+
+		# Create the search-based mass delete method
+		unless ( __PACKAGE__->is_registered( $api_prefix.'.mass_delete' ) ) {
+			__PACKAGE__->register_method(
+				api_name	=> $api_prefix.'.mass_delete',
+				method		=> 'mass_delete',
+				api_level	=> 1,
+				cdbi		=> $cdbi,
+				argc		=> 1,
+			);
+		}
+	}
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/action.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/action.pm
new file mode 100644
index 0000000000..6b96ffabca
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/action.pm
@@ -0,0 +1,2011 @@
+package OpenILS::Application::Storage::Publisher::action;
+use parent qw/OpenILS::Application::Storage::Publisher/;
+use strict;
+use warnings;
+use OpenSRF::Utils::Logger qw/:level/;
+use OpenSRF::Utils qw/:datetime/;
+use OpenSRF::Utils::JSON;
+use OpenSRF::AppSession;
+use OpenSRF::EX qw/:try/;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::PermitHold;
+use DateTime;
+use DateTime::Format::ISO8601;
+use OpenILS::Utils::Penalty;
+
+sub isTrue {
+	my $v = shift;
+	return 1 if ($v == 1);
+	return 1 if ($v =~ /^t/io);
+	return 1 if ($v =~ /^y/io);
+	return 0;
+}
+
+my $parser = DateTime::Format::ISO8601->new;
+my $log = 'OpenSRF::Utils::Logger';
+
+sub open_noncat_circs {
+	my $self = shift;
+	my $client = shift;
+	my $user = shift;
+
+	my $a = action::non_cataloged_circulation->table;
+	my $c = config::non_cataloged_type->table;
+
+	my $sql = <<"	SQL";
+		SELECT	a.id
+		  FROM	$a a
+			JOIN $c c ON (a.item_type = c.id)
+		  WHERE	a.circ_time + c.circ_duration > current_timestamp
+			AND a.patron = ?
+	SQL
+
+	return action::non_cataloged_circulation->db_Main->selectcol_arrayref($sql, {}, $user);
+}
+__PACKAGE__->register_method(
+    api_name  => 'open-ils.storage.action.open_non_cataloged_circulation.user',
+    method    => 'open_noncat_circs',
+    api_level => 1,
+    argc      => 1,
+);
+
+
+sub ou_hold_requests {
+	my $self = shift;
+	my $client = shift;
+	my $ou = shift;
+
+	my $h_table = action::hold_request->table;
+	my $c_table = asset::copy->table;
+	my $o_table = actor::org_unit->table;
+
+	my $SQL = <<"	SQL";
+		SELECT 	h.id
+		  FROM	$h_table h
+		  	JOIN $c_table cp ON (cp.id = h.current_copy)
+			JOIN $o_table ou ON (ou.id = cp.circ_lib)
+		  WHERE	ou.id = ?
+		  	AND h.capture_time IS NULL
+		  	AND h.cancel_time IS NULL
+		  	AND (h.expire_time IS NULL OR h.expire_time > NOW())
+		  ORDER BY h.request_time
+	SQL
+
+	my $sth = action::hold_request->db_Main->prepare_cached($SQL);
+	$sth->execute($ou);
+
+	$client->respond($_) for (
+		map {
+			$self
+				->method_lookup('open-ils.storage.direct.action.hold_request.retrieve')
+				->run($_)
+		} map {
+			$_->[0]
+		} @{ $sth->fetchall_arrayref }
+	);
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.action.targeted_hold_request.org_unit',
+	api_level       => 1,
+	argc		=> 1,
+	stream		=> 1,
+	method          => 'ou_hold_requests',
+);
+
+
+sub overdue_circs {
+	my $grace = shift;
+    my $upper_interval = shift || '1 millennium';
+	my $idlist = shift;
+
+	my $c_t = action::circulation->table;
+
+	if ($grace && $grace =~ /^\d+$/o) {
+    	$grace = " - ($grace * (fine_interval))";
+    } else {
+        $grace = '';
+    } 
+
+	my $sql = <<"	SQL";
+		SELECT	*
+		  FROM	$c_t
+		  WHERE	stop_fines IS NULL
+		  	AND due_date < ( CURRENT_TIMESTAMP $grace)
+            AND fine_interval < ?::INTERVAL
+	SQL
+
+	my $sth = action::circulation->db_Main->prepare_cached($sql);
+	$sth->execute($upper_interval);
+
+	my @circs = map { $idlist ? $_->{id} : action::circulation->construct($_) } $sth->fetchall_hash;
+
+	$c_t = booking::reservation->table;
+	$sql = <<"	SQL";
+		SELECT	*
+		  FROM	$c_t
+		  WHERE	return_time IS NULL
+		  	AND end_time < ( CURRENT_TIMESTAMP $grace)
+            AND fine_interval IS NOT NULL
+            AND cancel_time IS NULL
+	SQL
+
+	$sth = action::circulation->db_Main->prepare_cached($sql);
+	$sth->execute();
+
+    push @circs, map { $idlist ? $_->{id} : booking::reservation->construct($_) } $sth->fetchall_hash;
+
+    return @circs;
+}
+
+sub complete_reshelving {
+	my $self = shift;
+	my $client = shift;
+	my $window = shift;
+
+	local $OpenILS::Application::Storage::WRITE = 1;
+
+	throw OpenSRF::EX::InvalidArg ("I need an interval of more than 0 seconds!")
+		unless (interval_to_seconds( $window ));
+
+	my $setting = actor::org_unit_setting->table;
+	my $circ = action::circulation->table;
+	my $cp = asset::copy->table;
+	my $atc = action::transit_copy->table;
+
+	my $sql = <<"	SQL";
+		UPDATE	$cp
+		  SET	status = 0
+		  WHERE	id IN (
+			SELECT  id
+			  FROM  (SELECT cp.id, MAX(circ.checkin_time), MAX(trans.dest_recv_time)
+					  FROM  $cp cp
+							JOIN $circ circ ON (circ.target_copy = cp.id)
+							LEFT JOIN $atc trans ON (trans.target_copy = cp.id)
+							LEFT JOIN $setting setting
+								ON (cp.circ_lib = setting.org_unit AND setting.name = 'circ.reshelving_complete.interval')
+					  WHERE circ.checkin_time IS NOT NULL
+							AND cp.status = 7
+					  GROUP BY 1
+					  HAVING (
+						( ( MAX(circ.checkin_time) > MAX(trans.dest_recv_time) or MAX(trans.dest_recv_time) IS NULL )
+						  AND MAX(circ.checkin_time) < NOW() - CAST( COALESCE( BTRIM( FIRST(setting.value),'"' ), ? )  AS INTERVAL) )
+						OR
+						( MAX(trans.dest_recv_time) > MAX(circ.checkin_time)
+						  AND MAX(trans.dest_recv_time) < NOW() - CAST( COALESCE( BTRIM( FIRST(setting.value),'"' ), ? )  AS INTERVAL) )
+					  )
+					) AS foo
+								UNION ALL
+			SELECT  cp.id
+			  FROM  $cp cp 
+					LEFT JOIN $setting setting
+						ON (cp.circ_lib = setting.org_unit AND setting.name = 'circ.reshelving_complete.interval')
+					LEFT JOIN $circ circ ON (circ.target_copy = cp.id)
+			  WHERE cp.status = 7
+					AND circ.id IS NULL
+					AND cp.create_date < NOW() - CAST( COALESCE( BTRIM( setting.value,'"' ), ? )  AS INTERVAL)
+		  )
+	SQL
+	my $sth = action::circulation->db_Main->prepare_cached($sql);
+	$sth->execute($window, $window, $window);
+
+	return $sth->rows;
+
+}
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.action.circulation.reshelving.complete',
+	api_level       => 1,
+	argc		=> 1,
+	method          => 'complete_reshelving',
+);
+
+sub mark_longoverdue {
+	my $self = shift;
+	my $client = shift;
+	my $window = shift;
+
+	local $OpenILS::Application::Storage::WRITE = 1;
+
+	throw OpenSRF::EX::InvalidArg ("I need an interval of more than 0 seconds!")
+		unless (interval_to_seconds( $window ));
+
+	my $setting = actor::org_unit_setting->table;
+	my $circ = action::circulation->table;
+
+	my $sql = <<"	SQL";
+		UPDATE	$circ
+		  SET	stop_fines = 'LONGOVERDUE',
+			stop_fines_time = now()
+		  WHERE	id IN (
+		    SELECT  circ.id
+                      FROM  $circ circ
+                            LEFT JOIN $setting setting
+                                ON (circ.circ_lib = setting.org_unit AND setting.name = 'circ.long_overdue.interval')
+                      WHERE circ.checkin_time IS NULL AND (stop_fines IS NULL OR stop_fines NOT IN ('LOST','LONGOVERDUE'))
+                            AND AGE(circ.due_date) > CAST( COALESCE( BTRIM( setting.value,'"' ), ? )  AS INTERVAL)
+                  )
+	SQL
+
+	my $sth = action::circulation->db_Main->prepare_cached($sql);
+	$sth->execute($window);
+
+	return $sth->rows;
+
+}
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.action.circulation.long_overdue',
+	api_level       => 1,
+	argc		=> 1,
+	method          => 'mark_longoverdue',
+);
+
+sub auto_thaw_frozen_holds {
+	my $self = shift;
+	my $client = shift;
+
+	local $OpenILS::Application::Storage::WRITE = 1;
+
+	my $holds = action::hold_request->table;
+
+	my $sql = "UPDATE $holds SET frozen = FALSE WHERE frozen IS TRUE AND thaw_date < NOW();";
+
+	my $sth = action::hold_request->db_Main->prepare_cached($sql);
+	$sth->execute();
+
+	return $sth->rows;
+
+}
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.action.hold_request.thaw_expired_frozen',
+	api_level       => 1,
+	stream		=> 0,
+	argc		=> 0,
+	method          => 'auto_thaw_frozen_holds',
+);
+
+sub grab_overdue {
+	my $self = shift;
+	my $client = shift;
+	my $grace = shift || '';
+
+	my $idlist = $self->api_name =~/id_list/o ? 1 : 0;
+    
+	$client->respond( $idlist ? $_ : $_->to_fieldmapper ) for ( overdue_circs($grace, '', $idlist) );
+
+	return undef;
+
+}
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.action.circulation.overdue',
+	api_level       => 1,
+	stream		    => 1,
+	method          => 'grab_overdue',
+	signature       => q/
+		Return list of overdue circulations and reservations to be used for fine generation.
+		Despite the name, this is not a generic method for retrieving all overdue loans,
+		as it excludes loans that have already hit the maximum fine limit.
+/,
+);
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.action.circulation.overdue.id_list',
+	api_level       => 1,
+	stream		=> 1,
+	method          => 'grab_overdue',
+);
+
+sub nearest_hold {
+	my $self = shift;
+	my $client = shift;
+	my $here = shift;
+	my $cp = shift;
+	my $limit = int(shift()) || 10;
+	my $age = shift() || '0 seconds';
+	my $fifo = shift();
+
+	local $OpenILS::Application::Storage::WRITE = 1;
+
+	my $holdsort = isTrue($fifo) ?
+            "pgt.hold_priority, CASE WHEN h.cut_in_line IS TRUE THEN 0 ELSE 1 END, h.request_time, h.selection_depth DESC, p.prox " :
+            "p.prox, pgt.hold_priority, CASE WHEN h.cut_in_line IS TRUE THEN 0 ELSE 1 END, h.selection_depth DESC, h.request_time ";
+
+	my $ids = action::hold_request->db_Main->selectcol_arrayref(<<"	SQL", {}, $here, $cp, $age);
+		SELECT	h.id
+		  FROM	action.hold_request h
+			JOIN actor.org_unit_proximity p ON (p.from_org = ? AND p.to_org = h.pickup_lib)
+		  	JOIN action.hold_copy_map hm ON (hm.hold = h.id)
+		  	JOIN actor.usr au ON (au.id = h.usr)
+		  	JOIN permission.grp_tree pgt ON (au.profile = pgt.id)
+		  WHERE hm.target_copy = ?
+		  	AND (AGE(NOW(),h.request_time) >= CAST(? AS INTERVAL) OR p.prox = 0)
+			AND h.capture_time IS NULL
+		  	AND h.cancel_time IS NULL
+		  	AND (h.expire_time IS NULL OR h.expire_time > NOW())
+            AND h.frozen IS FALSE
+		ORDER BY $holdsort
+		LIMIT $limit
+	SQL
+	
+	$client->respond( $_ ) for ( @$ids );
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.action.hold_request.nearest_hold',
+	api_level	=> 1,
+	stream		=> 1,
+	method		=> 'nearest_hold',
+);
+
+sub targetable_holds {
+    my $self = shift;
+    my $client = shift;
+    my $check_expire = shift;
+
+    $check_expire ||= '12h';
+
+    local $OpenILS::Application::Storage::WRITE = 1;
+
+    # json_query can *almost* represent this query, but can't
+    # handle the CASE statement or the interval arithmetic
+    my $query = <<"    SQL";
+        SELECT ahr.id, mmsm.metarecord
+        FROM action.hold_request ahr
+        JOIN reporter.hold_request_record USING (id)
+        JOIN metabib.metarecord_source_map mmsm ON (bib_record = source)
+        WHERE capture_time IS NULL
+        AND (prev_check_time IS NULL or prev_check_time < (NOW() - ?::interval))
+        AND fulfillment_time IS NULL
+        AND cancel_time IS NULL
+        AND NOT frozen
+        ORDER BY CASE WHEN ahr.hold_type = 'F' THEN 0 ELSE 1 END, selection_depth DESC, request_time;
+    SQL
+    my $sth = action::hold_request->db_Main->prepare_cached($query);
+    $sth->execute($check_expire);
+
+    $client->respond( $_ ) for ( $sth->fetchall_arrayref );
+    return undef;
+}
+
+__PACKAGE__->register_method(
+    api_name    => 'open-ils.storage.action.hold_request.targetable_holds.id_list',
+    api_level   => 1,
+    stream      => 1,
+    method      => 'targetable_holds',
+    signature   => q/
+        Returns ordered list of hold request and metarecord IDs
+        for all hold requests that are available for initial targeting
+        or retargeting.
+        @param check interval
+        @return list of pairs of hold request and metarecord IDs
+/,
+);
+
+sub next_resp_group_id {
+	my $self = shift;
+	my $client = shift;
+
+	# XXX This is not replication safe!!!
+
+	my ($id) = action::survey->db_Main->selectrow_array(<<"	SQL");
+		SELECT NEXTVAL('action.survey_response_group_id_seq'::TEXT)
+	SQL
+	return $id;
+}
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.action.survey_response.next_group_id',
+	api_level       => 1,
+	method          => 'next_resp_group_id',
+);
+
+sub patron_circ_summary {
+	my $self = shift;
+	my $client = shift;
+	my $id = ''.shift();
+
+	return undef unless ($id);
+	my $c_table = action::circulation->table;
+	my $b_table = money::billing->table;
+
+	$log->debug("Retrieving patron summary for id $id", DEBUG);
+
+	my $select = <<"	SQL";
+		SELECT	COUNT(DISTINCT c.id), SUM( COALESCE(b.amount,0) )
+		  FROM	$c_table c
+		  	LEFT OUTER JOIN $b_table b ON (c.id = b.xact AND b.voided = FALSE)
+		  WHERE	c.usr = ?
+		  	AND c.xact_finish IS NULL
+			AND (
+				c.stop_fines NOT IN ('CLAIMSRETURNED','LOST')
+				OR c.stop_fines IS NULL
+			)
+	SQL
+
+	return action::survey->db_Main->selectrow_arrayref($select, {}, $id);
+}
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.action.circulation.patron_summary',
+	api_level       => 1,
+	method          => 'patron_circ_summary',
+);
+
+#XXX Fix stored proc calls
+sub find_local_surveys {
+	my $self = shift;
+	my $client = shift;
+	my $ou = ''.shift();
+
+	return undef unless ($ou);
+	my $s_table = action::survey->table;
+
+	my $select = <<"	SQL";
+		SELECT	s.*
+		  FROM	$s_table s
+		  	JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner)
+		  WHERE	CURRENT_TIMESTAMP BETWEEN s.start_date AND s.end_date
+	SQL
+
+	my $sth = action::survey->db_Main->prepare_cached($select);
+	$sth->execute($ou);
+
+	$client->respond( $_->to_fieldmapper ) for ( map { action::survey->construct($_) } $sth->fetchall_hash );
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.action.survey.all',
+	api_level       => 1,
+	stream          => 1,
+	method          => 'find_local_surveys',
+);
+
+#XXX Fix stored proc calls
+sub find_opac_surveys {
+	my $self = shift;
+	my $client = shift;
+	my $ou = ''.shift();
+
+	return undef unless ($ou);
+	my $s_table = action::survey->table;
+
+	my $select = <<"	SQL";
+		SELECT	s.*
+		  FROM	$s_table s
+		  	JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner)
+		  WHERE	CURRENT_TIMESTAMP BETWEEN s.start_date AND s.end_date
+		  	AND s.opac IS TRUE;
+	SQL
+
+	my $sth = action::survey->db_Main->prepare_cached($select);
+	$sth->execute($ou);
+
+	$client->respond( $_->to_fieldmapper ) for ( map { action::survey->construct($_) } $sth->fetchall_hash );
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.action.survey.opac',
+	api_level       => 1,
+	stream          => 1,
+	method          => 'find_opac_surveys',
+);
+
+sub hold_pull_list {
+	my $self = shift;
+	my $client = shift;
+	my $ou = shift;
+	my $limit = shift || 10;
+	my $offset = shift || 0;
+
+	return undef unless ($ou);
+	my $h_table = action::hold_request->table;
+	my $a_table = asset::copy->table;
+	my $ord_table = asset::copy_location_order->table;
+
+	my $idlist = 1 if ($self->api_name =~/id_list/o);
+	my $count = 1 if ($self->api_name =~/count$/o);
+
+	my $status_filter = '';
+	$status_filter = 'AND a.status IN (0,7)' if ($self->api_name =~/status_filtered/o);
+
+	my $select = <<"	SQL";
+		SELECT	h.*
+		  FROM	$h_table h
+		  	JOIN $a_table a ON (h.current_copy = a.id)
+		  	LEFT JOIN $ord_table ord ON (a.location = ord.location AND a.circ_lib = ord.org)
+		  WHERE	a.circ_lib = ?
+		  	AND h.capture_time IS NULL
+		  	AND h.cancel_time IS NULL
+		  	AND (h.expire_time IS NULL OR h.expire_time > NOW())
+			$status_filter
+		  ORDER BY CASE WHEN ord.position IS NOT NULL THEN ord.position ELSE 999 END, h.request_time
+		  LIMIT $limit
+		  OFFSET $offset
+	SQL
+
+    if ($count) {
+        $select = <<"        SQL";
+            SELECT    count(*)
+              FROM    $h_table h
+                  JOIN $a_table a ON (h.current_copy = a.id)
+              WHERE    a.circ_lib = ?
+                  AND h.capture_time IS NULL
+                  AND h.cancel_time IS NULL
+                  AND (h.expire_time IS NULL OR h.expire_time > NOW())
+                $status_filter
+        SQL
+    }
+
+	my $sth = action::survey->db_Main->prepare_cached($select);
+	$sth->execute($ou);
+
+	if ($count) {
+		$client->respond( $sth->fetchall_arrayref()->[0][0] );
+	} elsif ($idlist) {
+		$client->respond( $_->{id} ) for ( $sth->fetchall_hash );
+	} else {
+		$client->respond( $_->to_fieldmapper ) for ( map { action::hold_request->construct($_) } $sth->fetchall_hash );
+	}
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.direct.action.hold_request.pull_list.current_copy_circ_lib.count',
+	api_level       => 1,
+	stream          => 1,
+	signature	=> [
+		"Returns a count of holds for a specific library's pull list.",
+ 		[ [org_unit => "The library's org id", "number"] ],
+		['A count of holds for the stated library to pull ', 'number']
+	],
+	method          => 'hold_pull_list',
+);
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.direct.action.hold_request.pull_list.current_copy_circ_lib.status_filtered.count',
+	api_level       => 1,
+	stream          => 1,
+	signature	=> [
+		"Returns a status filtered count of holds for a specific library's pull list.",
+ 		[ [org_unit => "The library's org id", "number"] ],
+		['A status filtered count of holds for the stated library to pull ', 'number']
+	],
+	method          => 'hold_pull_list',
+);
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.direct.action.hold_request.pull_list.id_list.current_copy_circ_lib',
+	api_level       => 1,
+	stream          => 1,
+	signature	=> [
+		"Returns the hold ids for a specific library's pull list.",
+ 		[ [org_unit => "The library's org id", "number"],
+		  [limit => 'An optional page size, defaults to 10', 'number'],
+		  [offset => 'Offset for paging, defaults to 0, 0 based', 'number'],
+		],
+		['A list of holds for the stated library to pull for', 'array']
+	],
+	method          => 'hold_pull_list',
+);
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.direct.action.hold_request.pull_list.search.current_copy_circ_lib',
+	api_level       => 1,
+	stream          => 1,
+	signature	=> [
+		"Returns the holds for a specific library's pull list.",
+ 		[ [org_unit => "The library's org id", "number"],
+		  [limit => 'An optional page size, defaults to 10', 'number'],
+		  [offset => 'Offset for paging, defaults to 0, 0 based', 'number'],
+		],
+		['A list of holds for the stated library to pull for', 'array']
+	],
+	method          => 'hold_pull_list',
+);
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.direct.action.hold_request.pull_list.id_list.current_copy_circ_lib.status_filtered',
+	api_level       => 1,
+	stream          => 1,
+	signature	=> [
+		"Returns the hold ids for a specific library's pull list that are definitely in that library, based on status.",
+ 		[ [org_unit => "The library's org id", "number"],
+		  [limit => 'An optional page size, defaults to 10', 'number'],
+		  [offset => 'Offset for paging, defaults to 0, 0 based', 'number'],
+		],
+		['A list of holds for the stated library to pull for', 'array']
+	],
+	method          => 'hold_pull_list',
+);
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.direct.action.hold_request.pull_list.search.current_copy_circ_lib.status_filtered',
+	api_level       => 1,
+	stream          => 1,
+	signature	=> [
+		"Returns the holds for a specific library's pull list that are definitely in that library, based on status.",
+ 		[ [org_unit => "The library's org id", "number"],
+		  [limit => 'An optional page size, defaults to 10', 'number'],
+		  [offset => 'Offset for paging, defaults to 0, 0 based', 'number'],
+		],
+		['A list of holds for the stated library to pull for', 'array']
+	],
+	method          => 'hold_pull_list',
+);
+
+sub find_optional_surveys {
+	my $self = shift;
+	my $client = shift;
+	my $ou = ''.shift();
+
+	return undef unless ($ou);
+	my $s_table = action::survey->table;
+
+	my $select = <<"	SQL";
+		SELECT	s.*
+		  FROM	$s_table s
+		  	JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner)
+		  WHERE	CURRENT_TIMESTAMP BETWEEN s.start_date AND s.end_date
+		  	AND s.required IS FALSE;
+	SQL
+
+	my $sth = action::survey->db_Main->prepare_cached($select);
+	$sth->execute($ou);
+
+	$client->respond( $_->to_fieldmapper ) for ( map { action::survey->construct($_) } $sth->fetchall_hash );
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.action.survey.optional',
+	api_level       => 1,
+	stream          => 1,
+	method          => 'find_optional_surveys',
+);
+
+sub find_required_surveys {
+	my $self = shift;
+	my $client = shift;
+	my $ou = ''.shift();
+
+	return undef unless ($ou);
+	my $s_table = action::survey->table;
+
+	my $select = <<"	SQL";
+		SELECT	s.*
+		  FROM	$s_table s
+		  	JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner)
+		  WHERE	CURRENT_TIMESTAMP BETWEEN s.start_date AND s.end_date
+		  	AND s.required IS TRUE;
+	SQL
+
+	my $sth = action::survey->db_Main->prepare_cached($select);
+	$sth->execute($ou);
+
+	$client->respond( $_->to_fieldmapper ) for ( map { action::survey->construct($_) } $sth->fetchall_hash );
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.action.survey.required',
+	api_level       => 1,
+	stream          => 1,
+	method          => 'find_required_surveys',
+);
+
+sub find_usr_summary_surveys {
+	my $self = shift;
+	my $client = shift;
+	my $ou = ''.shift();
+
+	return undef unless ($ou);
+	my $s_table = action::survey->table;
+
+	my $select = <<"	SQL";
+		SELECT	s.*
+		  FROM	$s_table s
+		  	JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner)
+		  WHERE	CURRENT_TIMESTAMP BETWEEN s.start_date AND s.end_date
+		  	AND s.usr_summary IS TRUE;
+	SQL
+
+	my $sth = action::survey->db_Main->prepare_cached($select);
+	$sth->execute($ou);
+
+	$client->respond( $_->to_fieldmapper ) for ( map { action::survey->construct($_) } $sth->fetchall_hash );
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.action.survey.usr_summary',
+	api_level       => 1,
+	stream          => 1,
+	method          => 'find_usr_summary_surveys',
+);
+
+sub seconds_to_interval_hash {
+		my $interval = shift;
+		my $limit = shift || 's';
+		$limit =~ s/^(.)/$1/o;
+
+		my %output;
+
+		my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s);
+		my ($year, $month, $week, $day, $hour, $minute, $second) =
+				('years','months','weeks','days', 'hours', 'minutes', 'seconds');
+
+		if ($y = int($interval / (60 * 60 * 24 * 365))) {
+				$output{$year} = $y;
+				$ym = $interval % (60 * 60 * 24 * 365);
+		} else {
+				$ym = $interval;
+		}
+		return %output if ($limit eq 'y');
+
+		if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) {
+				$output{$month} = $M;
+				$Mm = $ym % ((60 * 60 * 24 * 365)/12);
+		} else {
+				$Mm = $ym;
+		}
+		return %output if ($limit eq 'M');
+
+		if ($w = int($Mm / 604800)) {
+				$output{$week} = $w;
+				$wm = $Mm % 604800;
+		} else {
+				$wm = $Mm;
+		}
+		return %output if ($limit eq 'w');
+
+		if ($d = int($wm / 86400)) {
+				$output{$day} = $d;
+				$dm = $wm % 86400;
+		} else {
+				$dm = $wm;
+		}
+		return %output if ($limit eq 'd');
+
+		if ($h = int($dm / 3600)) {
+				$output{$hour} = $h;
+				$hm = $dm % 3600;
+		} else {
+				$hm = $dm;
+		}
+		return %output if ($limit eq 'h');
+
+		if ($m = int($hm / 60)) {
+				$output{$minute} = $m;
+				$mm = $hm % 60;
+		} else {
+				$mm = $hm;
+		}
+		return %output if ($limit eq 'm');
+
+		if ($s = int($mm)) {
+				$output{$second} = $s;
+		} else {
+				$output{$second} = 0 unless (keys %output);
+		}
+		return %output;
+}
+
+
+sub generate_fines {
+	my $self = shift;
+	my $client = shift;
+	my $grace = shift;
+	my $circ = shift;
+	my $overbill = shift;
+
+	local $OpenILS::Application::Storage::WRITE = 1;
+
+	my @circs;
+	if ($circ) {
+		push @circs,
+            action::circulation->search_where( { id => $circ, stop_fines => undef } ),
+            booking::reservation->search_where( { id => $circ, return_time => undef, cancel_time => undef } );
+	} else {
+		push @circs, overdue_circs($grace);
+	}
+
+	my %hoo = map { ( $_->id => $_ ) } actor::org_unit::hours_of_operation->retrieve_all;
+
+	my $penalty = OpenSRF::AppSession->create('open-ils.penalty');
+	for my $c (@circs) {
+
+        my $ctype = ref($c);
+        $ctype =~ s/^.+::(\w+)$/$1/;
+	
+        my $due_date_method = 'due_date';
+        my $target_copy_method = 'target_copy';
+        my $circ_lib_method = 'circ_lib';
+        my $recurring_fine_method = 'recurring_fine';
+        my $is_reservation = 0;
+        if ($ctype eq 'reservation') {
+            $is_reservation = 1;
+            $due_date_method = 'end_time';
+            $target_copy_method = 'current_resource';
+            $circ_lib_method = 'pickup_lib';
+            $recurring_fine_method = 'fine_amount';
+            next unless ($c->fine_interval);
+        }
+
+		try {
+			if ($self->method_lookup('open-ils.storage.transaction.current')->run) {
+				$log->debug("Cleaning up after previous transaction\n");
+				$self->method_lookup('open-ils.storage.transaction.rollback')->run;
+			}
+			$self->method_lookup('open-ils.storage.transaction.begin')->run( $client );
+			$log->info(
+				sprintf("Processing %s %d...",
+					($is_reservation ? "reservation" : "circ"), $c->id
+				)
+			);
+
+
+			my $due_dt = $parser->parse_datetime( cleanse_ISO8601( $c->$due_date_method ) );
+	
+			my $due = $due_dt->epoch;
+			my $now = time;
+
+			my $fine_interval = $c->fine_interval;
+            $fine_interval =~ s/(\d{2}):(\d{2}):(\d{2})/$1 h $2 m $3 s/o;
+			$fine_interval = interval_to_seconds( $fine_interval );
+	
+			if ( $is_reservation and $fine_interval >= interval_to_seconds('1d') ) {	
+				my $tz_offset_s = 0;
+				if ($due_dt->strftime('%z') =~ /(-|\+)(\d{2}):?(\d{2})/) {
+					$tz_offset_s = $1 . interval_to_seconds( "${2}h ${3}m"); 
+				}
+	
+				$due -= ($due % $fine_interval) + $tz_offset_s;
+				$now -= ($now % $fine_interval) + $tz_offset_s;
+			}
+	
+			$client->respond(
+				"ARG! Overdue $ctype ".$c->id.
+				" for item ".$c->$target_copy_method.
+				" (user ".$c->usr.").\n".
+				"\tItem was due on or before: ".localtime($due)."\n");
+	
+			my @fines = money::billing->search_where(
+				{ xact => $c->id,
+				  btype => 1,
+				  billing_ts => { '>' => $c->$due_date_method } },
+				{ order_by => 'billing_ts DESC'}
+			);
+
+			my $f_idx = 0;
+			my $fine = $fines[$f_idx] if (@fines);
+			if ($overbill) {
+				$fine = $fines[++$f_idx] while ($fine and $fine->voided);
+			}
+
+			my $current_fine_total = 0;
+			$current_fine_total += int($_->amount * 100) for (grep { $_ and !$_->voided } @fines);
+	
+			my $last_fine;
+			if ($fine) {
+				$client->respond( "Last billing time: ".$fine->billing_ts." (clensed format: ".cleanse_ISO8601( $fine->billing_ts ).")");
+				$last_fine = $parser->parse_datetime( cleanse_ISO8601( $fine->billing_ts ) )->epoch;
+			} else {
+				$log->info( "Potential first billing for circ ".$c->id );
+				$last_fine = $due;
+
+				if (0) {
+					if (my $h = $hoo{$c->$circ_lib_method}) { 
+
+						$log->info( "Circ lib has an hours-of-operation entry" );
+						# find the day after the due date...
+						$due_dt = $due_dt->add( days => 1 );
+
+						# get the day of the week for that day...
+						my $dow = $due_dt->day_of_week_0;
+						my $dow_open = "dow_${dow}_open";
+						my $dow_close = "dow_${dow}_close";
+
+						my $count = 0;
+						while ( $h->$dow_open eq '00:00:00' and $h->$dow_close eq '00:00:00' ) {
+							# if the circ lib is closed, add a day to the grace period...
+
+							$grace++;
+							$log->info( "Grace period for circ ".$c->id." extended to $grace intervals" );
+							$log->info( "Day of week $dow open $dow_open, close $dow_close" );
+
+							$due_dt = $due_dt->add( days => 1 );
+							$dow = $due_dt->day_of_week_0;
+							$dow_open = "dow_${dow}_open";
+							$dow_close = "dow_${dow}_close";
+
+							$count++;
+
+							# and check for up to a week
+							last if ($count > 6);
+						}
+					}
+				}
+			}
+
+            next if ($last_fine > $now);
+            my $pending_fine_count = int( ($now - $last_fine) / $fine_interval ); 
+
+            # Generate fines for the interval we are currently inside, when the fine interval is some multiple of 1d
+            $pending_fine_count++ if ($fine_interval && ($fine_interval % 86400 == 0));
+
+            if ( $last_fine == $due                         # we have no fines yet
+                 && $grace                                  # and we have a grace period
+                 && $pending_fine_count <= $grace           # and we seem to be inside that period
+                 && $now < $due + $fine_interval * $grace   # and some date math bares that out, then
+            ) {
+                $client->respond( "Still inside grace period of: ". seconds_to_interval( $fine_interval * $grace)."\n" );
+                $log->info( "Circ ".$c->id." is still inside grace period of: $grace [". seconds_to_interval( $fine_interval * $grace).']' );
+                next;
+            }
+
+            $client->respond( "\t$pending_fine_count pending fine(s)\n" );
+            next unless ($pending_fine_count);
+
+			my $recurring_fine = int($c->$recurring_fine_method * 100);
+			my $max_fine = int($c->max_fine * 100);
+
+			my ($latest_billing_ts, $latest_amount) = ('',0);
+			for (my $bill = 1; $bill <= $pending_fine_count; $bill++) {
+	
+				if ($current_fine_total >= $max_fine) {
+					$c->update({stop_fines => 'MAXFINES', stop_fines_time => 'now'}) if ($ctype eq 'circulation');
+					$client->respond(
+						"\tMaximum fine level of ".$c->max_fine.
+						" reached for this $ctype.\n".
+						"\tNo more fines will be generated.\n" );
+					last;
+				}
+				
+				# XXX Use org time zone (or default to 'local') once we have the ou setting built for that
+				my $billing_ts = DateTime->from_epoch( epoch => $last_fine, time_zone => 'local' );
+				my $current_bill_count = $bill;
+				while ( $current_bill_count ) {
+					$billing_ts->add( seconds_to_interval_hash( $fine_interval ) );
+					$current_bill_count--;
+				}
+
+				my $dow = $billing_ts->day_of_week_0();
+				my $dow_open = "dow_${dow}_open";
+				my $dow_close = "dow_${dow}_close";
+
+				if (my $h = $hoo{$c->$circ_lib_method}) {
+					next if ( $h->$dow_open eq '00:00:00' and $h->$dow_close eq '00:00:00');
+				}
+
+				my $timestamptz = $billing_ts->strftime('%FT%T%z');
+				my @cl = actor::org_unit::closed_date->search_where(
+						{ close_start	=> { '<=' => $timestamptz },
+						  close_end	=> { '>=' => $timestamptz },
+						  org_unit	=> $c->$circ_lib_method }
+				);
+				next if (@cl);
+	
+				$current_fine_total += $recurring_fine;
+				$latest_amount += $recurring_fine;
+				$latest_billing_ts = $timestamptz;
+
+				money::billing->create(
+					{ xact		=> ''.$c->id,
+					  note		=> "System Generated Overdue Fine",
+					  billing_type	=> "Overdue materials",
+					  btype		=> 1,
+					  amount	=> sprintf('%0.2f', $recurring_fine/100),
+					  billing_ts	=> $timestamptz,
+					}
+				);
+
+			}
+
+			$client->respond( "\t\tAdding fines totaling $latest_amount for overdue up to $latest_billing_ts\n" )
+				if ($latest_billing_ts and $latest_amount);
+
+			$self->method_lookup('open-ils.storage.transaction.commit')->run;
+
+			if(1) { 
+
+                # Caluclate penalties inline
+				OpenILS::Utils::Penalty->calculate_penalties(
+					undef, $c->usr->to_fieldmapper->id.'', $c->$circ_lib_method->to_fieldmapper->id.'');
+
+			} else {
+
+                # Calculate penalties with an aysnc call to the penalty server.  This approach
+                # may lead to duplicate penalties since multiple penalty processes for a
+                # given user may be running at the same time. Leave this here for reference 
+                # in case we later find that asyc calls are needed in some environments.
+				$penalty->request(
+				    'open-ils.penalty.patron_penalty.calculate',
+				    { patronid	=> ''.$c->usr,
+				    context_org	=> ''.$c->$circ_lib_method,
+				    update	=> 1,
+				    background	=> 1,
+				    }
+			    )->gather(1);
+			}
+
+		} catch Error with {
+			my $e = shift;
+			$client->respond( "Error processing overdue $ctype [".$c->id."]:\n\n$e\n" );
+			$log->error("Error processing overdue $ctype [".$c->id."]:\n$e\n");
+			$self->method_lookup('open-ils.storage.transaction.rollback')->run;
+			throw $e if ($e =~ /IS NOT CONNECTED TO THE NETWORK/o);
+		};
+	}
+}
+__PACKAGE__->register_method(
+	api_name        => 'open-ils.storage.action.circulation.overdue.generate_fines',
+	api_level       => 1,
+	stream		=> 1,
+	method          => 'generate_fines',
+);
+
+
+
+sub new_hold_copy_targeter {
+	my $self = shift;
+	my $client = shift;
+	my $check_expire = shift;
+	my $one_hold = shift;
+
+	local $OpenILS::Application::Storage::WRITE = 1;
+
+	$self->{target_weight} = {};
+	$self->{max_loops} = {};
+
+	my $holds;
+
+	try {
+		if ($one_hold) {
+			$self->method_lookup('open-ils.storage.transaction.begin')->run( $client );
+			$holds = [ action::hold_request->search_where( { id => $one_hold, fulfillment_time => undef, cancel_time => undef } ) ];
+		} elsif ( $check_expire ) {
+
+			# what's the retarget time threashold?
+			my $time = time;
+			$check_expire ||= '12h';
+			$check_expire = interval_to_seconds( $check_expire );
+
+			my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time() - $check_expire);
+			$year += 1900;
+			$mon += 1;
+			my $expire_threshold = sprintf(
+				'%s-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d-00',
+				$year, $mon, $mday, $hour, $min, $sec
+			);
+
+			# find all the holds holds needing retargeting
+			$holds = [ action::hold_request->search_where(
+							{ capture_time => undef,
+							  fulfillment_time => undef,
+							  cancel_time => undef,
+							  frozen => 'f',
+							  prev_check_time => { '<=' => $expire_threshold },
+							},
+							{ order_by => 'CASE WHEN hold_type = \'F\' THEN 0 ELSE 1 END, selection_depth DESC, request_time,prev_check_time' } ) ];
+
+			# find all the holds holds needing first time targeting
+			push @$holds, action::hold_request->search(
+							capture_time => undef,
+							fulfillment_time => undef,
+				  			prev_check_time => undef,
+							frozen => 'f',
+							cancel_time => undef,
+							{ order_by => 'CASE WHEN hold_type = \'F\' THEN 0 ELSE 1 END, selection_depth DESC, request_time' } );
+		} else {
+
+			# find all the holds holds needing first time targeting ONLY
+			$holds = [ action::hold_request->search(
+							capture_time => undef,
+							fulfillment_time => undef,
+				  			prev_check_time => undef,
+							cancel_time => undef,
+							frozen => 'f',
+							{ order_by => 'CASE WHEN hold_type = \'F\' THEN 0 ELSE 1 END, selection_depth DESC, request_time' } ) ];
+		}
+	} catch Error with {
+		my $e = shift;
+		die "Could not retrieve uncaptured hold requests:\n\n$e\n";
+	};
+
+	my @closed = actor::org_unit::closed_date->search_where(
+		{ close_start => { '<=', 'now' },
+		  close_end => { '>=', 'now' } }
+	);
+
+    if ($check_expire) {
+
+        # $check_expire, if it exists, was already converted to seconds
+    	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time() + $check_expire);
+	    $year += 1900;
+    	$mon += 1;
+
+	    my $next_check_time = sprintf(
+    		'%s-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d-00',
+	    	$year, $mon, $mday, $hour, $min, $sec
+    	);
+
+
+	    my @closed_at_next = actor::org_unit::closed_date->search_where(
+		    { close_start => { '<=', $next_check_time },
+    		  close_end => { '>=', $next_check_time } }
+	    );
+
+        my @new_closed;
+        for my $c_at_n (@closed_at_next) {
+            if (grep { ''.$_->org_unit eq ''.$c_at_n->org_unit } @closed) {
+                push @new_closed, $c_at_n;
+            }
+        }
+        @closed = @new_closed;
+    }
+
+	my @successes;
+	my $actor = OpenSRF::AppSession->create('open-ils.actor');
+
+	for my $hold (@$holds) {
+		try {
+			#start a transaction if needed
+			if ($self->method_lookup('open-ils.storage.transaction.current')->run) {
+				$log->debug("Cleaning up after previous transaction\n");
+				$self->method_lookup('open-ils.storage.transaction.rollback')->run;
+			}
+			$self->method_lookup('open-ils.storage.transaction.begin')->run( $client );
+			$log->info("Processing hold ".$hold->id."...\n");
+
+			#first, re-fetch the hold, to make sure it's not captured already
+			$hold->remove_from_object_index();
+			$hold = action::hold_request->retrieve( $hold->id );
+
+			die "OK\n" if (!$hold or $hold->capture_time or $hold->cancel_time);
+
+			# remove old auto-targeting maps
+			my @oldmaps = action::hold_copy_map->search( hold => $hold->id );
+			$_->delete for (@oldmaps);
+
+			if ($hold->expire_time) {
+				my $ex_time = $parser->parse_datetime( cleanse_ISO8601( $hold->expire_time ) );
+				if ( DateTime->compare($ex_time, DateTime->now) < 0 ) {
+
+					# cancel cause = un-targeted expiration
+					$hold->update( { cancel_time => 'now', cancel_cause => 1 } ); 
+					$self->method_lookup('open-ils.storage.transaction.commit')->run;
+
+					# tell A/T the hold was cancelled
+					my $fm_hold = $hold->to_fieldmapper;
+					my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+					$ses->request('open-ils.trigger.event.autocreate', 
+						'hold_request.cancel.expire_no_target', $fm_hold, $fm_hold->pickup_lib);
+
+					die "OK\n";
+				}
+			}
+
+			my $all_copies = [];
+
+			# find filters for MR holds
+			my ($types, $formats, $lang);
+			if (defined($hold->holdable_formats)) {
+				($types, $formats, $lang) = split '-', $hold->holdable_formats;
+			}
+
+			# find all the potential copies
+			if ($hold->hold_type eq 'M') {
+				for my $r ( map
+						{$_->record}
+						metabib::record_descriptor
+							->search(
+								record => [
+									map {
+										isTrue($_->deleted) ?  () : ($_->id)
+									} metabib::metarecord->retrieve($hold->target)->source_records
+								],
+								( $types   ? (item_type => [split '', $types])   : () ),
+								( $formats ? (item_form => [split '', $formats]) : () ),
+								( $lang	   ? (item_lang => $lang)				 : () ),
+							)
+				) {
+					my ($rtree) = $self
+						->method_lookup( 'open-ils.storage.biblio.record_entry.ranged_tree')
+						->run( $r->id, $hold->selection_ou, $hold->selection_depth );
+
+					for my $cn ( @{ $rtree->call_numbers } ) {
+						push @$all_copies,
+							asset::copy->search_where(
+								{ id => [map {$_->id} @{ $cn->copies }],
+								  deleted => 'f' }
+							) if ($cn && @{ $cn->copies });
+					}
+				}
+			} elsif ($hold->hold_type eq 'T') {
+				my ($rtree) = $self
+					->method_lookup( 'open-ils.storage.biblio.record_entry.ranged_tree')
+					->run( $hold->target, $hold->selection_ou, $hold->selection_depth );
+
+				unless ($rtree) {
+					push @successes, { hold => $hold->id, eligible_copies => 0, error => 'NO_RECORD' };
+					die "OK\n";
+				}
+
+				for my $cn ( @{ $rtree->call_numbers } ) {
+					push @$all_copies,
+						asset::copy->search_where(
+							{ id => [map {$_->id} @{ $cn->copies }],
+							  deleted => 'f' }
+						) if ($cn && @{ $cn->copies });
+				}
+			} elsif ($hold->hold_type eq 'V') {
+				my ($vtree) = $self
+					->method_lookup( 'open-ils.storage.asset.call_number.ranged_tree')
+					->run( $hold->target, $hold->selection_ou, $hold->selection_depth );
+
+				push @$all_copies,
+					asset::copy->search_where(
+						{ id => [map {$_->id} @{ $vtree->copies }],
+						  deleted => 'f' }
+					) if ($vtree && @{ $vtree->copies });
+					
+			} elsif ($hold->hold_type eq 'I') {
+				my ($itree) = $self
+					->method_lookup( 'open-ils.storage.serial.issuance.ranged_tree')
+					->run( $hold->target, $hold->selection_ou, $hold->selection_depth );
+
+				push @$all_copies,
+					asset::copy->search_where(
+						{ id => [map {$_->unit->id} @{ $itree->items }],
+						  deleted => 'f' }
+					) if ($itree && @{ $itree->items });
+					
+			} elsif  ($hold->hold_type eq 'C' || $hold->hold_type eq 'R' || $hold->hold_type eq 'F') {
+				my $_cp = asset::copy->retrieve($hold->target);
+				push @$all_copies, $_cp if $_cp;
+			}
+
+			# trim unholdables
+			@$all_copies = grep {	isTrue($_->status->holdable) && 
+						isTrue($_->location->holdable) && 
+						isTrue($_->holdable) &&
+						!isTrue($_->deleted) &&
+						isTrue($hold->mint_condition) ? isTrue($_->mint_condition) : 1
+					} @$all_copies;
+
+			# let 'em know we're still working
+			$client->status( new OpenSRF::DomainObject::oilsContinueStatus );
+			
+			# if we have no copies ...
+			if (!ref $all_copies || !@$all_copies) {
+				$log->info("\tNo copies available for targeting at all!\n");
+				push @successes, { hold => $hold->id, eligible_copies => 0, error => 'NO_COPIES' };
+
+				$hold->update( { prev_check_time => 'today', current_copy => undef } );
+				$self->method_lookup('open-ils.storage.transaction.commit')->run;
+				die "OK\n";
+			}
+
+			my $copy_count = @$all_copies;
+
+			# map the potentials, so that we can pick up checkins
+			# XXX Loop-based targeting may require that /only/ copies from this loop should be added to
+			# XXX the potentials list.  If this is the cased, hold_copy_map creation will move down further.
+			$log->debug( "\tMapping ".scalar(@$all_copies)." potential copies for hold ".$hold->id);
+			action::hold_copy_map->create( { hold => $hold->id, target_copy => $_->id } ) for (@$all_copies);
+
+			#$client->status( new OpenSRF::DomainObject::oilsContinueStatus );
+
+			my @good_copies;
+			for my $c (@$all_copies) {
+				# current target
+				next if ($c->id eq $hold->current_copy);
+
+				# circ lib is closed
+				next if ( grep { ''.$_->org_unit eq ''.$c->circ_lib } @closed );
+
+				# target of another hold
+				next if (action::hold_request
+						->search_where(
+							{ current_copy => $c->id,
+							  fulfillment_time => undef,
+							  cancel_time => undef,
+							}
+						)
+				);
+
+				# we passed all three, keep it
+				push @good_copies, $c if ($c);
+				#$client->status( new OpenSRF::DomainObject::oilsContinueStatus );
+			}
+
+			$log->debug("\t".scalar(@good_copies)." (non-current) copies available for targeting...");
+
+			my $old_best = $hold->current_copy;
+			$hold->update({ current_copy => undef }) if ($old_best);
+	
+			if (!scalar(@good_copies)) {
+				$log->info("\tNo (non-current) copies eligible to fill the hold.");
+				if ( $old_best && grep { ''.$old_best->id eq ''.$_->id } @$all_copies ) {
+					# the old copy is still available
+					$log->debug("\tPushing current_copy back onto the targeting list");
+					push @good_copies, $old_best;
+				} else {
+					# oops, old copy is not available
+					$log->debug("\tcurrent_copy is no longer available for targeting... NEXT HOLD, PLEASE!");
+					$hold->update( { prev_check_time => 'today' } );
+					$self->method_lookup('open-ils.storage.transaction.commit')->run;
+					push @successes, { hold => $hold->id, eligible_copies => 0, error => 'NO_TARGETS' };
+					die "OK\n";
+				}
+			}
+
+            my $pu_lib = ''.$hold->pickup_lib;
+
+			my $prox_list = [];
+			$$prox_list[0] =
+			[
+				grep {
+					''.$_->circ_lib eq $pu_lib &&
+                    ( $_->status == 0 || $_->status == 7 )
+				} @good_copies
+			];
+
+			$all_copies = [grep { $_->status == 0 || $_->status == 7 } grep {''.$_->circ_lib ne $pu_lib } @good_copies];
+			# $all_copies is now a list of copies not at the pickup library
+
+			my $best = choose_nearest_copy($hold, $prox_list);
+			$client->status( new OpenSRF::DomainObject::oilsContinueStatus );
+
+			if (!$best) {
+				$log->debug("\tNothing at the pickup lib, looking elsewhere among ".scalar(@$all_copies)." copies");
+
+				$self->{max_loops}{$pu_lib} = $actor->request(
+					'open-ils.actor.ou_setting.ancestor_default' => $pu_lib => 'circ.holds.max_org_unit_target_loops'
+				)->gather(1);
+
+				if (defined($self->{max_loops}{$pu_lib})) {
+					$self->{max_loops}{$pu_lib} = $self->{max_loops}{$pu_lib}{value};
+
+					my %circ_lib_map =  map { (''.$_->circ_lib => 1) } @$all_copies;
+					my $circ_lib_list = [keys %circ_lib_map];
+	
+					my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
+	
+					# Grab the "biggest" loop for this hold so far
+					my $current_loop = $cstore->request(
+						'open-ils.cstore.json_query',
+						{ distinct => 1,
+						  select => { aufhmxl => ['max'] },
+						  from => 'aufhmxl',
+						  where => { hold => $hold->id}
+						}
+					)->gather(1);
+	
+					$current_loop = $current_loop->{max} if ($current_loop);
+					$current_loop ||= 1;
+	
+					my $exclude_list = $cstore->request(
+						'open-ils.cstore.json_query.atomic',
+						{ distinct => 1,
+						  select => { aufhol => ['circ_lib'] },
+						  from => 'aufhol',
+						  where => { hold => $hold->id}
+						}
+					)->gather(1);
+	
+					my @keepers;
+					if ($exclude_list && @$exclude_list) {
+						$exclude_list = [map {$_->{circ_lib}} @$exclude_list];
+						# check to see if we've used up every library in the potentials list
+						for my $l ( @$circ_lib_list ) {
+							my $keep = 1;
+							for my $ex ( @$exclude_list ) {
+								if ($ex eq $l) {
+									$keep = 0;
+									last;
+								}
+							}
+							push(@keepers, $l) if ($keep);
+						}
+					} else {
+						@keepers = @$circ_lib_list;
+					}
+	
+					$current_loop++ if (!@keepers);
+	
+					if ($self->{max_loops}{$pu_lib} && $self->{max_loops}{$pu_lib} >= $current_loop) {
+						# We haven't exceeded max_loops yet
+						my @keeper_copies;
+						for my $cp ( @$all_copies ) {
+							push(@keeper_copies, $cp) if ( grep { $_ eq ''.$cp->circ_lib } @keepers );
+						}
+						$all_copies = [@keeper_copies];
+					} else {
+						# We have, and should remove potentials and cancel the hold
+						my @oldmaps = action::hold_copy_map->search( hold => $hold->id );
+						$_->delete for (@oldmaps);
+
+						# cancel cause = un-targeted expiration
+						$hold->update( { cancel_time => 'now', cancel_cause => 1 } ); 
+						$self->method_lookup('open-ils.storage.transaction.commit')->run;
+
+						# tell A/T the hold was cancelled
+						my $fm_hold = $hold->to_fieldmapper;
+						my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+						$ses->request('open-ils.trigger.event.autocreate', 
+							'hold_request.cancel.expire_no_target', $fm_hold, $fm_hold->pickup_lib);
+
+						die "OK\n";
+					}
+				}
+
+				$prox_list = create_prox_list( $self, $pu_lib, $all_copies );
+
+				$client->status( new OpenSRF::DomainObject::oilsContinueStatus );
+
+				$best = choose_nearest_copy($hold, $prox_list);
+			}
+
+			$client->status( new OpenSRF::DomainObject::oilsContinueStatus );
+			if ($old_best) {
+				# hold wasn't fulfilled, record the fact
+			
+				$log->info("\tHold was not (but should have been) fulfilled by ".$old_best->id);
+				action::unfulfilled_hold_list->create(
+						{ hold => ''.$hold->id,
+						  current_copy => ''.$old_best->id,
+						  circ_lib => ''.$old_best->circ_lib,
+						});
+			}
+
+			if ($best) {
+				$hold->update( { current_copy => ''.$best->id, prev_check_time => 'now' } );
+				$log->debug("\tUpdating hold [".$hold->id."] with new 'current_copy' [".$best->id."] for hold fulfillment.");
+			} elsif (
+				$old_best &&
+				!action::hold_request
+					->search_where(
+						{ current_copy => $old_best->id,
+						  fulfillment_time => undef,
+						  cancel_time => undef,
+						}       
+					)
+			) {     
+				$hold->update( { prev_check_time => 'now', current_copy => ''.$old_best->id } );
+				$log->debug( "\tRetargeting the previously targeted copy [".$old_best->id."]" );
+			} else {
+				$hold->update( { prev_check_time => 'now' } );
+				$log->info( "\tThere were no targetable copies for the hold" );
+				process_recall($actor, $log, $hold, \@good_copies);
+			}
+
+			$self->method_lookup('open-ils.storage.transaction.commit')->run;
+			$log->info("\tProcessing of hold ".$hold->id." complete.");
+
+			push @successes,
+				{ hold => $hold->id,
+				  old_target => ($old_best ? $old_best->id : undef),
+				  eligible_copies => $copy_count,
+				  target => ($best ? $best->id : undef) };
+
+		} otherwise {
+			my $e = shift;
+			if ($e !~ /^OK/o) {
+				$log->error("Processing of hold failed:  $e");
+				$self->method_lookup('open-ils.storage.transaction.rollback')->run;
+				throw $e if ($e =~ /IS NOT CONNECTED TO THE NETWORK/o);
+			}
+		};
+	}
+
+	return \@successes;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.action.hold_request.copy_targeter',
+	api_level	=> 1,
+	method		=> 'new_hold_copy_targeter',
+);
+
+sub process_recall {
+    my ($actor, $log, $hold, $good_copies) = @_;
+
+    # Bail early if we don't have required settings to avoid spurious requests
+    my ($recall_threshold, $return_interval, $fine_rules);
+
+    my $rv = $actor->request(
+        'open-ils.actor.ou_setting.ancestor_default', ''.$hold->pickup_lib, 'circ.holds.recall_threshold'
+    )->gather(1);
+
+    if (!$rv) {
+        $log->info("Recall threshold was not set; bailing out on hold ".$hold->id." processing.");
+        return;
+    }
+    $recall_threshold = $rv->{value};
+
+    $rv = $actor->request(
+        'open-ils.actor.ou_setting.ancestor_default', ''.$hold->pickup_lib, 'circ.holds.recall_return_interval'
+    )->gather(1);
+
+    if (!$rv) {
+        $log->info("Recall return interval was not set; bailing out on hold ".$hold->id." processing.");
+        return;
+    }
+    $return_interval = $rv->{value};
+
+    $rv = $actor->request(
+        'open-ils.actor.ou_setting.ancestor_default', ''.$hold->pickup_lib, 'circ.holds.recall_fine_rules'
+    )->gather(1);
+
+    if ($rv) {
+        $fine_rules = $rv->{value};
+    }
+
+    $log->info("Recall threshold: $recall_threshold; return interval: $return_interval");
+
+    # We want checked out copies (status = 1) at the hold pickup lib
+    my $all_copies = [grep { $_->status == 1 } grep {''.$_->circ_lib eq ''.$hold->pickup_lib } @$good_copies];
+
+    my @copy_ids = map { $_->id } @$all_copies;
+
+    $log->info("Found " . scalar(@$all_copies) . " eligible checked-out copies for recall");
+
+    my $return_date = DateTime->now(time_zone => 'local')->add(seconds => interval_to_seconds($return_interval))->iso8601();
+
+    # Iterate over the checked-out copies to find a copy with a
+    # loan period longer than the recall threshold:
+    my $circs = [ action::circulation->search_where(
+        { target_copy => \@copy_ids, checkin_time => undef, duration => { '>' => $recall_threshold } },
+        { order_by => 'due_date ASC' }
+    )];
+
+    # If we have a candidate copy, then:
+    if (scalar(@$circs)) {
+        my $circ = $circs->[0];
+        $log->info("Recalling circ ID : " . $circ->id);
+
+        # Give the user a new due date of either a full recall threshold,
+        # or the return interval, whichever is further in the future
+        my $threshold_date = DateTime::Format::ISO8601->parse_datetime(cleanse_ISO8601($circ->xact_start))->add(seconds => interval_to_seconds($recall_threshold))->iso8601();
+        if (DateTime->compare(DateTime::Format::ISO8601->parse_datetime($threshold_date), DateTime::Format::ISO8601->parse_datetime($return_date)) == 1) {
+            $return_date = $threshold_date;
+        }
+
+        my $update_fields = {
+            due_date => $return_date,
+            renewal_remaining => 0,
+        };
+
+        # If the OU hasn't defined new fine rules for recalls, keep them
+        # as they were
+        if ($fine_rules) {
+            $log->info("Apply recall fine rules: $fine_rules");
+            my $rules = OpenSRF::Utils::JSON->JSON2perl($fine_rules);
+            $update_fields->{recurring_fine} = $rules->[0];
+            $update_fields->{fine_interval} = $rules->[1];
+            $update_fields->{max_fine} = $rules->[2];
+        }
+
+        # Adjust circ for current user
+        $circ->update($update_fields);
+
+        # Create trigger event for notifying current user
+        my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+        $ses->request('open-ils.trigger.event.autocreate', 'circ.recall.target', $circ->to_fieldmapper(), $circ->circ_lib->id);
+    }
+
+    $log->info("Processing of hold ".$hold->id." for recall is now complete.");
+}
+
+sub reservation_targeter {
+	my $self = shift;
+	my $client = shift;
+	my $one_reservation = shift;
+
+	local $OpenILS::Application::Storage::WRITE = 1;
+
+	my $reservations;
+
+	try {
+		if ($one_reservation) {
+			$self->method_lookup('open-ils.storage.transaction.begin')->run( $client );
+			$reservations = [ booking::reservation->search_where( { id => $one_reservation, capture_time => undef, cancel_time => undef } ) ];
+		} else {
+
+			# find all the reservations needing targeting
+			$reservations = [
+                booking::reservation->search_where(
+					{ current_resource => undef,
+					  cancel_time => undef,
+					  start_time => { '>' => 'now' }
+                    },
+                    { order_by => 'start_time' }
+                )
+            ];
+		}
+	} catch Error with {
+		my $e = shift;
+		die "Could not retrieve reservation requests:\n\n$e\n";
+	};
+
+	my @successes = ();
+	for my $bresv (@$reservations) {
+		try {
+			#start a transaction if needed
+			if ($self->method_lookup('open-ils.storage.transaction.current')->run) {
+				$log->debug("Cleaning up after previous transaction\n");
+				$self->method_lookup('open-ils.storage.transaction.rollback')->run;
+			}
+			$self->method_lookup('open-ils.storage.transaction.begin')->run( $client );
+			$log->info("Processing reservation ".$bresv->id."...\n");
+
+			#first, re-fetch the hold, to make sure it's not captured already
+			$bresv->remove_from_object_index();
+			$bresv = booking::reservation->retrieve( $bresv->id );
+
+			die "OK\n" if (!$bresv or $bresv->capture_time or $bresv->cancel_time);
+
+			my $end_time = $parser->parse_datetime( cleanse_ISO8601( $bresv->end_time ) );
+			if (DateTime->compare($end_time, DateTime->now) < 0) {
+
+				# cancel cause = un-targeted expiration
+				$bresv->update( { cancel_time => 'now' } ); 
+				$self->method_lookup('open-ils.storage.transaction.commit')->run;
+
+				# tell A/T the reservation was cancelled
+				my $fm_bresv = $bresv->to_fieldmapper;
+				my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+				$ses->request('open-ils.trigger.event.autocreate', 
+					'booking.reservation.cancel.expire_no_target', $fm_bresv, $fm_bresv->pickup_lib);
+
+				die "OK\n";
+			}
+
+			my $possible_resources;
+
+			# find all the potential resources
+			if (!$bresv->target_resource) {
+				my $filter = { type => $bresv->target_resource_type };
+				my $attr_maps = [ booking::reservation_attr_value_map->search( reservation => $bresv->id) ];
+
+				$filter->{attribute_values} = [ map { $_->attr_value } @$attr_maps ] if (@$attr_maps);
+
+				$filter->{available} = [$bresv->start_time, $bresv->end_time];
+				my $ses = OpenSRF::AppSession->create('open-ils.booking');
+				$possible_resources = $ses->request('open-ils.booking.resources.filtered_id_list', undef, $filter)->gather(1);
+			} else {
+				$possible_resources = $bresv->target_resource;
+			}
+
+            my $all_resources = [ booking::resource->search( id => $possible_resources ) ];
+			@$all_resources = grep { isTrue($_->type->transferable) || $_->owner.'' eq $bresv->pickup_lib.'' } @$all_resources;
+
+
+            my @good_resources = ();
+            my %conflicts = ();
+            for my $res (@$all_resources) {
+                unless (isTrue($res->type->catalog_item)) {
+                    push @good_resources, $res;
+                    next;
+                }
+
+                my $copy = [ asset::copy->search( deleted => 'f', barcode => $res->barcode )]->[0];
+
+                unless ($copy) {
+                    push @good_resources, $res;
+                    next;
+                }
+
+                if ($copy->status->id == 0 || $copy->status->id == 7) {
+                    push @good_resources, $res;
+                    next;
+                }
+
+                if ($copy->status->id == 1) {
+                    my $circs = [ action::circulation->search_where(
+                        {target_copy => $copy->id, checkin_time => undef },
+                        { order_by => 'id DESC' }
+                    ) ];
+
+                    if (@$circs) {
+                        my $due_date = $circs->[0]->due_date;
+			            $due_date = $parser->parse_datetime( cleanse_ISO8601( $due_date ) );
+			            my $start_time = $parser->parse_datetime( cleanse_ISO8601( $bresv->start_time ) );
+                        if (DateTime->compare($start_time, $due_date) < 0) {
+                            $conflicts{$res->id} = $circs->[0]->to_fieldmapper;
+                            next;
+                        }
+
+                        push @good_resources, $res;
+                    }
+
+                    next;
+                }
+
+                push @good_resources, $res if (isTrue($copy->status->holdable));
+            }
+
+			# let 'em know we're still working
+			$client->status( new OpenSRF::DomainObject::oilsContinueStatus );
+			
+			# if we have no copies ...
+			if (!@good_resources) {
+				$log->info("\tNo resources available for targeting at all!\n");
+				push @successes, { reservation => $bresv->id, eligible_copies => 0, error => 'NO_COPIES', conflicts => \%conflicts };
+
+
+				$self->method_lookup('open-ils.storage.transaction.commit')->run;
+				die "OK\n";
+			}
+
+			$log->debug("\t".scalar(@good_resources)." resources available for targeting...");
+
+			my $prox_list = [];
+			$$prox_list[0] =
+			[
+				grep {
+					$_->owner == $bresv->pickup_lib
+				} @good_resources
+			];
+
+			$all_resources = [grep {$_->owner != $bresv->pickup_lib } @good_resources];
+			# $all_copies is now a list of copies not at the pickup library
+
+			my $best = shift @good_resources;
+			$client->status( new OpenSRF::DomainObject::oilsContinueStatus );
+
+			if (!$best) {
+				$log->debug("\tNothing at the pickup lib, looking elsewhere among ".scalar(@$all_resources)." resources");
+
+				$prox_list =
+                    map  { $_->[1] }
+                    sort { $a->[0] <=> $b->[0] }
+                    map  {
+                        [   actor::org_unit_proximity->search_where(
+                                { from_org => $bresv->pickup_lib.'', to_org => $_->owner.'' }
+                            )->[0]->prox,
+                            $_
+                        ]
+                    } @$all_resources;
+
+				$client->status( new OpenSRF::DomainObject::oilsContinueStatus );
+
+				$best = shift @$prox_list
+			}
+
+			if ($best) {
+				$bresv->update( { current_resource => ''.$best->id } );
+				$log->debug("\tUpdating reservation [".$bresv->id."] with new 'current_resource' [".$best->id."] for reservation fulfillment.");
+			}
+
+			$self->method_lookup('open-ils.storage.transaction.commit')->run;
+			$log->info("\tProcessing of bresv ".$bresv->id." complete.");
+
+			push @successes,
+				{ reservation => $bresv->id,
+				  current_resource => ($best ? $best->id : undef) };
+
+		} otherwise {
+			my $e = shift;
+			if ($e !~ /^OK/o) {
+				$log->error("Processing of bresv failed:  $e");
+				$self->method_lookup('open-ils.storage.transaction.rollback')->run;
+				throw $e if ($e =~ /IS NOT CONNECTED TO THE NETWORK/o);
+			}
+		};
+	}
+
+	return \@successes;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.booking.reservation.resource_targeter',
+	api_level	=> 1,
+	method		=> 'reservation_targeter',
+);
+
+my $locations;
+my $statuses;
+my %cache = (titles => {}, cns => {});
+
+sub copy_hold_capture {
+	my $self = shift;
+	my $hold = shift;
+	my $cps = shift;
+
+	if (!defined($cps)) {
+		try {
+			$cps = [ asset::copy->search( id => $hold->target ) ];
+		} catch Error with {
+			my $e = shift;
+			die "Could not retrieve initial volume list:\n\n$e\n";
+		};
+	}
+
+	my @copies = grep { $_->holdable } @$cps;
+
+	for (my $i = 0; $i < @$cps; $i++) {
+		next unless $$cps[$i];
+		
+		my $cn = $cache{cns}{$copies[$i]->call_number};
+		my $rec = $cache{titles}{$cn->record};
+		$copies[$i] = undef if ($copies[$i] && !grep{ $copies[$i]->status eq $_->id}@$statuses);
+		$copies[$i] = undef if ($copies[$i] && !grep{ $copies[$i]->location eq $_->id}@$locations);
+		$copies[$i] = undef if (
+			!$copies[$i] ||
+			!$self->{user_filter}->request(
+				'open-ils.circ.permit_hold',
+				$hold->to_fieldmapper, do {
+					my $cp_fm = $copies[$i]->to_fieldmapper;
+					$cp_fm->circ_lib( $copies[$i]->circ_lib->to_fieldmapper );
+					$cp_fm->location( $copies[$i]->location->to_fieldmapper );
+					$cp_fm->status( $copies[$i]->status->to_fieldmapper );
+					$cp_fm;
+				},
+				{ title => $rec->to_fieldmapper,
+				  usr => actor::user->retrieve($hold->usr)->to_fieldmapper,
+				  requestor => actor::user->retrieve($hold->requestor)->to_fieldmapper,
+				})->gather(1)
+		);
+		$self->{client}->status( new OpenSRF::DomainObject::oilsContinueStatus );
+	}
+
+	@copies = grep { $_ } @copies;
+
+	my $count = @copies;
+
+	return unless ($count);
+	
+	action::hold_copy_map->search( hold => $hold->id )->delete_all;
+	
+	my @maps;
+	$self->{client}->respond( "\tMapping ".scalar(@copies)." eligable copies for hold ".$hold->id."\n");
+	for my $c (@copies) {
+		push @maps, action::hold_copy_map->create( { hold => $hold->id, target_copy => $c->id } );
+	}
+	$self->{client}->respond( "\tA total of ".scalar(@maps)." mapping were created for hold ".$hold->id."\n");
+
+	return \@copies;
+}
+
+
+sub choose_nearest_copy {
+	my $hold = shift;
+	my $prox_list = shift;
+
+	for my $p ( 0 .. int( scalar(@$prox_list) - 1) ) {
+		next unless (ref $$prox_list[$p]);
+
+		my @capturable = @{ $$prox_list[$p] };
+		next unless (@capturable);
+
+		my $rand = int(rand(scalar(@capturable)));
+		my %seen = ();
+		while (my ($c) = splice(@capturable, $rand, 1)) {
+			return $c if !exists($seen{$c->id}) && ( OpenILS::Utils::PermitHold::permit_copy_hold(
+				{ title => $c->call_number->record->to_fieldmapper,
+				  title_descriptor => $c->call_number->record->record_descriptor->next->to_fieldmapper,
+				  patron => $hold->usr->to_fieldmapper,
+				  copy => $c->to_fieldmapper,
+				  requestor => $hold->requestor->to_fieldmapper,
+				  request_lib => $hold->request_lib->to_fieldmapper,
+				  pickup_lib => $hold->pickup_lib->id,
+				  retarget => 1
+				}
+			));
+			$seen{$c->id}++;
+
+			last unless(@capturable);
+			$rand = int(rand(scalar(@capturable)));
+		}
+	}
+}
+
+sub create_prox_list {
+	my $self = shift;
+	my $lib = shift;
+	my $copies = shift;
+
+	my $actor = OpenSRF::AppSession->create('open-ils.actor');
+
+	my @prox_list;
+	for my $cp (@$copies) {
+		my ($prox) = $self->method_lookup('open-ils.storage.asset.copy.proximity')->run( $cp, $lib );
+		next unless (defined($prox));
+
+        my $copy_circ_lib = ''.$cp->circ_lib;
+		# Fetch the weighting value for hold targeting, defaulting to 1
+		$self->{target_weight}{$copy_circ_lib} ||= $actor->request(
+			'open-ils.actor.ou_setting.ancestor_default' => $copy_circ_lib.'' => 'circ.holds.org_unit_target_weight'
+		)->gather(1);
+        $self->{target_weight}{$copy_circ_lib} = $self->{target_weight}{$copy_circ_lib}{value} if (ref $self->{target_weight}{$copy_circ_lib});
+        $self->{target_weight}{$copy_circ_lib} ||= 1;
+
+		$prox_list[$prox] = [] unless defined($prox_list[$prox]);
+		for my $w ( 1 .. $self->{target_weight}{$copy_circ_lib} ) {
+			push @{$prox_list[$prox]}, $cp;
+		}
+	}
+	return \@prox_list;
+}
+
+sub volume_hold_capture {
+	my $self = shift;
+	my $hold = shift;
+	my $vols = shift;
+
+	if (!defined($vols)) {
+		try {
+			$vols = [ asset::call_number->search( id => $hold->target ) ];
+			$cache{cns}{$_->id} = $_ for (@$vols);
+		} catch Error with {
+			my $e = shift;
+			die "Could not retrieve initial volume list:\n\n$e\n";
+		};
+	}
+
+	my @v_ids = map { $_->id } @$vols;
+
+	my $cp_list;
+	try {
+		$cp_list = [ asset::copy->search( call_number => \@v_ids ) ];
+	
+	} catch Error with {
+		my $e = shift;
+		warn "Could not retrieve copy list:\n\n$e\n";
+	};
+
+	$self->copy_hold_capture($hold,$cp_list) if (ref $cp_list and @$cp_list);
+}
+
+sub title_hold_capture {
+	my $self = shift;
+	my $hold = shift;
+	my $titles = shift;
+
+	if (!defined($titles)) {
+		try {
+			$titles = [ biblio::record_entry->search( id => $hold->target ) ];
+			$cache{titles}{$_->id} = $_ for (@$titles);
+		} catch Error with {
+			my $e = shift;
+			die "Could not retrieve initial title list:\n\n$e\n";
+		};
+	}
+
+	my @t_ids = map { $_->id } @$titles;
+	my $cn_list;
+	try {
+		($cn_list) = $self->method_lookup('open-ils.storage.direct.asset.call_number.search.record.atomic')->run( \@t_ids );
+	
+	} catch Error with {
+		my $e = shift;
+		warn "Could not retrieve volume list:\n\n$e\n";
+	};
+
+	$cache{cns}{$_->id} = $_ for (@$cn_list);
+
+	$self->volume_hold_capture($hold,$cn_list) if (ref $cn_list and @$cn_list);
+}
+
+sub metarecord_hold_capture {
+	my $self = shift;
+	my $hold = shift;
+
+	my $titles;
+	try {
+		$titles = [ metabib::metarecord_source_map->search( metarecord => $hold->target) ];
+	
+	} catch Error with {
+		my $e = shift;
+		die "Could not retrieve initial title list:\n\n$e\n";
+	};
+
+	try {
+		my @recs = map {$_->record} metabib::record_descriptor->search( record => $titles, item_type => [split '', $hold->holdable_formats] ); 
+
+		$titles = [ biblio::record_entry->search( id => \@recs ) ];
+	
+	} catch Error with {
+		my $e = shift;
+		die "Could not retrieve format-pruned title list:\n\n$e\n";
+	};
+
+
+	$cache{titles}{$_->id} = $_ for (@$titles);
+	$self->title_hold_capture($hold,$titles) if (ref $titles and @$titles);
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/actor.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/actor.pm
new file mode 100644
index 0000000000..22362cf53c
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/actor.pm
@@ -0,0 +1,1031 @@
+package OpenILS::Application::Storage::Publisher::actor;
+use base qw/OpenILS::Application::Storage/;
+use OpenILS::Application::Storage::CDBI::actor;
+use OpenSRF::Utils::Logger qw/:level/;
+use OpenSRF::Utils qw/:datetime/;
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::SettingsClient;
+
+use DateTime;           
+use DateTime::Format::ISO8601;  
+use DateTime::Set;
+use DateTime::SpanSet;
+                                                
+						                                                
+my $_dt_parser = DateTime::Format::ISO8601->new;    
+
+my $log = 'OpenSRF::Utils::Logger';
+
+sub new_usergroup_id {
+	return actor::user->db_Main->selectrow_array("select nextval('actor.usr_usrgroup_seq'::regclass)");
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.user.group_id.new',
+	api_level	=> 1,
+	method		=> 'new_usergroup_id',
+);
+
+sub juv_to_adult {
+	my $self = shift;
+	my $client = shift;
+	my $adult_age = shift;
+
+	my $sql = <<"	SQL";
+            UPDATE  actor.usr
+              SET   juvenile = FALSE
+              WHERE AGE(dob) > ?::INTERVAL;
+	SQL
+
+    my $sth = actor::user->db_Main->prepare_cached($sql);
+    $sth->execute($adult_age);
+
+    return $sth->rows;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.user.juvenile_to_adult',
+	api_level	=> 1,
+	method		=> 'juv_to_adult',
+);
+
+sub usr_total_owed {
+	my $self = shift;
+	my $client = shift;
+	my $usr = shift;
+
+	my $sql = <<"	SQL";
+			SELECT	x.usr,
+					SUM(COALESCE((SELECT SUM(b.amount) FROM money.billing b WHERE b.voided IS FALSE AND b.xact = x.id),0.0)) -
+						SUM(COALESCE((SELECT SUM(p.amount) FROM money.payment p WHERE p.voided IS FALSE AND p.xact = x.id),0.0))
+			  FROM	money.billable_xact x
+			  WHERE	x.usr = ? AND x.xact_finish IS NULL
+			  GROUP BY 1
+	SQL
+
+	my (undef,$val) = actor::user->db_Main->selectrow_array($sql, {}, $usr);
+
+	return $val;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.user.total_owed',
+	api_level	=> 1,
+	method		=> 'usr_total_owed',
+);
+
+sub usr_breakdown_out {
+	my $self = shift;
+	my $client = shift;
+	my $usr = shift;
+
+	$self->method_lookup('open-ils.storage.transaction.begin')->run($client);
+
+	my $out_sql = <<"	SQL";
+			SELECT	id
+			  FROM	action.circulation
+			  WHERE	usr = ?
+                    AND checkin_time IS NULL
+                    AND (  (fine_interval >= '1 day' AND due_date >= 'today')
+                        OR (fine_interval < '1 day'  AND due_date > 'now'   ))
+                    AND (stop_fines IS NULL
+                        OR stop_fines NOT IN ('LOST','CLAIMSRETURNED','LONGOVERDUE'))
+	SQL
+
+	my $out = actor::user->db_Main->selectcol_arrayref($out_sql, {}, $usr);
+
+	my $od_sql = <<"	SQL";
+			SELECT	id
+			  FROM	action.circulation
+			  WHERE	usr = ?
+                    AND checkin_time IS NULL
+                    AND (  (fine_interval >= '1 day' AND due_date < 'today')
+                        OR (fine_interval < '1 day'  AND due_date < 'now'  ))
+                    AND (stop_fines IS NULL
+                        OR stop_fines NOT IN ('LOST','CLAIMSRETURNED','LONGOVERDUE'))
+	SQL
+
+	my $od = actor::user->db_Main->selectcol_arrayref($od_sql, {}, $usr);
+
+	my $lost_sql = <<"	SQL";
+			SELECT	id
+			  FROM	action.circulation
+			  WHERE	usr = ? AND checkin_time IS NULL AND xact_finish IS NULL AND stop_fines = 'LOST'
+	SQL
+
+	my $lost = actor::user->db_Main->selectcol_arrayref($lost_sql, {}, $usr);
+
+	my $cl_sql = <<"	SQL";
+			SELECT	id
+			  FROM	action.circulation
+			  WHERE	usr = ? AND checkin_time IS NULL AND stop_fines = 'CLAIMSRETURNED'
+	SQL
+
+	my $cl = actor::user->db_Main->selectcol_arrayref($cl_sql, {}, $usr);
+
+	my $lo_sql = <<"	SQL";
+			SELECT	id
+			  FROM	action.circulation
+			  WHERE	usr = ? AND checkin_time IS NULL AND stop_fines = 'LONGOVERDUE'
+	SQL
+
+	my $lo = actor::user->db_Main->selectcol_arrayref($lo_sql, {}, $usr);
+
+	$self->method_lookup('open-ils.storage.transaction.rollback')->run($client);
+
+	if ($self->api_name =~/count$/o) {
+		return {	total	=> scalar(@$out) + scalar(@$od) + scalar(@$lost) + scalar(@$cl) + scalar(@$lo),
+					out		=> scalar(@$out),
+					overdue	=> scalar(@$od),
+					lost	=> scalar(@$lost),
+					claims_returned	=> scalar(@$cl),
+					long_overdue		=> scalar(@$lo),
+		};
+	}
+
+	return {	out		=> $out,
+				overdue	=> $od,
+				lost	=> $lost,
+				claims_returned	=> $cl,
+				long_overdue		=> $lo,
+	};
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.user.checked_out',
+	api_level	=> 1,
+	method		=> 'usr_breakdown_out',
+);
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.user.checked_out.count',
+	api_level	=> 1,
+	method		=> 'usr_breakdown_out',
+);
+
+sub usr_total_out {
+	my $self = shift;
+	my $client = shift;
+	my $usr = shift;
+
+	my $sql = <<"	SQL";
+			SELECT	count(*)
+			  FROM	action.circulation
+			  WHERE	usr = ? AND checkin_time IS NULL
+	SQL
+
+	my ($val) = actor::user->db_Main->selectrow_array($sql, {}, $usr);
+
+	return $val;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.user.total_out',
+	api_level	=> 1,
+	method		=> 'usr_total_out',
+);
+
+sub calc_proximity {
+	my $self = shift;
+	my $client = shift;
+
+	local $OpenILS::Application::Storage::WRITE = 1;
+
+	my $delete_sql = <<"	SQL";
+		DELETE FROM actor.org_unit_proximity;
+	SQL
+
+	my $insert_sql = <<"	SQL";
+		INSERT INTO actor.org_unit_proximity (from_org, to_org, prox)
+			SELECT	l.id,
+				r.id,
+				actor.org_unit_proximity(l.id,r.id)
+			  FROM	actor.org_unit l,
+				actor.org_unit r;
+	SQL
+
+	actor::org_unit_proximity->db_Main->do($delete_sql);
+	actor::org_unit_proximity->db_Main->do($insert_sql);
+
+	return 1;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.org_unit.refresh_proximity',
+	api_level	=> 1,
+	method		=> 'calc_proximity',
+);
+
+sub make_hoo_spanset {
+    my $hoo = shift;
+    return undef unless $hoo;
+
+    my $today = shift || DateTime->now;
+
+    my $tz = OpenSRF::AppSession->create('open-ils.actor')->request(
+        'open-ils.actor.ou_setting.ancestor_default' => $hoo->id.'' => 'org_unit.timezone'
+    )->gather(1) || DateTime::TimeZone->new( name => 'local' )->name;
+
+    my $current_dow = $today->day_of_week_0;
+
+    my $spanset = DateTime::SpanSet->empty_set;
+    for my $d ( 0 .. 6 ) {
+
+        my $omethod = 'dow_'.$d.'_open';
+        my $cmethod = 'dow_'.$d.'_close';
+
+        my $open = interval_to_seconds($hoo->$omethod());
+        my $close = interval_to_seconds($hoo->$cmethod());
+
+        next if ($open == $close && $open == 0);
+
+        my $dow_offset = ($d - $current_dow) * $one_day;
+        $close += $one_day if ($close <= $open);
+
+        $spanset = $spanset->union(
+            DateTime::Span->new(
+                start => $today->clone->add( seconds => $dow_offset + $open  ),
+                end   => $today->clone->add( seconds => $dow_offset + $close )
+            )
+        );
+    }
+
+    return $spanset->complement;
+}
+
+sub make_closure_spanset {
+    my $closures = shift;
+    return undef unless $closures;
+
+    my $spanset = DateTime::SpanSet->empty_set;
+    for my $k ( keys %$closures ) {
+        my $c = $$closures{$k};
+
+        $spanset = $spanset->union(
+            DateTime::Span->new(
+                start => $_dt_parser->parse_datetime(cleanse_ISO8601($c->{close_start})),
+                end   => $_dt_parser->parse_datetime(cleanse_ISO8601($c->{close_end}))
+            )
+        );
+    }
+
+    return $spanset;
+}
+
+sub new_org_closed_overlap {
+	my $self = shift;
+	my $client = shift;
+	my $ou = shift;
+	my $date = shift;
+	my $direction = shift || 0;
+	my $no_hoo = shift || 0;
+
+	return undef unless ($date && $ou);
+
+    # we're given a date and a direction, find any closures that contain the date
+	my $t = actor::org_unit::closed_date->table;
+	my $sql = <<"	SQL";
+		SELECT	*
+		  FROM	$t
+		  WHERE	close_end > ?
+			AND org_unit = ?
+		  ORDER BY close_start ASC, close_end DESC
+		  LIMIT 1
+	SQL
+
+	$date = cleanse_ISO8601($date);
+
+    my $target_date = $_dt_parser->parse_datetime( $date );
+	my ($begin, $end) = ($target_date, $target_date);
+
+    # create a spanset from the closures that contain the $date
+	my $closure_spanset = make_closure_spanset(
+        actor::org_unit::closed_date->db_Main->selectall_hashref( $sql, 'id', {}, $date, $ou )
+    );
+
+    if ($closure_spanset && $closure_spanset->intersects( $target_date )) {
+        my $closure_intersection = $closure_spanset->intersection( $target_date );
+        $begin = $closure_intersection->min;
+        $end = $closure_intersection->max;
+
+		if ( $direction <= 0 ) {
+			$begin->subtract( minutes => 1 );
+
+			while ( my $_b = new_org_closed_overlap($self, $client, $ou, $begin->strftime('%FT%T%z'), -1, 1 ) ) {
+				$begin = $_dt_parser->parse_datetime( cleanse_ISO8601($_b->{start}) );
+			}
+		}
+
+		if ( $direction >= 0 ) {
+			$end->add( minutes => 1 );
+
+			while ( my $_a = new_org_closed_overlap($self, $client, $ou, $end->strftime('%FT%T%z'), 1, 1 ) ) {
+				$end = $_dt_parser->parse_datetime( cleanse_ISO8601($_a->{end}) );
+			}
+		}
+    }
+
+	if ( !$no_hoo ) {
+
+	    my $begin_hoo = make_hoo_spanset(actor::org_unit::hours_of_operation->retrieve($ou), $begin);
+	    my $end_hoo   = make_hoo_spanset(actor::org_unit::hours_of_operation->retrieve($ou), $end  );
+
+
+        if ( $begin_hoo && $direction <= 0 && $begin_hoo->intersects($begin) ) {
+            my $hoo_intersection = $begin_hoo->intersection( $begin );
+            $begin = $hoo_intersection->min;
+            $begin->subtract( minutes => 1 );
+
+            while ( my $_b = new_org_closed_overlap($self, $client, $ou, $begin->strftime('%FT%T%z'), -1 ) ) {
+                $begin = $_dt_parser->parse_datetime( cleanse_ISO8601($_b->{start}) );
+            }
+        }
+	
+        if ( $end_hoo && $direction >= 0 && $end_hoo->intersects($end) ) {
+            my $hoo_intersection = $end_hoo->intersection( $end );
+            $end = $hoo_intersection->max;
+			$end->add( minutes => 1 );
+
+
+            while ( my $_b = new_org_closed_overlap($self, $client, $ou, $end->strftime('%FT%T%z'), -1 ) ) {
+                $end = $_dt_parser->parse_datetime( cleanse_ISO8601($_b->{end}) );
+            }
+        }
+    }
+
+    my $start = $begin->strftime('%FT%T%z');
+    my $stop = $end->strftime('%FT%T%z');
+
+    return undef if ($start eq $stop);
+    return { start => $start, end => $stop };
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.org_unit.closed_date.overlap',
+	api_level	=> 0,
+	method		=> 'new_org_closed_overlap',
+);
+
+sub org_closed_overlap {
+    my $self = shift;
+    my $client = shift;
+    my $ou = shift;
+    my $date = shift;
+    my $direction = shift || 0;
+    my $no_hoo = shift || 0;
+
+    return undef unless ($date && $ou);
+
+    my $t = actor::org_unit::closed_date->table;
+    my $sql = <<"    SQL";
+        SELECT  *
+          FROM  $t
+          WHERE ? between close_start and close_end
+            AND org_unit = ?
+          ORDER BY close_start ASC, close_end DESC
+          LIMIT 1
+    SQL
+
+    $date = cleanse_ISO8601($date);
+    my ($begin, $end) = ($date,$date);
+
+    my $hoo = actor::org_unit::hours_of_operation->retrieve($ou);
+
+    if (my $closure = actor::org_unit::closed_date->db_Main->selectrow_hashref( $sql, {}, $date, $ou )) {
+        $begin = cleanse_ISO8601($closure->{close_start});
+        $end = cleanse_ISO8601($closure->{close_end});
+
+        if ( $direction <= 0 ) {
+            $before = $_dt_parser->parse_datetime( $begin );
+            $before->subtract( minutes => 1 );
+
+            while ( my $_b = org_closed_overlap($self, $client, $ou, $before->strftime('%FT%T%z'), -1, 1 ) ) {
+                $before = $_dt_parser->parse_datetime( cleanse_ISO8601($_b->{start}) );
+            }
+            $begin = cleanse_ISO8601($before->strftime('%FT%T%z'));
+        }
+
+        if ( $direction >= 0 ) {
+            $after = $_dt_parser->parse_datetime( $end );
+            $after->add( minutes => 1 );
+
+            while ( my $_a = org_closed_overlap($self, $client, $ou, $after->strftime('%FT%T%z'), 1, 1 ) ) {
+                $after = $_dt_parser->parse_datetime( cleanse_ISO8601($_a->{end}) );
+            }
+            $end = cleanse_ISO8601($after->strftime('%FT%T%z'));
+        }
+    }
+
+    if ( !$no_hoo ) {
+        if ( $hoo ) {
+
+            if ( $direction <= 0 ) {
+                my $begin_dow = $_dt_parser->parse_datetime( $begin )->day_of_week_0;
+                my $begin_open_meth = "dow_".$begin_dow."_open";
+                my $begin_close_meth = "dow_".$begin_dow."_close";
+
+                my $count = 1;
+                while ($hoo->$begin_open_meth eq '00:00:00' and $hoo->$begin_close_meth eq '00:00:00') {
+                    $begin = cleanse_ISO8601($_dt_parser->parse_datetime( $begin )->subtract( days => 1)->strftime('%FT%T%z'));
+                    $begin_dow++;
+                    $begin_dow %= 7;
+                    $count++;
+                    last if ($count > 6);
+                    $begin_open_meth = "dow_".$begin_dow."_open";
+                    $begin_close_meth = "dow_".$begin_dow."_close";
+                }
+
+                if (my $closure = actor::org_unit::closed_date->db_Main->selectrow_hashref( $sql, {}, $begin, $ou )) {
+                    $before = $_dt_parser->parse_datetime( $begin );
+                    $before->subtract( minutes => 1 );
+                    while ( my $_b = org_closed_overlap($self, $client, $ou, $before->strftime('%FT%T%z'), -1 ) ) {
+                        $before = $_dt_parser->parse_datetime( cleanse_ISO8601($_b->{start}) );
+                    }
+                }
+            }
+    
+            if ( $direction >= 0 ) {
+                my $end_dow = $_dt_parser->parse_datetime( $end )->day_of_week_0;
+                my $end_open_meth = "dow_".$end_dow."_open";
+                my $end_close_meth = "dow_".$end_dow."_close";
+    
+                $count = 1;
+                while ($hoo->$end_open_meth eq '00:00:00' and $hoo->$end_close_meth eq '00:00:00') {
+                    $end = cleanse_ISO8601($_dt_parser->parse_datetime( $end )->add( days => 1)->strftime('%FT%T%z'));
+                    $end_dow++;
+                    $end_dow %= 7;
+                    $count++;
+                    last if ($count > 6);
+                    $end_open_meth = "dow_".$end_dow."_open";
+                    $end_close_meth = "dow_".$end_dow."_close";
+                }
+
+                if (my $closure = actor::org_unit::closed_date->db_Main->selectrow_hashref( $sql, {}, $end, $ou )) {
+                    $after = $_dt_parser->parse_datetime( $end );
+                    $after->add( minutes => 1 );
+
+                    while ( my $_a = org_closed_overlap($self, $client, $ou, $after->strftime('%FT%T%z'), 1 ) ) {
+                        $after = $_dt_parser->parse_datetime( cleanse_ISO8601($_a->{end}) );
+                    }
+                    $end = cleanse_ISO8601($after->strftime('%FT%T%z'));
+                }
+            }
+
+        }
+    }
+
+    if ($begin eq $date && $end eq $date) {
+        return undef;
+    }
+
+    return { start => $begin, end => $end };
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.org_unit.closed_date.overlap',
+	api_level	=> 1,
+	method		=> 'org_closed_overlap',
+);
+
+sub user_by_barcode {
+	my $self = shift;
+	my $client = shift;
+	my @barcodes = shift;
+
+	return undef unless @barcodes;
+
+	for my $card ( actor::card->search( { barcode => @barcodes } ) ) {
+		next unless $card;
+		if (@barcodes == 1) {
+			return $card->usr->to_fieldmapper;
+		}
+		$client->respond( $card->usr->to_fieldmapper);
+	}
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.direct.actor.user.search.barcode',
+	api_level	=> 1,
+	method		=> 'user_by_barcode',
+	stream		=> 1,
+	cachable	=> 1,
+);
+
+sub lost_barcodes {
+	my $self = shift;
+	my $client = shift;
+
+	my $c = actor::card->table;
+	my $p = actor::user->table;
+
+	my $sql = "SELECT c.barcode FROM $c c JOIN $p p ON (c.usr = p.id) WHERE p.card <> c.id";
+
+	my $list = actor::user->db_Main->selectcol_arrayref($sql);
+	for my $bc ( @$list ) {
+		$client->respond($bc);
+	}
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.user.lost_barcodes',
+	api_level	=> 1,
+	stream		=> 1,
+	method		=> 'lost_barcodes',
+	signature	=> <<'	NOTE',
+		Returns an array of barcodes that belong to lost cards.
+		@return array of barcodes
+	NOTE
+);
+
+sub expired_barcodes {
+	my $self = shift;
+	my $client = shift;
+
+	my $c = actor::card->table;
+	my $p = actor::user->table;
+
+	my $sql = "SELECT c.barcode FROM $c c JOIN $p p ON (c.usr = p.id) WHERE p.expire_date < CURRENT_DATE";
+
+	my $list = actor::user->db_Main->selectcol_arrayref($sql);
+	for my $bc ( @$list ) {
+		$client->respond($bc);
+	}
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.user.expired_barcodes',
+	api_level	=> 1,
+	stream		=> 1,
+	method		=> 'expired_barcodes',
+	signature	=> <<'	NOTE',
+		Returns an array of barcodes that are currently expired.
+		@return array of barcodes
+	NOTE
+);
+
+sub barred_barcodes {
+	my $self = shift;
+	my $client = shift;
+
+	my $c = actor::card->table;
+	my $p = actor::user->table;
+
+	my $sql = "SELECT c.barcode FROM $c c JOIN $p p ON (c.usr = p.id) WHERE p.barred IS TRUE";
+
+	my $list = actor::user->db_Main->selectcol_arrayref($sql);
+	for my $bc ( @$list ) {
+		$client->respond($bc);
+	}
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.user.barred_barcodes',
+	api_level	=> 1,
+	stream		=> 1,
+	method		=> 'barred_barcodes',
+	signature	=> <<'	NOTE',
+		Returns an array of barcodes that are currently barred.
+		@return array of barcodes
+	NOTE
+);
+
+sub penalized_barcodes {
+	my $self = shift;
+	my $client = shift;
+
+	my $c = actor::card->table;
+	my $p = actor::user_standing_penalty->table;
+
+	my $sql = <<"	SQL";
+		SELECT	DISTINCT c.barcode
+		  FROM	$c c
+			JOIN $p p USING (usr)
+			JOIN config.standing_penalty csp ON (csp.id = p.standing_penalty)
+		  WHERE	csp.block_list IS NOT NULL
+			AND p.set_date < CURRENT_DATE
+			AND (p.stop_date IS NULL OR p.stop_date > CURRENT_DATE);
+	SQL
+
+	my $list = actor::user->db_Main->selectcol_arrayref($sql);
+	for my $bc ( @$list ) {
+		$client->respond($bc);
+	}
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.user.penalized_barcodes',
+	api_level	=> 1,
+	stream		=> 1,
+	method		=> 'penalized_barcodes',
+	signature	=> <<'	NOTE',
+		Returns an array of barcodes that have blocking penalties.
+		@return array of barcodes
+	NOTE
+);
+
+
+sub patron_search {
+	my $self = shift;
+	my $client = shift;
+	my $search = shift;
+	my $limit = shift || 1000;
+	my $sort = shift;
+	my $inactive = shift;
+	my $ws_ou = shift;
+	my $ws_ou_depth = shift || 0;
+
+    my $penalty_sort = 0;
+
+	my $strict_opt_in = OpenSRF::Utils::SettingsClient->new->config_value( share => user => 'opt_in' );
+
+	$sort = ['family_name','first_given_name'] unless ($$sort[0]);
+	push @$sort,'id';
+
+    if ($$sort[0] eq 'penalties') {
+        shift @$sort;
+        $penalty_sort = 1;
+    }
+
+	# group 0 = user
+	# group 1 = address
+	# group 2 = phone, ident
+	# group 3 = barcode
+
+	my $usr = join ' AND ', map { "LOWER(CAST($_ AS text)) ~ ?" } grep { ''.$$search{$_}{group} eq '0' } keys %$search;
+	my @usrv = map { "^$$search{$_}{value}" } grep { ''.$$search{$_}{group} eq '0' } keys %$search;
+
+	my $addr = join ' AND ', map { "LOWER(CAST($_ AS text)) ~ ?" } grep { ''.$$search{$_}{group} eq '1' } keys %$search;
+	my @addrv = map { "^$$search{$_}{value}" } grep { ''.$$search{$_}{group} eq '1' } keys %$search;
+
+	my $pv = $$search{phone}{value};
+	my $iv = $$search{ident}{value};
+	my $nv = $$search{name}{value};
+	my $cv = $$search{card}{value};
+
+	my $card = '';
+	if ($cv) {
+	    $card = 'JOIN (SELECT DISTINCT usr FROM actor.card WHERE LOWER(barcode) LIKE ?||\'%\') AS card ON (card.usr = users.id)';
+	    unshift(@usrv, $cv);
+	}
+
+	my $phone = '';
+	my @ps;
+	my @phonev;
+	if ($pv) {
+		for my $p ( qw/day_phone evening_phone other_phone/ ) {
+			push @ps, "LOWER($p) ~ ?";
+			push @phonev, "^$pv";
+		}
+		$phone = '(' . join(' OR ', @ps) . ')';
+	}
+
+	my $ident = '';
+	my @is;
+	my @identv;
+	if ($iv) {
+		for my $i ( qw/ident_value ident_value2/ ) {
+			push @is, "LOWER($i) ~ ?";
+			push @identv, "^$iv";
+		}
+		$ident = '(' . join(' OR ', @is) . ')';
+	}
+
+	my $name = '';
+	my @ns;
+	my @namev;
+	if (0 && $nv) {
+		for my $n ( qw/first_given_name second_given_name family_name/ ) {
+			push @ns, "LOWER($n) ~ ?";
+			push @namev, "^$nv";
+		}
+		$name = '(' . join(' OR ', @ns) . ')';
+	}
+
+	my $usr_where = join ' AND ', grep { $_ } ($usr,$phone,$ident,$name);
+	my $addr_where = $addr;
+
+
+	my $u_table = actor::user->table;
+	my $a_table = actor::user_address->table;
+	my $opt_in_table = actor::usr_org_unit_opt_in->table;
+	my $ou_table = actor::org_unit->table;
+
+	my $u_select = "SELECT id as id FROM $u_table u WHERE $usr_where";
+	my $a_select = "SELECT u.id as id FROM $a_table a JOIN $u_table u ON (u.mailing_address = a.id OR u.billing_address = a.id) WHERE $addr_where";
+
+	my $clone_select = '';
+
+	#$clone_select = "JOIN (SELECT cu.id as id FROM $a_table ca ".
+	#		   "JOIN $u_table cu ON (cu.mailing_address = ca.id OR cu.billing_address = ca.id) ".
+	#		   "WHERE $addr_where) AS clone ON (clone.id = users.id)" if ($addr_where);
+
+	my $select = '';
+	if ($usr_where) {
+		if ($addr_where) {
+			$select = "$u_select INTERSECT $a_select";
+		} else {
+			$select = $u_select;
+		}
+	} elsif ($addr_where) {
+		$select = "$a_select";
+	}
+
+	return undef if (!$select && !$card);
+
+	my $order_by = join ', ', map { 'LOWER(CAST(users.'. (split / /,$_)[0] . ' AS text)) ' . (split / /,$_)[1] } @$sort;
+	my $distinct_list = join ', ', map { 'LOWER(CAST(users.'. (split / /,$_)[0] . ' AS text))' } @$sort;
+    my $group_list = $distinct_list;
+
+	if ($inactive) {
+		$inactive = '';
+	} else {
+		$inactive = 'AND users.active = TRUE';
+	}
+
+	if (!$ws_ou) {  # XXX This should be required!!
+		$ws_ou = actor::org_unit->search( { parent_ou => undef } )->next->id;
+	}
+
+	my $opt_in_join = '';
+	my $opt_in_where = '';
+	if (lc($strict_opt_in) eq 'true') {
+		$opt_in_join = "LEFT JOIN $opt_in_table oi ON (oi.org_unit = $ws_ou AND users.id = oi.usr)";
+		$opt_in_where = "AND (oi.id IS NOT NULL OR users.home_ou = $ws_ou)";
+	}
+
+	my $penalty_join = '';
+    if ($penalty_sort) {
+        $distinct_list = 'COUNT(penalties.id), ' . $distinct_list;
+        $order_by = 'COUNT(penalties.id) DESC, ' . $order_by;
+        unshift @$sort, 'COUNT(penalties.id)';
+	    $penalty_join = <<"        SQL";
+            LEFT JOIN actor.usr_standing_penalty penalties
+                ON (users.id = penalties.usr AND (penalties.stop_date IS NULL OR penalties.stop_date > NOW()))
+        SQL
+    }
+
+	my $descendants = "actor.org_unit_descendants($ws_ou, $ws_ou_depth)";
+
+	$select = "JOIN ($select) AS search ON (search.id = users.id)" if ($select);
+	$select = <<"	SQL";
+		SELECT	$distinct_list
+		  FROM	$u_table AS users $card
+			JOIN $descendants d ON (d.id = users.home_ou)
+			$select
+			$opt_in_join
+			$clone_select
+            $penalty_join
+		  WHERE	users.deleted = FALSE
+			$inactive
+			$opt_in_where
+		  GROUP BY $group_list
+		  ORDER BY $order_by
+		  LIMIT $limit
+	SQL
+
+	return actor::user->db_Main->selectcol_arrayref($select, {Columns=>[scalar(@$sort)]}, map {lc($_)} (@usrv,@phonev,@identv,@namev,@addrv));
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.user.crazy_search',
+	api_level	=> 1,
+	method		=> 'patron_search',
+);
+
+sub org_unit_list {
+	my $self = shift;
+	my $client = shift;
+
+	my $select =<<"	SQL";
+	SELECT	*
+	  FROM	actor.org_unit
+	  ORDER BY CASE WHEN parent_ou IS NULL THEN 0 ELSE 1 END, name;
+	SQL
+
+	my $sth = actor::org_unit->db_Main->prepare_cached($select);
+	$sth->execute;
+
+	$client->respond( $_->to_fieldmapper ) for ( map { actor::org_unit->construct($_) } $sth->fetchall_hash );
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.direct.actor.org_unit.retrieve.all',
+	api_level	=> 1,
+	stream		=> 1,
+	method		=> 'org_unit_list',
+);
+
+sub org_unit_type_list {
+	my $self = shift;
+	my $client = shift;
+
+	my $select =<<"	SQL";
+	SELECT	*
+	  FROM	actor.org_unit_type
+	  ORDER BY depth, name;
+	SQL
+
+	my $sth = actor::org_unit_type->db_Main->prepare_cached($select);
+	$sth->execute;
+
+	$client->respond( $_->to_fieldmapper ) for ( map { actor::org_unit_type->construct($_) } $sth->fetchall_hash );
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.direct.actor.org_unit_type.retrieve.all',
+	api_level	=> 1,
+	stream		=> 1,
+	method		=> 'org_unit_type_list',
+);
+
+sub org_unit_full_path {
+	my $self = shift;
+	my $client = shift;
+	my @binds = @_;
+
+	return undef unless (@binds);
+
+	my $func = 'actor.org_unit_full_path(?)';
+	$func = 'actor.org_unit_full_path(?,?)' if (@binds > 1);
+
+	my $sth = actor::org_unit->db_Main->prepare_cached("SELECT * FROM $func");
+	$sth->execute(@binds);
+
+	$client->respond( $_->to_fieldmapper ) for ( map { actor::org_unit->construct($_) } $sth->fetchall_hash );
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.org_unit.full_path',
+	api_level	=> 1,
+	stream		=> 1,
+	method		=> 'org_unit_full_path',
+);
+
+sub org_unit_ancestors {
+	my $self = shift;
+	my $client = shift;
+	my $id = shift;
+
+	return undef unless ($id);
+
+	my $func = 'actor.org_unit_ancestors(?)';
+
+	my $sth = actor::org_unit->db_Main->prepare_cached(<<"	SQL");
+		SELECT	f.*
+		  FROM	$func f
+			JOIN actor.org_unit_type t ON (f.ou_type = t.id)
+		  ORDER BY t.depth, f.name;
+	SQL
+	$sth->execute(''.$id);
+
+	$client->respond( $_->to_fieldmapper ) for ( map { actor::org_unit->construct($_) } $sth->fetchall_hash );
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.org_unit.ancestors',
+	api_level	=> 1,
+	stream		=> 1,
+	method		=> 'org_unit_ancestors',
+);
+
+sub org_unit_descendants {
+	my $self = shift;
+	my $client = shift;
+	my $id = shift;
+	my $depth = shift;
+
+	return undef unless ($id);
+
+	my $func = 'actor.org_unit_descendants(?)';
+	if (defined $depth) {
+		$func = 'actor.org_unit_descendants(?,?)';
+	}
+
+	my $sth = actor::org_unit->db_Main->prepare_cached("SELECT * FROM $func");
+	$sth->execute(''.$id, ''.$depth) if (defined $depth);
+	$sth->execute(''.$id) unless (defined $depth);
+
+	$client->respond( $_->to_fieldmapper ) for ( map { actor::org_unit->construct($_) } $sth->fetchall_hash );
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.actor.org_unit.descendants',
+	api_level	=> 1,
+	stream		=> 1,
+	method		=> 'org_unit_descendants',
+);
+
+sub fleshed_actor_stat_cat {
+        my $self = shift;
+        my $client = shift;
+        my @list = @_;
+        
+	@list = ($list[0]) unless ($self->api_name =~ /batch/o);
+
+	for my $sc (@list) {
+		my $cat = actor::stat_cat->retrieve($sc);
+		next unless ($cat);
+
+		my $sc_fm = $cat->to_fieldmapper;
+		$sc_fm->entries( [ map { $_->to_fieldmapper } $cat->entries ] );
+
+		$client->respond( $sc_fm );
+
+	}
+
+	return undef;
+}
+__PACKAGE__->register_method(
+        api_name        => 'open-ils.storage.fleshed.actor.stat_cat.retrieve',
+        api_level       => 1,
+	argc		=> 1,
+        method          => 'fleshed_actor_stat_cat',
+);
+
+__PACKAGE__->register_method(
+        api_name        => 'open-ils.storage.fleshed.actor.stat_cat.retrieve.batch',
+        api_level       => 1,
+	argc		=> 1,
+        stream          => 1,
+        method          => 'fleshed_actor_stat_cat',
+);
+
+#XXX Fix stored proc calls
+sub ranged_actor_stat_cat_all {
+        my $self = shift;
+        my $client = shift;
+        my $ou = ''.shift();
+        
+        return undef unless ($ou);
+        my $s_table = actor::stat_cat->table;
+
+        my $select = <<"        SQL";
+                SELECT  s.*
+                  FROM  $s_table s
+                        JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner)
+		  ORDER BY name
+        SQL
+
+	$fleshed = 0;
+	$fleshed = 1 if ($self->api_name =~ /fleshed/o);
+
+        my $sth = actor::stat_cat->db_Main->prepare_cached($select);
+        $sth->execute($ou);
+
+        for my $sc ( map { actor::stat_cat->construct($_) } $sth->fetchall_hash ) {
+		my $sc_fm = $sc->to_fieldmapper;
+		$sc_fm->entries(
+			[ $self->method_lookup( 'open-ils.storage.ranged.actor.stat_cat_entry.search.stat_cat' )->run($ou,$sc->id) ]
+		) if ($fleshed);
+		$client->respond( $sc_fm );
+	}
+
+        return undef;
+}
+__PACKAGE__->register_method(
+        api_name        => 'open-ils.storage.ranged.fleshed.actor.stat_cat.all',
+        api_level       => 1,
+	argc		=> 1,
+        stream          => 1,
+        method          => 'ranged_actor_stat_cat_all',
+);
+
+__PACKAGE__->register_method(
+        api_name        => 'open-ils.storage.ranged.actor.stat_cat.all',
+        api_level       => 1,
+	argc		=> 1,
+        stream          => 1,
+        method          => 'ranged_actor_stat_cat_all',
+);
+
+#XXX Fix stored proc calls
+sub ranged_actor_stat_cat_entry {
+        my $self = shift;
+        my $client = shift;
+        my $ou = ''.shift();
+        my $sc = ''.shift();
+        
+        return undef unless ($ou);
+        my $s_table = actor::stat_cat_entry->table;
+
+        my $select = <<"        SQL";
+                SELECT  s.*
+                  FROM  $s_table s
+                        JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner)
+		  WHERE	stat_cat = ?
+		  ORDER BY name
+        SQL
+
+        my $sth = actor::stat_cat->db_Main->prepare_cached($select);
+        $sth->execute($ou,$sc);
+
+        for my $sce ( map { actor::stat_cat_entry->construct($_) } $sth->fetchall_hash ) {
+		$client->respond( $sce->to_fieldmapper );
+	}
+
+        return undef;
+}
+__PACKAGE__->register_method(
+        api_name        => 'open-ils.storage.ranged.actor.stat_cat_entry.search.stat_cat',
+        api_level       => 1,
+        stream          => 1,
+        method          => 'ranged_actor_stat_cat_entry',
+);
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/asset.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/asset.pm
new file mode 100644
index 0000000000..622a1dbbf1
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/asset.pm
@@ -0,0 +1,888 @@
+package OpenILS::Application::Storage::Publisher::asset;
+use base qw/OpenILS::Application::Storage/;
+#use OpenILS::Application::Storage::CDBI::asset;
+#use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::Logger qw/:level/;
+use OpenSRF::EX qw/:try/;
+use OpenSRF::Utils::JSON;
+
+#
+
+my $log = 'OpenSRF::Utils::Logger';
+
+use MARC::Record;
+use MARC::File::XML;
+
+sub circ_count {
+	my $self = shift;
+	my $client = shift;
+	my $copy = shift;
+	my $granularity = shift;
+
+	my $c_table = action::circulation->table;
+
+	if (lc($granularity) eq 'year') {
+		$granularity = ", to_char(xact_start, 'YYYY') as when";
+	} elsif (lc($granularity) eq 'month') {
+		$granularity = ", to_char(xact_start, 'YYYY-MM') as when";
+	} elsif (lc($granularity) eq 'day') {
+		$granularity = ", to_char(xact_start, 'YYYY-MM-DD') as when";
+	} else {
+		$granularity = ", 'total' as when";
+	}
+
+	my $SQL = <<"	SQL";
+		SELECT	COUNT(*) as count $granularity
+		  FROM	$c_table
+		  WHERE	target_copy = ?
+	SQL
+
+
+	if ($granularity !~ /total/o) {
+		$SQL .= ' GROUP BY 2 ORDER BY 2';
+	}
+
+	$log->debug("Circ count SQL [$SQL]", DEBUG);
+
+	return action::circulation->db_Main->selectall_hashref($SQL, 'when', {}, $copy);
+}
+__PACKAGE__->register_method(
+	method		=> 'circ_count',
+	api_name	=> 'open-ils.storage.asset.copy.circ_count',
+	argc		=> 1,
+);
+
+
+#our $_default_subfield_map = {
+#        call_number     => $cn,
+#        barcode         => $bc,
+#        owning_lib      => $ol,
+#        circulating_lib => $cl,
+#        copy_location   => $sl,
+#        copy_number     => $num,
+#        price           => $pr,
+#        status          => $loc,
+#        create_date     => $date,
+#
+#        legacy_item_type        => $it,
+#        legacy_item_cat_1       => $ic1,
+#        legacy_item_cat_2       => $ic2,
+#};
+
+my %org_cache;
+
+sub import_xml_holdings {
+	my $self = shift;
+	my $client = shift;
+	my $editor = shift;
+	my $record = shift;
+	my $xml = shift;
+	my $tag = shift;
+	my $map = shift;
+	my $date_format = shift || 'mm/dd/yyyy';
+
+	($record) = biblio::record_entry->search_where($record);
+
+	return 0 unless ($record);
+
+	my $r = MARC::Record->new_from_xml($xml);
+
+	my $count = 0;
+	for my $f ( $r->fields( $tag ) ) {
+		next unless ($f->subfield( $map->{owning_lib} ));
+
+		my ($ol,$cl);
+
+		try {
+			$ol = 
+				$org_cache{ $f->subfield( $map->{owning_lib} ) }
+				|| actor::org_unit->search( shortname => $f->subfield( $map->{owning_lib} ) )->next->id;
+
+			$org_cache{ $f->subfield( $map->{owning_lib} ) } = $ol;
+		} otherwise {
+			$log->debug('Could not find library with shortname ['.$f->subfield( $map->{owning_lib} ).'] : '. shift(), ERROR);
+			$log->info('Failed holdings tag: ['.OpenSRF::Utils::JSON->perl2JSON( $f ).']');
+		};
+		
+		try {
+			$cl =
+				$org_cache{ $f->subfield( $map->{circulating_lib} ) }
+				|| actor::org_unit->search( shortname => $f->subfield( $map->{circulating_lib} ) )->next->id;
+
+			$org_cache{ $f->subfield( $map->{circulating_lib} ) } = $cl;
+		} otherwise {
+			$log->debug('Could not find library with shortname ['.$f->subfield( $map->{circulating_lib} ).'] : '. shift(), ERROR);
+			$log->info('Failed holdings tag: ['.OpenSRF::Utils::JSON->perl2JSON( $f ).']');
+		};
+
+		next unless ($ol && $cl);
+
+		my $cn;
+		try {
+			$cn = asset::call_number->find_or_create(
+				{ label		=> $f->subfield( $map->{call_number} ),
+				  owning_lib	=> $ol,
+				  record	=> $record->id,
+				  creator	=> $editor,
+				  editor	=> $editor,
+				}
+			);
+		} otherwise {
+			$log->debug('Could not find or create callnumber ['.$f->subfield( $map->{call_number} )."] on record $record : ". shift(), ERROR);
+			$log->info('Failed holdings tag: ['.OpenSRF::Utils::JSON->perl2JSON( $f ).']');
+		};
+
+		next unless ($cn);
+
+		my $create_date =  $f->subfield( $map->{create_date} );
+
+		my ($m,$d,$y);
+		if ($date_format eq 'mm/dd/yyyy') {
+			($m,$d,$y) = split '/', $create_date;
+
+		} elsif ($date_format eq 'dd/mm/yyyy') {
+			($d,$m,$y) = split '/', $create_date;
+
+		} elsif ($date_format eq 'mm-dd-yyyy') {
+			($m,$d,$y) = split '-', $create_date;
+
+		} elsif ($date_format eq 'dd-mm-yyyy') {
+			($d,$m,$y) = split '-', $create_date;
+
+		} elsif ($date_format eq 'yyyy-mm-dd') {
+			($y,$m,$d) = split '-', $create_date;
+
+		} elsif ($date_format eq 'yyyy/mm/dd') {
+			($y,$m,$d) = split '/', $create_date;
+		}
+
+		if ($y == 0) {
+			(undef,undef,undef,$d,$m,$y) = localtime;
+			$m++;
+			$y+=1900;
+		}
+
+		my $price = $f->subfield( $map->{price} );
+		$price =~ s/[^0-9\.]+//gso;
+		$price ||= '0.00';
+
+		try {
+			$cn->add_to_copies(
+				{ circ_lib	=> $cl,
+				  copy_number	=> $f->subfield( $map->{copy_number} ),
+				  price		=> $price,
+				  barcode	=> $f->subfield( $map->{barcode} ),
+				  loan_duration	=> 2,
+				  fine_level	=> 2,
+				  creator	=> $editor,
+				  editor	=> $editor,
+				  create_date	=> sprintf('%04d-%02d-%02d',$y,$m,$d),
+				}
+			);
+			$count++;
+		} otherwise {
+			$log->debug('Could not create copy ['.$f->subfield( $map->{barcode} ).'] : '. shift(), ERROR);
+		};
+	}
+
+	return $count;
+}
+__PACKAGE__->register_method(
+	method		=> 'import_xml_holdings',
+	api_name	=> 'open-ils.storage.asset.holdings.import.xml',
+	argc		=> 5,
+	stream		=> 0,
+);
+
+# XXX
+# see /home/miker/cn_browse-test.sql for page up and down sql ...
+# XXX
+
+sub cn_browse_pagedown {
+	my $self = shift;
+	my $client = shift;
+
+	my %args = @_;
+
+	my $cn = uc($args{label});
+	my $org = $args{org_unit};
+	my $depth = $args{depth};
+	my $boundry_id = $args{boundry_id};
+	my $size = $args{page_size} || 20;
+	$size = int($size);
+
+	my $table = asset::call_number->table;
+
+	my $descendants = "actor.org_unit_descendants($org)";
+	if (defined $depth) {
+		$descendants = "actor.org_unit_descendants($org,$depth)";
+	}
+
+	my $orgs = join(',', @{ asset::call_number->db_Main->selectcol_arrayref("SELECT DISTINCT id FROM $descendants;") });
+	
+	my $sql = <<"	SQL";
+		select
+		        cn.label,
+		        cn.owning_lib,
+	        	cn.record,
+		        cn.id
+		from
+		        $table cn
+		where
+			not deleted
+		        and (oils_text_as_bytea(label) > ? or ( cn.id > ? and oils_text_as_bytea(label) = ? ))
+			and owning_lib in ($orgs)
+		order by oils_text_as_bytea(label), 4, 2
+		limit $size;
+	SQL
+
+	my $sth = asset::call_number->db_Main->prepare($sql);
+	$sth->execute($cn, $boundry_id, $cn);
+	while ( my @row = $sth->fetchrow_array ) {
+		$client->respond([@row]);
+	}
+	$sth->finish;
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	method		=> 'cn_browse_pagedown',
+	api_name	=> 'open-ils.storage.asset.call_number.browse.page_down',
+	argc		=> 4,
+	stream		=> 1,
+);
+
+sub cn_browse_pageup {
+	my $self = shift;
+	my $client = shift;
+
+	my %args = @_;
+
+	my $cn = uc($args{label});
+	my $org = $args{org_unit};
+	my $depth = $args{depth};
+	my $boundry_id = $args{boundry_id};
+	my $size = $args{page_size} || 20;
+	$size = int($size);
+
+	my $table = asset::call_number->table;
+
+	my $descendants = "actor.org_unit_descendants($org)";
+	if (defined $depth) {
+		$descendants = "actor.org_unit_descendants($org,$depth)";
+	}
+
+	my $orgs = join(',', @{ asset::call_number->db_Main->selectcol_arrayref("SELECT DISTINCT id FROM $descendants;") });
+
+	my $sql = <<"	SQL";
+		select * from (
+			select
+			        cn.label,
+			        cn.owning_lib,
+		        	cn.record,
+			        cn.id
+			from
+			        $table cn
+			where
+				not deleted
+			        and (oils_text_as_bytea(label) < ? or ( cn.id < ? and oils_text_as_bytea(label) = ? ))
+				and owning_lib in ($orgs)
+			order by oils_text_as_bytea(label) desc, 4 desc, 2 desc
+			limit $size
+		) as bar
+		order by 1,4,2;
+	SQL
+
+	my $sth = asset::call_number->db_Main->prepare($sql);
+	$sth->execute($cn, $boundry_id, $cn);
+	while ( my @row = $sth->fetchrow_array ) {
+		$client->respond([@row]);
+	}
+	$sth->finish;
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	method		=> 'cn_browse_pageup',
+	api_name	=> 'open-ils.storage.asset.call_number.browse.page_up',
+	argc		=> 4,
+	stream		=> 1,
+);
+
+sub cn_browse_target {
+	my $self = shift;
+	my $client = shift;
+
+	my %args = @_;
+
+	my $cn = uc($args{label});
+	my $org = $args{org_unit};
+	my $depth = $args{depth};
+	my $size = $args{page_size} || 20;
+	my $topsize = $size / 2;
+	$topsize = int($topsize);
+	$bottomsize = $size - $topsize;
+
+	my $table = asset::call_number->table;
+
+	my $descendants = "actor.org_unit_descendants($org)";
+	if (defined $depth) {
+		$descendants = "actor.org_unit_descendants($org,$depth)";
+	}
+
+	my $orgs = join(',', @{ asset::call_number->db_Main->selectcol_arrayref("SELECT DISTINCT id FROM $descendants;") });
+
+	my $top_sql = <<"	SQL";
+		select * from (
+			select
+			        cn.label,
+			        cn.owning_lib,
+			       	cn.record,
+			        cn.id
+			from
+			        $table cn
+			where
+				not deleted
+			        and oils_text_as_bytea(label) < ?
+				and owning_lib in ($orgs)
+			order by oils_text_as_bytea(label) desc, 4 desc, 2 desc
+			limit $topsize
+		) as bar
+		order by 1,4,2;
+	SQL
+
+	my $bottom_sql = <<"	SQL";
+		select
+        		cn.label,
+		        cn.owning_lib,
+		        cn.record,
+	        	cn.id
+		from
+		        $table cn
+		where
+			not deleted
+		        and oils_text_as_bytea(label) >= ?
+			and owning_lib in ($orgs)
+		order by oils_text_as_bytea(label),4,2
+		limit $bottomsize;
+	SQL
+
+	my $sth = asset::call_number->db_Main->prepare($top_sql);
+	$sth->execute($cn);
+	while ( my @row = $sth->fetchrow_array ) {
+		$client->respond([@row]);
+	}
+	$sth->finish;
+
+	$sth = asset::call_number->db_Main->prepare($bottom_sql);
+	$sth->execute($cn);
+	while ( my @row = $sth->fetchrow_array ) {
+		$client->respond([@row]);
+	}
+	$sth->finish;
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	method		=> 'cn_browse_target',
+	api_name	=> 'open-ils.storage.asset.call_number.browse.target',
+	argc		=> 4,
+	stream		=> 1,
+);
+
+
+sub copy_proximity {
+	my $self = shift;
+	my $client = shift;
+
+	my $cp = shift;
+	my $org = shift;
+
+	return unless ($cp && $org);
+
+	$cp = asset::copy->retrieve($cp) unless (ref($cp));
+
+	return unless $cp;
+	my $ol = $cp->circ_lib;
+
+	return (actor::org_unit_proximity->search( from_org => "$ol", to_org => "$org"))[0]->prox;
+}
+__PACKAGE__->register_method(
+	method		=> 'copy_proximity',
+	api_name	=> 'open-ils.storage.asset.copy.proximity',
+	argc		=> 2,
+	stream		=> 1,
+);
+
+sub asset_copy_location_all {
+	my $self = shift;
+	my $client = shift;
+
+	for my $rec ( asset::copy_location->retrieve_all ) {
+		$client->respond( $rec->to_fieldmapper );
+	}
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	method		=> 'asset_copy_location_all',
+	api_name	=> 'open-ils.storage.direct.asset.copy_location.retrieve.all',
+	argc		=> 0,
+	stream		=> 1,
+);
+
+# XXX arg, with the descendancy SPs...
+sub ranged_asset_copy_location {
+        my $self = shift;
+        my $client = shift;
+        my @binds = @_;
+        
+        my $ctable = asset::copy_location->table;
+        
+        my $descendants = defined($binds[1]) ?
+                "actor.org_unit_full_path(?, ?)" :
+                "actor.org_unit_full_path(?)" ;
+
+        
+        my $sql = <<"	SQL";
+                SELECT  DISTINCT c.*
+                  FROM  $ctable c
+                        JOIN $descendants d
+                                ON (d.id = c.owning_lib)
+                 ORDER BY name
+	SQL
+        
+        my $sth = asset::copy_location->db_Main->prepare($sql);
+        $sth->execute(@binds);
+        
+        while ( my $rec = $sth->fetchrow_hashref ) {
+        
+                my $cnct = new Fieldmapper::asset::copy_location;
+		map {$cnct->$_($$rec{$_})} keys %$rec;
+                $client->respond( $cnct );
+        }
+
+        return undef;
+}
+__PACKAGE__->register_method(
+        method          => 'ranged_asset_copy_location',
+        api_name        => 'open-ils.storage.ranged.asset.copy_location.retrieve',
+        argc            => 1,
+        stream          => 1,
+);
+
+
+sub fleshed_copy {
+	my $self = shift;
+	my $client = shift;
+	my @ids = @_;
+
+	return undef unless (@ids);
+
+	@ids = ($ids[0]) unless ($self->api_name =~ /batch/o);
+
+	for my $id ( @ids ) {
+		next unless $id;
+		my $cp = asset::copy->retrieve($id);
+		next unless $cp;
+
+		my $cp_fm = $cp->to_fieldmapper;
+		$cp_fm->circ_lib( $cp->circ_lib->to_fieldmapper );
+		$cp_fm->location( $cp->location->to_fieldmapper );
+		$cp_fm->status( $cp->status->to_fieldmapper );
+		$cp_fm->stat_cat_entries( [ map { $_->to_fieldmapper } $cp->stat_cat_entries ] );
+
+		$client->respond( $cp_fm );
+	}
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.fleshed.asset.copy.batch.retrieve',
+	method		=> 'fleshed_copy',
+	argc		=> 1,
+	stream		=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.fleshed.asset.copy.retrieve',
+	method		=> 'fleshed_copy',
+	argc		=> 1,
+);
+
+sub fleshed_copy_by_barcode {
+	my $self = shift;
+	my $client = shift;
+	my $bc = ''.shift;
+
+	my ($cp) = asset::copy->search( { barcode => $bc } );
+
+	return undef unless ($cp);
+
+	my $cp_fm = $cp->to_fieldmapper;
+	$cp_fm->circ_lib( $cp->circ_lib->to_fieldmapper );
+	$cp_fm->location( $cp->location->to_fieldmapper );
+	$cp_fm->status( $cp->status->to_fieldmapper );
+
+	return $cp_fm;
+}	
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.fleshed.asset.copy.search.barcode',
+	method		=> 'fleshed_copy_by_barcode',
+	argc		=> 1,
+	stream		=> 1,
+);
+
+
+#XXX Fix stored proc calls
+sub fleshed_asset_stat_cat {
+        my $self = shift;
+        my $client = shift;
+        my @list = @_;
+
+	@list = ($list[0]) unless ($self->api_name =~ /batch/o);
+	for my $sc (@list) {
+        	my $cat = asset::stat_cat->retrieve($sc);
+		
+		next unless ($cat);
+
+                my $sc_fm = $cat->to_fieldmapper;
+                $sc_fm->entries( [ map { $_->to_fieldmapper } $cat->entries ] );
+                $client->respond( $sc_fm );
+        }
+
+        return undef;
+}
+__PACKAGE__->register_method(
+        api_name        => 'open-ils.storage.fleshed.asset.stat_cat.retrieve',
+        api_level       => 1,
+        method          => 'fleshed_asset_stat_cat',
+);
+
+__PACKAGE__->register_method(
+        api_name        => 'open-ils.storage.fleshed.asset.stat_cat.retrieve.batch',
+        api_level       => 1,
+        stream          => 1,
+        method          => 'fleshed_asset_stat_cat',
+);
+
+
+#XXX Fix stored proc calls
+sub ranged_asset_stat_cat {
+        my $self = shift;
+        my $client = shift;
+        my $ou = ''.shift();
+
+        return undef unless ($ou);
+        my $s_table = asset::stat_cat->table;
+
+        my $select = <<"        SQL";
+                SELECT  s.*
+                  FROM  $s_table s
+                        JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner)
+                  ORDER BY name
+        SQL
+
+        $fleshed = 0;
+        $fleshed = 1 if ($self->api_name =~ /fleshed/o);
+
+        my $sth = asset::stat_cat->db_Main->prepare_cached($select);
+        $sth->execute($ou);
+
+        for my $sc ( map { asset::stat_cat->construct($_) } $sth->fetchall_hash ) {
+                my $sc_fm = $sc->to_fieldmapper;
+                $sc_fm->entries(
+                        [ $self->method_lookup( 'open-ils.storage.ranged.asset.stat_cat_entry.search.stat_cat' )->run($ou,$sc->id) ]
+                ) if ($fleshed);
+                $client->respond( $sc_fm );
+        }
+
+        return undef;
+}
+__PACKAGE__->register_method(
+        api_name        => 'open-ils.storage.ranged.fleshed.asset.stat_cat.all',
+        api_level       => 1,
+        stream          => 1,
+        method          => 'ranged_asset_stat_cat',
+);
+
+__PACKAGE__->register_method(
+        api_name        => 'open-ils.storage.ranged.asset.stat_cat.all',
+        api_level       => 1,
+        stream          => 1,
+        method          => 'ranged_asset_stat_cat',
+);
+
+
+#XXX Fix stored proc calls
+sub multiranged_asset_stat_cat {
+        my $self = shift;
+        my $client = shift;
+        my $ous = shift;
+
+        return undef unless (defined($ous) and @$ous);
+        my $s_table = asset::stat_cat->table;
+
+        my $select = <<"        SQL";
+                SELECT  s.*
+                  FROM  $s_table s
+		  WHERE s.owner IN ( XXX )
+                  ORDER BY name
+        SQL
+
+	my $collector = ' INTERSECT ';
+	my $entry_method = 'open-ils.storage.multiranged.intersect.asset.stat_cat_entry.search.stat_cat';
+	if ($self->api_name =~ /union/o) {
+		$collector = ' UNION ';
+		$entry_method = 'open-ils.storage.multiranged.union.asset.stat_cat_entry.search.stat_cat';
+	}
+
+	my $binds = join($collector, map { 'SELECT id FROM actor.org_unit_full_path(?)' } grep {defined} @$ous);
+	$select =~ s/XXX/$binds/so;
+	
+        $fleshed = 0;
+        $fleshed = 1 if ($self->api_name =~ /fleshed/o);
+
+        my $sth = asset::stat_cat->db_Main->prepare_cached($select);
+        $sth->execute(map { "$_" } grep {defined} @$ous);
+
+        for my $sc ( map { asset::stat_cat->construct($_) } $sth->fetchall_hash ) {
+                my $sc_fm = $sc->to_fieldmapper;
+                $sc_fm->entries(
+                        [ $self->method_lookup( $entry_method )->run($ous, $sc->id) ]
+                ) if ($fleshed);
+                $client->respond( $sc_fm );
+        }
+
+        return undef;
+}
+__PACKAGE__->register_method(
+        api_name        => 'open-ils.storage.multiranged.intersect.fleshed.asset.stat_cat.all',
+        api_level       => 1,
+        stream          => 1,
+        method          => 'multiranged_asset_stat_cat',
+);
+__PACKAGE__->register_method(
+        api_name        => 'open-ils.storage.multiranged.union.fleshed.asset.stat_cat.all',
+        api_level       => 1,
+        stream          => 1,
+        method          => 'multiranged_asset_stat_cat',
+);
+
+#XXX Fix stored proc calls
+sub ranged_asset_stat_cat_entry {
+        my $self = shift;
+        my $client = shift;
+        my $ou = ''.shift();
+        my $sc = ''.shift();
+
+        return undef unless ($ou);
+        my $s_table = asset::stat_cat_entry->table;
+
+        my $select = <<"        SQL";
+                SELECT  s.*
+                  FROM  $s_table s
+                        JOIN actor.org_unit_full_path(?) p ON (p.id = s.owner)
+                  WHERE stat_cat = ?
+                  ORDER BY name
+        SQL
+
+        my $sth = asset::stat_cat->db_Main->prepare_cached($select);
+        $sth->execute($ou,$sc);
+
+        for my $sce ( map { asset::stat_cat_entry->construct($_) } $sth->fetchall_hash ) {
+                $client->respond( $sce->to_fieldmapper );
+        }
+
+        return undef;
+}
+__PACKAGE__->register_method(
+        api_name        => 'open-ils.storage.ranged.asset.stat_cat_entry.search.stat_cat',
+        api_level       => 1,
+        stream          => 1,
+        method          => 'ranged_asset_stat_cat_entry',
+);
+
+#XXX Fix stored proc calls
+sub multiranged_asset_stat_cat_entry {
+        my $self = shift;
+        my $client = shift;
+        my $ous = shift;
+        my $sc = ''.shift();
+
+        return undef unless (defined($ous) and @$ous);
+        my $s_table = asset::stat_cat_entry->table;
+
+	my $collector = ' INTERSECT ';
+	$collector = ' UNION ' if ($self->api_name =~ /union/o);
+
+        my $select = <<"        SQL";
+                SELECT  s.*
+                  FROM  $s_table s
+		  WHERE s.owner IN ( XXX ) and s.stat_cat = ?
+                  ORDER BY value
+        SQL
+
+	my $binds = join($collector, map { 'SELECT id FROM actor.org_unit_full_path(?)' } grep {defined} @$ous);
+	$select =~ s/XXX/$binds/so;
+	
+        my $sth = asset::stat_cat->db_Main->prepare_cached($select);
+        $sth->execute(map {"$_"} @$ous,$sc);
+
+        for my $sce ( map { asset::stat_cat_entry->construct($_) } $sth->fetchall_hash ) {
+                $client->respond( $sce->to_fieldmapper );
+        }
+
+        return undef;
+}
+__PACKAGE__->register_method(
+        api_name        => 'open-ils.storage.multiranged.intersect.asset.stat_cat_entry.search.stat_cat',
+        api_level       => 1,
+        stream          => 1,
+        method          => 'multiranged_asset_stat_cat_entry',
+);
+__PACKAGE__->register_method(
+        api_name        => 'open-ils.storage.multiranged.union.asset.stat_cat_entry.search.stat_cat',
+        api_level       => 1,
+        stream          => 1,
+        method          => 'multiranged_asset_stat_cat_entry',
+);
+
+
+sub cn_ranged_tree {
+	my $self = shift;
+	my $client = shift;
+	my $cn = shift;
+	my $ou = shift;
+	my $depth = shift || 0;
+
+	my $ou_list =
+		actor::org_unit
+			->db_Main
+			->selectcol_arrayref(
+				'SELECT id FROM actor.org_unit_descendants(?,?)',
+				{},
+				$ou,
+				$depth
+			);
+
+	return undef unless ($ou_list and @$ou_list);
+
+	$cn = asset::call_number->retrieve( $cn );
+	return undef unless ($cn);
+	return undef if ($cn->deleted);
+
+	my $call_number = $cn->to_fieldmapper;
+	$call_number->copies([]);
+
+	$call_number->record( $cn->record->to_fieldmapper );
+	$call_number->record->fixed_fields( $cn->record->record_descriptor->next->to_fieldmapper );
+
+	for my $cp ( $cn->copies(circ_lib => $ou_list) ) {
+		next if ($cp->deleted);
+		my $copy = $cp->to_fieldmapper;
+		$copy->status( $cp->status->to_fieldmapper );
+		$copy->location( $cp->location->to_fieldmapper );
+
+		push @{ $call_number->copies }, $copy;
+	}
+
+	return $call_number;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.asset.call_number.ranged_tree',
+	method		=> 'cn_ranged_tree',
+	argc		=> 1,
+	api_level	=> 1,
+);
+
+
+# XXX Since this is all we need in open-ils.storage for serial stuff ATM, just
+# XXX putting it here instead of creating a whole new file.
+sub issuance_ranged_tree {
+    my $self = shift;
+    my $client = shift;
+    my $iss = shift;
+    my $ou = shift;
+    my $depth = shift || 0;
+
+    my $ou_list =
+        actor::org_unit
+            ->db_Main
+            ->selectcol_arrayref(
+                'SELECT id FROM actor.org_unit_descendants(?,?)',
+                {},
+                $ou,
+                $depth
+            );
+
+    return undef unless ($ou_list and @$ou_list);
+
+    $iss = serial::issuance->retrieve( $iss );
+    return undef unless ($iss);
+
+    my $issuance = $iss->to_fieldmapper;
+    $issuance->items([]);
+
+    # Now, gather issuances on the same bib, with the same label and date_published ...
+    my @subs = map { $_->id } serial::subscription->search( record_entry => $iss->subscription->record_entry->id );
+
+    my @similar_iss = serial::issuance->search_where(
+        subscription => \@subs,
+        label => $iss->label,
+        date_published => $iss->date_published
+    );
+
+    # ... and add all /their/ items to the target issuance
+    for my $i ( @similar_iss ) {
+        for my $it ( $i->items() ) {
+            next unless $it->unit and not $it->unit->deleted;
+            next unless (grep { $it->unit->circ_lib eq $_ } @$ou_list);
+    
+            my $unit = $it->unit->to_fieldmapper;
+            $unit->status( $it->unit->status->to_fieldmapper );
+            $unit->location( $it->unit->location->to_fieldmapper );
+
+            my $item = $it->to_fieldmapper;
+            $item->unit( $unit );
+    
+            push @{ $issuance->items }, $item;
+        }
+    }
+
+    return $issuance;
+}
+__PACKAGE__->register_method(
+    api_name    => 'open-ils.storage.serial.issuance.ranged_tree',
+    method      => 'issuance_ranged_tree',
+    argc        => 1,
+    api_level   => 1,
+);
+
+sub merge_record_assets {
+	my $self = shift;
+	my $client = shift;
+	my $target = shift;
+	my @sources = @_;
+
+	my $count = 0;
+	for my $source ( @sources ) {
+		$count += asset::call_number
+				->db_Main
+				->selectcol_arrayref(
+					"SELECT asset.merge_record_assets(?,?);",
+					{},
+					$target,
+					$source
+				)->[0];
+	}
+
+	return $count;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.asset.merge_record_assets',
+	method		=> 'merge_record_assets',
+	argc		=> 2,
+	api_level	=> 1,
+);
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/authority.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/authority.pm
new file mode 100644
index 0000000000..f21530f745
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/authority.pm
@@ -0,0 +1,261 @@
+package OpenILS::Application::Storage::Publisher::authority;
+use base qw/OpenILS::Application::Storage::Publisher/;
+use vars qw/$VERSION/;
+use OpenSRF::EX qw/:try/;
+use OpenILS::Application::Storage::FTS;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::Normalize qw( naco_normalize );
+use OpenSRF::Utils::Logger qw/:level/;
+use OpenSRF::Utils::Cache;
+use Data::Dumper;
+use Digest::MD5 qw/md5_hex/;
+use XML::LibXML;
+use Time::HiRes qw/time sleep/;
+use Unicode::Normalize;
+
+my $log = 'OpenSRF::Utils::Logger';
+
+$VERSION = 1;
+
+my $parser = XML::LibXML->new;
+
+sub validate_tag {
+	my $self = shift;
+	my $client = shift;
+	my %args = @_;
+	
+	my @tags = @{$args{tags}};
+	my @searches = @{$args{searches}};
+
+	my $search_table = authority::full_rec->table;
+
+	my @values;
+	my @selects;
+	for my $t ( @tags ) {
+		for my $search ( @searches ) {
+			my $sf = $$search{subfield};
+			my $term = naco_normalize($$search{term}, $sf);
+
+			$tag = [$tag] if (!ref($tag));
+
+			push @values, $t, $sf, $term;
+
+			push @selects,
+				"SELECT record FROM $search_table ".
+				"WHERE tag = ? AND subfield = ? AND value = ?";
+		}
+
+		my $sql;
+		if ($self->api_name =~ /id_list/) {
+			$sql = 'SELECT DISTINCT record FROM (';
+		} else {
+			$sql = 'SELECT COUNT(DISTINCT record) FROM (';
+		}
+		$sql .= 'SELECT record FROM (('.join(') INTERSECT (', @selects).')) AS x ';
+		$sql .= "JOIN $search_table recheck USING (record) WHERE recheck.tag = ? ";
+		$sql .= "GROUP BY 1 HAVING (COUNT(recheck.id) - ?) = 0) AS foo;";
+
+		if ($self->api_name =~ /id_list/) {
+			my $id_list = authority::full_rec->db_Main->selectcol_arrayref( $sql, {}, @values, $t, scalar(@searches) );
+			return $id_list;
+		} else {
+			my $count = authority::full_rec->db_Main->selectcol_arrayref( $sql, {}, @values, $t, scalar(@searches) )->[0];
+			return $count if ($count > 0);
+		}
+	}
+
+	return 0;
+}
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.authority.validate.tag",
+	method		=> 'validate_tag',
+	api_level	=> 1,
+);
+
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.authority.validate.tag.id_list",
+	method		=> 'validate_tag',
+	api_level	=> 1,
+);
+
+
+sub find_authority_marc {
+	my $self = shift;
+	my $client = shift;
+	my %args = @_;
+	
+	my $term = NFD(lc($args{term}));
+	my $tag = $args{tag};
+	my $subfield = $args{subfield};
+	my $limit = $args{limit} || 100;
+	my $offset = $args{offset} || 0;
+
+	if ($limit) {
+		$limit = "LIMIT $limit";
+	} else {
+		$limit = '';
+	}
+
+	if ($offset) {
+		$offset = "OFFSET $offset";
+	} else {
+		$offset = '';
+	}
+
+	my $tag_where = "AND f.tag LIKE '$tag'";
+	if (ref $tag) {
+		$tag_where = "AND f.tag IN ('".join("','",@$tag)."')";
+	}
+
+	my $sf_where = "AND f.subfield = '$subfield'";
+	if (ref $subfield) {
+		$sf_where = "AND f.subfield IN ('".join("','",@$subfield)."')";
+	}
+
+	my $search_table = authority::full_rec->table;
+	my $marc_table = authority::record_entry->table;
+
+	my ($index_col) = authority::full_rec->columns('FTS');
+	$index_col ||= 'value';
+
+	my $fts = OpenILS::Application::Storage::FTS->compile(default => $term, 'f.value', "f.$index_col");
+
+	$term =~ s/\W+$//gso;
+	$term =~ s/'/''/gso;
+	$term =~ s/\pM//gso;
+
+	my $fts_where = $fts->sql_where_clause;
+	my $fts_words = join '%', $fts->words;
+
+    return undef unless ($fts_words);
+
+	my $fts_words_where = "f.value LIKE '$fts_words\%'";
+	my $fts_start_where = "f.value LIKE '$term\%'";
+	my $fts_eq_where = "f.value = '$term'";
+
+	my $fts_rank = join '+', $fts->fts_rank;
+
+	my $select = <<"	SQL";
+		SELECT	a.marc, sum($fts_rank), count(f.record), first(f.value)
+  	  	FROM	$search_table f,
+			$marc_table a
+  	  	WHERE	$fts_start_where
+			$tag_where
+			$sf_where
+	  		AND a.id = f.record
+			GROUP BY 1
+			ORDER BY 2 desc, 3 desc, 4
+			$limit
+			$offset
+			
+	SQL
+
+	$log->debug("Authority Search SQL :: [$select]",DEBUG);
+
+	my $recs = authority::full_rec->db_Main->selectcol_arrayref( $select );
+	
+	$log->debug("Search yielded ".scalar(@$recs)." results.",DEBUG);
+
+	$client->respond($_) for (@$recs);
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.authority.search.marc",
+	method		=> 'find_authority_marc',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+
+sub _empty_check {
+	my $term = shift;
+	my $class = shift || 'metabib::full_rec';
+
+	my $table = $class->table;
+
+	my ($index_col) = $class->columns('FTS');
+	$index_col ||= 'value';
+
+	my $fts = OpenILS::Application::Storage::FTS->compile(default => $term, 'm.value', "m.$index_col");
+	my $fts_where = $fts->sql_where_clause;
+
+	my $sql = <<"	SQL";
+		SELECT	TRUE
+		FROM	$table m
+		WHERE	$fts_where
+		LIMIT 1
+	SQL
+
+	return $class->db_Main->selectcol_arrayref($sql)->[0];
+}
+
+my $prevtime;
+
+sub find_see_from_controlled {
+	my $self = shift;
+	my $client = shift;
+	my $term = shift;
+	my $limit = shift;
+	my $offset = shift;
+
+	$prevtime = time;
+
+	(my $class = $self->api_name) =~ s/^.+authority.([^\.]+)\.see.+$/$1/o;
+	my $sf = 'a';
+	$sf = 't' if ($class eq 'title');
+
+	my @marc = $self->method_lookup('open-ils.storage.authority.search.marc')
+			->run( term => $term, tag => [400,410,411,430,450,455], subfield => $sf, limit => $limit, offset => $offset );
+
+	
+	for my $m ( @marc ) {
+		my $doc = $parser->parse_string($m);
+		my @nodes = $doc->documentElement->findnodes('//*[substring(@tag,1,1)="1"]/*[@code="a" or @code="d" or @code="x"]');
+		my $list = [ map { $_->textContent } @nodes ];
+		$client->respond( $list ) if (_empty_check(join(' ',@$list), "metabib::${class}_field_entry"));
+	}
+	return undef;
+}
+for my $class ( qw/title author subject keyword series identifier/ ) {
+	__PACKAGE__->register_method(
+		api_name	=> "open-ils.storage.authority.$class.see_from.controlled",
+		method		=> 'find_see_from_controlled',
+		api_level	=> 1,
+		stream		=> 1,
+		cachable	=> 1,
+	);
+}
+
+sub find_see_also_from_controlled {
+	my $self = shift;
+	my $client = shift;
+	my $term = shift;
+	my $limit = shift;
+	my $offset = shift;
+
+	(my $class = $self->api_name) =~ s/^.+authority.([^\.]+)\.see.+$/$1/o;
+	my $sf = 'a';
+	$sf = 't' if ($class eq 'title');
+
+	my @marc = $self->method_lookup('open-ils.storage.authority.search.marc')
+			->run( term => $term, tag => [500,510,511,530,550,555], subfield => $sf, limit => $limit, offset => $offset );
+	for my $m ( @marc ) {
+		my $doc = $parser->parse_string($m);
+		my @nodes = $doc->documentElement->findnodes('//*[substring(@tag,1,1)="1"]/*[@code="a" or @code="d" or @code="x"]');
+		my $list = [ map { $_->textContent } @nodes ];
+		$client->respond( $list ) if (_empty_check(join(' ',@$list), "metabib::${class}_field_entry"));
+	}
+	return undef;
+}
+for my $class ( qw/title author subject keyword series identifier/ ) {
+	__PACKAGE__->register_method(
+		api_name	=> "open-ils.storage.authority.$class.see_also_from.controlled",
+		method		=> 'find_see_also_from_controlled',
+		api_level	=> 1,
+		stream		=> 1,
+		cachable	=> 1,
+	);
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/biblio.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/biblio.pm
new file mode 100644
index 0000000000..5b609bee73
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/biblio.pm
@@ -0,0 +1,500 @@
+package OpenILS::Application::Storage::Publisher::biblio;
+use base qw/OpenILS::Application::Storage/;
+use vars qw/$VERSION/;
+use OpenSRF::EX qw/:try/;
+#use OpenILS::Application::Storage::CDBI::biblio;
+#use OpenILS::Application::Storage::CDBI::asset;
+use OpenILS::Utils::Fieldmapper;
+
+$VERSION = 1;
+
+sub record_copy_count {
+	my $self = shift;
+	my $client = shift;
+
+	my %args = @_;
+
+	my $cn_table = asset::call_number->table;
+	my $cp_table = asset::copy->table;
+	my $st_table = config::copy_status->table;
+	my $src_table = config::bib_source->table;
+	my $br_table = biblio::record_entry->table;
+	my $loc_table = asset::copy_location->table;
+	my $out_table = actor::org_unit_type->table;
+
+	my $descendants = "actor.org_unit_descendants(u.id)";
+	my $ancestors = "actor.org_unit_ancestors(?) u JOIN $out_table t ON (u.ou_type = t.id)";
+
+    if ($args{org_unit} < 0) {
+        $args{org_unit} *= -1;
+	    $ancestors = "(select org_unit as id from actor.org_lasso_map where lasso = ?) u CROSS JOIN (SELECT -1 AS depth) t";
+    }
+
+	my $visible = 'AND a.opac_visible = TRUE AND st.opac_visible = TRUE AND loc.opac_visible = TRUE AND cp.opac_visible = TRUE';
+	if ($self->api_name =~ /staff/o) {
+		$visible = ''
+	}
+
+	my $sql = <<"	SQL";
+		SELECT	t.depth,
+			u.id AS org_unit,
+			sum(
+				(SELECT count(cp.id)
+				  FROM  $cn_table cn
+					JOIN $cp_table cp ON (cn.id = cp.call_number)
+					JOIN $descendants a ON (cp.circ_lib = a.id)
+					JOIN $st_table st ON (cp.status = st.id)
+					JOIN $loc_table loc ON (cp.location = loc.id)
+				  WHERE cn.record = ?
+					$visible
+				  	AND cn.deleted IS FALSE
+					AND cp.deleted IS FALSE)
+			) AS count,
+			sum(
+				(SELECT count(cp.id)
+				  FROM  $cn_table cn
+					JOIN $cp_table cp ON (cn.id = cp.call_number)
+					JOIN $descendants a ON (cp.circ_lib = a.id)
+					JOIN $st_table st ON (cp.status = st.id)
+					JOIN $loc_table loc ON (cp.location = loc.id)
+				  WHERE cn.record = ?
+					$visible
+				  	AND cn.deleted IS FALSE
+					AND cp.deleted IS FALSE
+				  	AND cp.status IN (0,7,12))
+			) AS available,
+			sum(
+				(SELECT count(cp.id)
+				  FROM  $cn_table cn
+					JOIN $cp_table cp ON (cn.id = cp.call_number)
+					JOIN $st_table st ON (cp.status = st.id)
+					JOIN $loc_table loc ON (cp.location = loc.id)
+				  WHERE cn.record = ?
+					AND st.opac_visible = TRUE
+					AND loc.opac_visible = TRUE
+					AND cp.opac_visible = TRUE
+				  	AND cn.deleted IS FALSE
+					AND cp.deleted IS FALSE)
+			) AS unshadow,
+                        sum(    
+                                (SELECT sum(1)
+                                  FROM	$br_table br
+                                        JOIN $src_table src ON (src.id = br.source)
+                                  WHERE br.id = ?
+                                        AND src.transcendant IS TRUE
+                                )
+                        ) AS transcendant
+		  FROM  $ancestors
+		  GROUP BY 1,2
+	SQL
+
+	my $sth = biblio::record_entry->db_Main->prepare_cached($sql);
+	$sth->execute(''.$args{record}, ''.$args{record}, ''.$args{record}, ''.$args{record}, ''.$args{org_unit});
+	while ( my $row = $sth->fetchrow_hashref ) {
+		$client->respond( $row );
+	}
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.biblio.record_entry.copy_count',
+	method		=> 'record_copy_count',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.biblio.record_entry.copy_count.staff',
+	method		=> 'record_copy_count',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+
+sub record_ranged_tree {
+	my $self = shift;
+	my $client = shift;
+	my $r = shift;
+	my $ou = shift;
+	my $depth = shift;
+	my $limit = shift || 0;
+	my $offset = shift || 0;
+
+	my $ou_sql = defined($depth) ?
+			"SELECT id FROM actor.org_unit_descendants(?,?)":
+			"SELECT id FROM actor.org_unit_descendants(?)";
+
+	my $ou_list =
+		actor::org_unit
+			->db_Main
+			->selectcol_arrayref(
+				$ou_sql,
+				{},
+				$ou,
+				(defined($depth) ? ($depth) : ()),
+			);
+
+	return undef unless ($ou_list and @$ou_list);
+
+	$r = biblio::record_entry->retrieve( $r );
+	return undef unless ($r);
+
+	my $rec = $r->to_fieldmapper;
+	$rec->call_numbers([]);
+
+	$rec->fixed_fields( $r->record_descriptor->next->to_fieldmapper );
+
+	my $offset_count = 0;
+	my $limit_count = 0;
+	for my $cn ( $r->call_numbers  ) {
+		next if ($cn->deleted);
+		my $call_number = $cn->to_fieldmapper;
+		$call_number->copies([]);
+
+
+		for my $cp ( $cn->copies(circ_lib => $ou_list) ) {
+			next if ($cp->deleted);
+			if ($offset > 0 && $offset_count < $offset) {
+				$offset_count++;
+				next;
+			}
+			
+			last if ($limit > 0 && $limit_count >= $limit);
+
+			my $copy = $cp->to_fieldmapper;
+			$copy->status( $cp->status->to_fieldmapper );
+			$copy->location( $cp->location->to_fieldmapper );
+			push @{ $call_number->copies }, $copy;
+
+			$limit_count++;
+		}
+
+		last if ($limit > 0 && $limit_count >= $limit);
+
+		push @{ $rec->call_numbers }, $call_number if (@{ $call_number->copies });
+	}
+
+	return $rec;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.biblio.record_entry.ranged_tree',
+	method		=> 'record_ranged_tree',
+	argc		=> 1,
+	api_level	=> 1,
+);
+
+sub record_by_barcode {
+	my $self = shift;
+	my $client = shift;
+
+	my $cn_table = asset::call_number->table;
+	my $cp_table = asset::copy->table;
+
+	my $id = ''.shift;
+	my ($r) = biblio::record_entry->db_Main->selectrow_array( <<"	SQL", {}, $id );
+		SELECT	cn.record
+		  FROM	$cn_table cn
+		  	JOIN $cp_table cp ON (cp.call_number = cn.id)
+		  WHERE	cp.barcode = ?
+	SQL
+
+	my $rec = biblio::record_entry->retrieve( $r );
+
+	return $rec->to_fieldmapper if ($rec);
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.biblio.record_entry.retrieve_by_barcode',
+	method		=> 'record_by_barcode',
+	api_level	=> 1,
+	cachable	=> 1,
+);
+
+sub record_by_copy {
+	my $self = shift;
+	my $client = shift;
+
+	my $cn_table = asset::call_number->table;
+	my $cp_table = asset::copy->table;
+
+	my $id = ''.shift;
+	my ($r) = biblio::record_entry->db_Main->selectrow_array( <<"	SQL", {}, $id );
+		SELECT	cn.record
+		  FROM	$cn_table cn
+		  	JOIN $cp_table cp ON (cp.call_number = cn.id)
+		  WHERE	cp.id = ?
+	SQL
+
+	my $rec = biblio::record_entry->retrieve( $r );
+	return undef unless ($rec);
+
+	my $r_fm = $rec->to_fieldmapper;
+	my $ff = $rec->record_descriptor->next;
+	$r_fm->fixed_fields( $ff->to_fieldmapper ) if ($ff);
+
+	return $r_fm;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.fleshed.biblio.record_entry.retrieve_by_copy',
+	method		=> 'record_by_copy',
+	api_level	=> 1,
+	cachable	=> 1,
+);
+
+
+=comment Old version
+
+my $org_unit_lookup;
+sub record_copy_count {
+	my $self = shift;
+	my $client = shift;
+	my $oid = shift;
+	my @recs = @_;
+
+	if ($self->api_name !~ /batch/o) {
+		@recs = ($recs[0]);
+	}
+
+	throw OpenSRF::EX::InvalidArg ( "No org_unit id passed!" )
+		unless ($oid);
+
+	throw OpenSRF::EX::InvalidArg ( "No record id passed!" )
+		unless (@recs);
+
+	$org_unit_lookup ||= $self->method_lookup('open-ils.storage.direct.actor.org_unit.retrieve');
+	my ($org_unit) = $org_unit_lookup->run($oid);
+
+	# XXX Use descendancy tree here!!!
+	my $short_name_hack = $org_unit->shortname;
+	$short_name_hack = '' if (!$org_unit->parent_ou);
+	$short_name_hack .= '%';
+	# XXX Use descendancy tree here!!!
+
+	my $rec_list = join(',',@recs);
+
+	my $cp_table = asset::copy->table;
+	my $cn_table = asset::call_number->table;
+
+	my $select =<<"	SQL";
+		SELECT	count(cp.*) as copies
+		  FROM	$cn_table cn
+			JOIN $cp_table cp ON (cp.call_number = cn.id)
+		  WHERE	cn.owning_lib LIKE ? AND
+		  	cn.record IN ($rec_list)
+	SQL
+
+	my $sth = asset::copy->db_Main->prepare_cached($select);
+	$sth->execute($short_name_hack);
+
+	my $results = $sth->fetchall_hashref('record');
+
+	$client->respond($$results{$_}{copies} || 0) for (@recs);
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	method		=> 'record_copy_count',
+	api_name	=> 'open-ils.storage.direct.biblio.record_copy_count',
+	api_level	=> 1,
+	argc		=> 1,
+);
+__PACKAGE__->register_method(
+	method		=> 'record_copy_count',
+	api_name	=> 'open-ils.storage.direct.biblio.record_copy_count.batch',
+	api_level	=> 1,
+	argc		=> 1,
+	stream		=> 1,
+);
+
+=cut
+
+sub global_record_copy_count {
+	my $self = shift;
+	my $client = shift;
+
+	my $rec = shift;
+
+	my $cn_table = asset::call_number->table;
+	my $cp_table = asset::copy->table;
+	my $cl_table = asset::copy_location->table;
+	my $cs_table = config::copy_status->table;
+
+	my $copies_visible = 'AND cp.opac_visible IS TRUE AND cs.opac_visible IS TRUE AND cl.opac_visible IS TRUE';
+	$copies_visible = '' if ($self->api_name =~ /staff/o);
+
+	my $sql = <<"	SQL";
+
+		SELECT	owning_lib, sum(avail), sum(tot)
+ 		  FROM	(
+        			SELECT	cn.owning_lib, count(cp.id) as avail, 0 as tot
+				  FROM	$cn_table cn
+					JOIN $cp_table cp ON (cn.id = cp.call_number)
+					JOIN $cs_table cs ON (cs.id = cp.status)
+					JOIN $cl_table cl ON (cl.id = cp.location)
+				  WHERE	cn.record = ?
+				  	AND cp.status IN (0,7,12)
+				  	$copies_visible
+				  GROUP BY 1
+                        			UNION
+        			SELECT	cn.owning_lib, 0 as avail, count(cp.id) as tot
+				  FROM	$cn_table cn
+					JOIN $cp_table cp ON (cn.id = cp.call_number)
+					JOIN $cs_table cs ON (cs.id = cp.status)
+					JOIN $cl_table cl ON (cl.id = cp.location)
+				  WHERE	cn.record = ?
+				  	$copies_visible
+				  GROUP BY 1
+			) x
+		  GROUP BY 1
+	SQL
+
+	my $sth = biblio::record_entry->db_Main->prepare_cached($sql);
+	$sth->execute("$rec", "$rec");
+
+	$client->respond( $_ ) for (@{$sth->fetchall_arrayref});
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.biblio.record_entry.global_copy_count',
+	method		=> 'global_record_copy_count',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.biblio.record_entry.global_copy_count.staff',
+	method		=> 'global_record_copy_count',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+
+sub record_copy_status_count {
+	my $self = shift;
+	my $client = shift;
+
+	my $rec = shift;
+	my $ou = shift || 1;
+	my $depth = shift || 0;
+
+
+	my $descendants = "actor.org_unit_descendants(?,?)";
+
+	my $cn_table = asset::call_number->table;
+	my $cp_table = asset::copy->table;
+	my $cl_table = asset::copy_location->table;
+	my $cs_table = config::copy_status->table;
+
+	my $sql = <<"	SQL";
+
+		SELECT	cp.circ_lib, cn.label, cp.status, count(cp.id)
+		  FROM	$cp_table cp,
+		  	$cn_table cn,
+			$cl_table cl,
+			$cs_table cs,
+			$descendants d
+		  WHERE	cn.record = ?
+		  	AND cp.call_number = cn.id
+		  	AND cp.location = cl.id
+			AND cp.circ_lib = d.id
+		  	AND cp.status = cs.id
+			AND cl.opac_visible IS TRUE
+			AND cp.opac_visible IS TRUE
+			AND cp.deleted IS FALSE
+			AND cs.opac_visible IS TRUE
+		  GROUP BY 1,2,3;
+	SQL
+
+	my $sth = biblio::record_entry->db_Main->prepare_cached($sql);
+	$sth->execute($ou, $depth, "$rec" );
+
+	my %data = ();
+	for my $row (@{$sth->fetchall_arrayref}) {
+		$data{$$row[0]}{$$row[1]}{$$row[2]} += $$row[3];
+	}
+	
+	for my $ou (keys %data) {
+		for my $cn (keys %{$data{$ou}}) {
+			$client->respond( [$ou, $cn, $data{$ou}{$cn}] );
+		}
+	}
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.biblio.record_entry.status_copy_count',
+	method		=> 'record_copy_status_count',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+
+
+sub record_copy_status_location_count {
+	my $self = shift;
+	my $client = shift;
+
+	my $rec = shift;
+	my $ou = shift || 1;
+	my $depth = shift || 0;
+
+
+	my $descendants = "actor.org_unit_descendants(?,?)";
+
+	my $cn_table = asset::call_number->table;
+	my $cp_table = asset::copy->table;
+	my $cl_table = asset::copy_location->table;
+	my $cs_table = config::copy_status->table;
+
+	# FIXME using oils_i18n_xlate here is exposing a hitherto unexposed
+	# implementation detail of json_query; doing it this way because
+	# json_query currently doesn't grok joining a function to tables
+	my $sql = <<"	SQL";
+
+		SELECT	cp.circ_lib,
+				cn.label, 
+				oils_i18n_xlate('asset.copy_location', 'acpl', 'name', 'id', cl.id::TEXT, ?),
+				cp.status,
+				count(cp.id)
+		  FROM	$cp_table cp,
+		  	$cn_table cn,
+			$cl_table cl,
+			$cs_table cs,
+			$descendants d
+		  WHERE	cn.record = ?
+		  	AND cp.call_number = cn.id
+		  	AND cp.location = cl.id
+			AND cp.circ_lib = d.id
+		  	AND cp.status = cs.id
+			AND cl.opac_visible IS TRUE
+			AND cp.opac_visible IS TRUE
+			AND cp.deleted IS FALSE
+			AND cs.opac_visible IS TRUE
+		  GROUP BY 1,2,3,4;
+	SQL
+
+	my $sth = biblio::record_entry->db_Main->prepare_cached($sql);
+	my $ses_locale = $client->session ? $client->session->session_locale : 'en-US';
+	$sth->execute($ses_locale, $ou, $depth, "$rec" );
+
+	my %data = ();
+	for my $row (@{$sth->fetchall_arrayref}) {
+		$data{$$row[0]}{$$row[1]}{$$row[2]}{$$row[3]} += $$row[4];
+	}
+	
+	for my $ou (keys %data) {
+		for my $cn (keys %{$data{$ou}}) {
+		    for my $cl (keys %{$data{$ou}{$cn}}) {
+    			$client->respond( [$ou, $cn, $cl, $data{$ou}{$cn}{$cl}] );
+            }
+		}
+	}
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.biblio.record_entry.status_copy_location_count',
+	method		=> 'record_copy_status_location_count',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/config.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/config.pm
new file mode 100644
index 0000000000..33644ce437
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/config.pm
@@ -0,0 +1,81 @@
+package OpenILS::Application::Storage::Publisher::config;
+use base qw/OpenILS::Application::Storage/;
+use OpenILS::Application::Storage::CDBI::config;
+
+
+sub retrieve_all {
+	my $self = shift;
+	my $client = shift;
+
+	$self->api_name =~ /direct\.config\.(.+)\.retrieve/o;
+	
+	my $class = 'config::'.$1;
+	for my $rec ( $class->retrieve_all ) {
+		$client->respond( $rec->to_fieldmapper );
+	}
+
+	return undef;
+}
+
+for my $class (
+		qw/metabib_field standing identification_type copy_status
+		   non_cataloged_type audience_map item_form_map item_type_map
+		   language_map lit_form_map bib_source net_access_level/ ) {
+
+	__PACKAGE__->register_method(
+		method		=> 'retrieve_all',
+		api_name	=> "open-ils.storage.direct.config.$class.retrieve.all",
+		argc		=> 0,
+		stream		=> 1,
+	);
+}
+
+
+# XXX arg, with the descendancy SPs...
+sub ranged_config_non_cat {
+	my $self = shift;
+	my $client = shift;
+	my @binds = @_;
+
+	my $ctable = config::non_cataloged_type->table;
+
+	my $descendants = defined($binds[1]) ?
+		"actor.org_unit_full_path(?, ?)" :
+		"actor.org_unit_full_path(?)" ;
+
+
+	my $sql = <<"	SQL";
+		SELECT	DISTINCT c.*
+		  FROM	$ctable c
+		  	JOIN $descendants d
+				ON (d.id = c.owning_lib)
+	SQL
+
+	my $sth = config::non_cataloged_type->db_Main->prepare($sql);
+	$sth->execute(@binds);
+
+	while ( my $rec = $sth->fetchrow_hashref ) {
+
+		my $cnct = new Fieldmapper::config::non_cataloged_type;
+		$cnct->name($rec->{name});
+		$cnct->owning_lib($rec->{owning_lib});
+		$cnct->id($rec->{id});
+		$cnct->circ_duration($rec->{circ_duration});
+		$cnct->in_house($rec->{in_house});
+
+		$client->respond( $cnct );
+	}
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	method		=> 'ranged_config_non_cat',
+	api_name	=> 'open-ils.storage.ranged.config.non_cataloged_type.retrieve',
+	argc		=> 1,
+	stream		=> 1,
+	notes		=> <<"	NOTES",
+		Returns 
+	NOTES
+);
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/container.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/container.pm
new file mode 100644
index 0000000000..fe60ee6336
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/container.pm
@@ -0,0 +1,6 @@
+package OpenILS::Application::Storage::Publisher::container;
+use base qw/OpenILS::Application::Storage/;
+#use OpenILS::Application::Storage::CDBI::config;
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/metabib.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/metabib.pm
new file mode 100644
index 0000000000..c70b5cd0ea
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/metabib.pm
@@ -0,0 +1,3192 @@
+package OpenILS::Application::Storage::Publisher::metabib;
+use base qw/OpenILS::Application::Storage::Publisher/;
+use vars qw/$VERSION/;
+use OpenSRF::EX qw/:try/;
+use OpenILS::Application::Storage::FTS;
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::Logger qw/:level/;
+use OpenSRF::Utils::Cache;
+use OpenSRF::Utils::JSON;
+use Data::Dumper;
+use Digest::MD5 qw/md5_hex/;
+
+
+my $log = 'OpenSRF::Utils::Logger';
+
+$VERSION = 1;
+
+sub ordered_records_from_metarecord {
+	my $self = shift;
+	my $client = shift;
+	my $mr = shift;
+	my $formats = shift;
+	my $org = shift || 1;
+	my $depth = shift;
+
+	my (@types,@forms,@blvl);
+
+	if ($formats) {
+		my ($t, $f, $b) = split '-', $formats;
+		@types = split '', $t;
+		@forms = split '', $f;
+		@blvl = split '', $b;
+	}
+
+	my $descendants =
+		defined($depth) ?
+			"actor.org_unit_descendants($org, $depth)" :
+			"actor.org_unit_descendants($org)" ;
+
+
+	my $copies_visible = 'AND d.opac_visible IS TRUE AND cp.opac_visible IS TRUE AND cs.opac_visible IS TRUE AND cl.opac_visible IS TRUE';
+	$copies_visible = '' if ($self->api_name =~ /staff/o);
+
+	my $sm_table = metabib::metarecord_source_map->table;
+	my $rd_table = metabib::record_descriptor->table;
+	my $fr_table = metabib::full_rec->table;
+	my $cn_table = asset::call_number->table;
+	my $cl_table = asset::copy_location->table;
+	my $cp_table = asset::copy->table;
+	my $cs_table = config::copy_status->table;
+	my $src_table = config::bib_source->table;
+	my $out_table = actor::org_unit_type->table;
+	my $br_table = biblio::record_entry->table;
+
+	my $sql = <<"	SQL";
+		SELECT	record,
+			item_type,
+			item_form,
+			quality,
+			FIRST(COALESCE(LTRIM(SUBSTR( value, COALESCE(SUBSTRING(ind2 FROM E'\\\\d+'),'0')::INT + 1 )),'zzzzzzzz')) AS title
+		FROM	(
+			SELECT	rd.record,
+				rd.item_type,
+				rd.item_form,
+				br.quality,
+				fr.tag,
+				fr.subfield,
+				fr.value,
+				fr.ind2
+	SQL
+
+	if ($copies_visible) {
+		$sql .= <<"		SQL";
+	  		  FROM	$sm_table sm,
+				$br_table br,
+				$fr_table fr,
+				$rd_table rd
+		  	  WHERE	rd.record = sm.source
+				AND fr.record = sm.source
+		  		AND br.id = sm.source
+				AND sm.metarecord = ?
+                        	AND (EXISTS ((SELECT	1
+						FROM	$cp_table cp
+							JOIN $cn_table cn ON (cp.call_number = cn.id)
+				       			JOIN $cs_table cs ON (cp.status = cs.id)
+				       			JOIN $cl_table cl ON (cp.location = cl.id)
+							JOIN $descendants d ON (cp.circ_lib = d.id)
+						WHERE	cn.record = sm.source
+		                                	$copies_visible
+						LIMIT 1))
+					OR EXISTS ((
+					    SELECT	1
+					      FROM	$src_table src
+					      WHERE	src.id = br.source
+					      		AND src.transcendant IS TRUE))
+				)
+					  
+		SQL
+	} else {
+		$sql .= <<"		SQL";
+			  FROM	$sm_table sm
+				JOIN $br_table br ON (sm.source = br.id)
+				JOIN $fr_table fr ON (fr.record = br.id)
+				JOIN $rd_table rd ON (rd.record = br.id)
+			  WHERE	sm.metarecord = ?
+				AND ((	EXISTS (
+						SELECT	1
+						  FROM	$cp_table cp,
+							$cn_table cn,
+							$descendants d
+						  WHERE	cn.record = br.id
+							AND cn.deleted = FALSE
+							AND cp.deleted = FALSE
+							AND cp.circ_lib = d.id
+							AND cn.id = cp.call_number
+						  LIMIT 1
+					) OR NOT EXISTS (
+						SELECT	1
+						  FROM	$cp_table cp,
+							$cn_table cn
+						  WHERE	cn.record = br.id
+							AND cn.deleted = FALSE
+							AND cp.deleted = FALSE
+							AND cn.id = cp.call_number
+						  LIMIT 1
+					))
+					OR EXISTS ((
+					    SELECT	1
+					      FROM	$src_table src
+					      WHERE	src.id = br.source
+					      		AND src.transcendant IS TRUE))
+				)
+		SQL
+	}
+
+	if (@types) {
+		$sql .= '				AND rd.item_type IN ('.join(',',map{'?'}@types).')';
+	}
+
+	if (@forms) {
+		$sql .= '				AND rd.item_form IN ('.join(',',map{'?'}@forms).')';
+	}
+
+	if (@blvl) {
+		$sql .= '				AND rd.bib_level IN ('.join(',',map{'?'}@blvl).')';
+	}
+
+
+
+	$sql .= <<"	SQL";
+	  		  OFFSET 0
+			) AS x
+	  WHERE	tag = '245'
+	  	AND subfield = 'a'
+	  GROUP BY record, item_type, item_form, quality
+	  ORDER BY
+		CASE
+			WHEN item_type IS NULL -- default
+				THEN 0
+			WHEN item_type = '' -- default
+				THEN 0
+			WHEN item_type IN ('a','t') -- books
+				THEN 1
+			WHEN item_type = 'g' -- movies
+				THEN 2
+			WHEN item_type IN ('i','j') -- sound recordings
+				THEN 3
+			WHEN item_type = 'm' -- software
+				THEN 4
+			WHEN item_type = 'k' -- images
+				THEN 5
+			WHEN item_type IN ('e','f') -- maps
+				THEN 6
+			WHEN item_type IN ('o','p') -- mixed
+				THEN 7
+			WHEN item_type IN ('c','d') -- music
+				THEN 8
+			WHEN item_type = 'r' -- 3d
+				THEN 9
+		END,
+		title ASC,
+		quality DESC
+	SQL
+
+	my $ids = metabib::metarecord_source_map->db_Main->selectcol_arrayref($sql, {}, "$mr", @types, @forms, @blvl);
+	return $ids if ($self->api_name =~ /atomic$/o);
+
+	$client->respond( $_ ) for ( @$ids );
+	return undef;
+
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.ordered.metabib.metarecord.records',
+	method		=> 'ordered_records_from_metarecord',
+	api_level	=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.ordered.metabib.metarecord.records.staff',
+	method		=> 'ordered_records_from_metarecord',
+	api_level	=> 1,
+	cachable	=> 1,
+);
+
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.ordered.metabib.metarecord.records.atomic',
+	method		=> 'ordered_records_from_metarecord',
+	api_level	=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.ordered.metabib.metarecord.records.staff.atomic',
+	method		=> 'ordered_records_from_metarecord',
+	api_level	=> 1,
+	cachable	=> 1,
+);
+
+sub isxn_search {
+	my $self = shift;
+	my $client = shift;
+	my $isxn = lc(shift());
+
+	$isxn =~ s/^\s*//o;
+	$isxn =~ s/\s*$//o;
+	$isxn =~ s/-//o if ($self->api_name =~ /isbn/o);
+
+	my $tag = ($self->api_name =~ /isbn/o) ? "'020' OR f.tag = '024'" : "'022'";
+
+	my $fr_table = metabib::full_rec->table;
+	my $bib_table = biblio::record_entry->table;
+
+	my $sql = <<"	SQL";
+		SELECT	DISTINCT f.record
+		  FROM	$fr_table f
+			JOIN $bib_table b ON (b.id = f.record)
+		  WHERE	(f.tag = $tag)
+			AND f.value LIKE ?
+			AND b.deleted IS FALSE
+	SQL
+
+	my $list = metabib::full_rec->db_Main->selectcol_arrayref($sql, {}, "$isxn%");
+	$client->respond($_) for (@$list);
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.id_list.biblio.record_entry.search.isbn',
+	method		=> 'isxn_search',
+	api_level	=> 1,
+	stream		=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.id_list.biblio.record_entry.search.issn',
+	method		=> 'isxn_search',
+	api_level	=> 1,
+	stream		=> 1,
+);
+
+sub metarecord_copy_count {
+	my $self = shift;
+	my $client = shift;
+
+	my %args = @_;
+
+	my $sm_table = metabib::metarecord_source_map->table;
+	my $rd_table = metabib::record_descriptor->table;
+	my $cn_table = asset::call_number->table;
+	my $cp_table = asset::copy->table;
+	my $br_table = biblio::record_entry->table;
+	my $src_table = config::bib_source->table;
+	my $cl_table = asset::copy_location->table;
+	my $cs_table = config::copy_status->table;
+	my $out_table = actor::org_unit_type->table;
+
+	my $descendants = "actor.org_unit_descendants(u.id)";
+	my $ancestors = "actor.org_unit_ancestors(?) u JOIN $out_table t ON (u.ou_type = t.id)";
+
+    if ($args{org_unit} < 0) {
+        $args{org_unit} *= -1;
+        $ancestors = "(select org_unit as id from actor.org_lasso_map where lasso = ?) u CROSS JOIN (SELECT -1 AS depth) t";
+    }
+
+	my $copies_visible = 'AND a.opac_visible IS TRUE AND cp.opac_visible IS TRUE AND cs.opac_visible IS TRUE AND cl.opac_visible IS TRUE';
+	$copies_visible = '' if ($self->api_name =~ /staff/o);
+
+	my (@types,@forms,@blvl);
+	my ($t_filter, $f_filter, $b_filter) = ('','','');
+
+	if ($args{format}) {
+		my ($t, $f, $b) = split '-', $args{format};
+		@types = split '', $t;
+		@forms = split '', $f;
+		@blvl = split '', $b;
+
+		if (@types) {
+			$t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')';
+		}
+
+		if (@forms) {
+			$f_filter .= ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')';
+		}
+
+		if (@blvl) {
+			$b_filter .= ' AND rd.bib_level IN ('.join(',',map{'?'}@blvl).')';
+		}
+	}
+
+	my $sql = <<"	SQL";
+		SELECT	t.depth,
+			u.id AS org_unit,
+			sum(
+				(SELECT count(cp.id)
+				  FROM  $sm_table r
+					JOIN $cn_table cn ON (cn.record = r.source)
+					JOIN $rd_table rd ON (cn.record = rd.record)
+					JOIN $cp_table cp ON (cn.id = cp.call_number)
+			       		JOIN $cs_table cs ON (cp.status = cs.id)
+			       		JOIN $cl_table cl ON (cp.location = cl.id)
+					JOIN $descendants a ON (cp.circ_lib = a.id)
+				  WHERE r.metarecord = ?
+				  	AND cn.deleted IS FALSE
+				  	AND cp.deleted IS FALSE
+				  	$copies_visible
+					$t_filter
+					$f_filter
+					$b_filter
+				)
+			) AS count,
+			sum(
+				(SELECT count(cp.id)
+				  FROM  $sm_table r
+					JOIN $cn_table cn ON (cn.record = r.source)
+					JOIN $rd_table rd ON (cn.record = rd.record)
+					JOIN $cp_table cp ON (cn.id = cp.call_number)
+			       		JOIN $cs_table cs ON (cp.status = cs.id)
+			       		JOIN $cl_table cl ON (cp.location = cl.id)
+					JOIN $descendants a ON (cp.circ_lib = a.id)
+				  WHERE r.metarecord = ?
+				  	AND cp.status IN (0,7,12)
+				  	AND cn.deleted IS FALSE
+				  	AND cp.deleted IS FALSE
+					$copies_visible
+					$t_filter
+					$f_filter
+					$b_filter
+				)
+			) AS available,
+			sum(
+				(SELECT count(cp.id)
+				  FROM  $sm_table r
+					JOIN $cn_table cn ON (cn.record = r.source)
+					JOIN $rd_table rd ON (cn.record = rd.record)
+					JOIN $cp_table cp ON (cn.id = cp.call_number)
+			       		JOIN $cs_table cs ON (cp.status = cs.id)
+			       		JOIN $cl_table cl ON (cp.location = cl.id)
+				  WHERE r.metarecord = ?
+				  	AND cn.deleted IS FALSE
+				  	AND cp.deleted IS FALSE
+					AND cp.opac_visible IS TRUE
+					AND cs.opac_visible IS TRUE
+					AND cl.opac_visible IS TRUE
+					$t_filter
+					$f_filter
+					$b_filter
+				)
+			) AS unshadow,
+			sum(	
+				(SELECT sum(1)
+				  FROM  $sm_table r
+			       		JOIN $br_table br ON (br.id = r.source)
+			       		JOIN $src_table src ON (src.id = br.source)
+				  WHERE r.metarecord = ?
+				  	AND src.transcendant IS TRUE
+				)
+			) AS transcendant
+
+		  FROM  $ancestors
+		  GROUP BY 1,2
+	SQL
+
+	my $sth = metabib::metarecord_source_map->db_Main->prepare_cached($sql);
+	$sth->execute(	''.$args{metarecord},
+			@types, 
+			@forms,
+			@blvl,
+			''.$args{metarecord},
+			@types, 
+			@forms,
+			@blvl,
+			''.$args{metarecord},
+			@types, 
+			@forms,
+			@blvl,
+			''.$args{metarecord},
+			''.$args{org_unit}, 
+	); 
+
+	while ( my $row = $sth->fetchrow_hashref ) {
+		$client->respond( $row );
+	}
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.metabib.metarecord.copy_count',
+	method		=> 'metarecord_copy_count',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.metabib.metarecord.copy_count.staff',
+	method		=> 'metarecord_copy_count',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+
+sub biblio_multi_search_full_rec {
+    my $self   = shift;
+    my $client = shift;
+    my %args   = @_;
+
+    my $class_join = $args{class_join} || 'AND';
+    my $limit      = $args{limit}      || 100;
+    my $offset     = $args{offset}     || 0;
+    my $sort       = $args{'sort'};
+    my $sort_dir   = $args{sort_dir}   || 'DESC';
+
+	my @binds;
+	my @selects;
+
+	for my $arg (@{ $args{searches} }) {
+		my $term     = $$arg{term};
+		my $limiters = $$arg{restrict};
+
+		my ($index_col)  = metabib::full_rec->columns('FTS');
+		$index_col ||= 'value';
+		my $search_table = metabib::full_rec->table;
+
+		my $fts = OpenILS::Application::Storage::FTS->compile('default' => $term, 'value',"$index_col");
+
+		my $fts_where = $fts->sql_where_clause();
+		my @fts_ranks = $fts->fts_rank;
+
+		my $rank = join(' + ', @fts_ranks);
+
+		my @wheres;
+		for my $limit (@$limiters) {
+			if ($$limit{tag} =~ /^\d+$/ and $$limit{tag} < 10) {
+				# MARC control field; mfr.subfield is NULL
+				push @wheres, "( tag = ? AND $fts_where )";
+				push @binds, $$limit{tag};
+ 				$log->debug("Limiting query using { tag => $$limit{tag} }", DEBUG);
+			} else {
+				push @wheres, "( tag = ? AND subfield LIKE ? AND $fts_where )";
+				push @binds, $$limit{tag}, $$limit{subfield};
+ 				$log->debug("Limiting query using { tag => $$limit{tag}, subfield => $$limit{subfield} }", DEBUG);
+			}
+		}
+		my $where = join(' OR ', @wheres);
+
+		push @selects, "SELECT id, record, $rank as sum FROM $search_table WHERE $where";
+
+	}
+
+	my $descendants = defined($args{depth}) ?
+				"actor.org_unit_descendants($args{org_unit}, $args{depth})" :
+				"actor.org_unit_descendants($args{org_unit})" ;
+
+
+	my $metabib_record_descriptor = metabib::record_descriptor->table;
+	my $metabib_full_rec = metabib::full_rec->table;
+	my $asset_call_number_table = asset::call_number->table;
+	my $asset_copy_table = asset::copy->table;
+	my $cs_table = config::copy_status->table;
+	my $cl_table = asset::copy_location->table;
+	my $br_table = biblio::record_entry->table;
+
+	my $cj = 'HAVING COUNT(x.id) = ' . scalar(@selects) if ($class_join eq 'AND');
+	my $search_table =
+		'(SELECT x.record, sum(x.sum) FROM (('.
+			join(') UNION ALL (', @selects).
+			")) x GROUP BY 1 $cj ORDER BY 2 DESC )";
+
+	my $has_vols = 'AND cn.owning_lib = d.id';
+	my $has_copies = 'AND cp.call_number = cn.id';
+	my $copies_visible = 'AND d.opac_visible IS TRUE AND cp.opac_visible IS TRUE AND cs.opac_visible IS TRUE AND cl.opac_visible IS TRUE';
+
+	if ($self->api_name =~ /staff/o) {
+		$copies_visible = '';
+		$has_copies     = '' if ($ou_type == 0);
+		$has_vols       = '' if ($ou_type == 0);
+	}
+
+	my ($t_filter, $f_filter) = ('','');
+	my ($a_filter, $l_filter, $lf_filter) = ('','','');
+
+	if (my $a = $args{audience}) {
+		$a = [$a] if (!ref($a));
+		my @aud = @$a;
+			
+		$a_filter = ' AND rd.audience IN ('.join(',',map{'?'}@aud).')';
+		push @binds, @aud;
+	}
+
+	if (my $l = $args{language}) {
+		$l = [$l] if (!ref($l));
+		my @lang = @$l;
+
+		$l_filter = ' AND rd.item_lang IN ('.join(',',map{'?'}@lang).')';
+		push @binds, @lang;
+	}
+
+	if (my $f = $args{lit_form}) {
+		$f = [$f] if (!ref($f));
+		my @lit_form = @$f;
+
+		$lf_filter = ' AND rd.lit_form IN ('.join(',',map{'?'}@lit_form).')';
+		push @binds, @lit_form;
+	}
+
+	if (my $f = $args{item_form}) {
+		$f = [$f] if (!ref($f));
+		my @forms = @$f;
+
+		$f_filter = ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')';
+		push @binds, @forms;
+	}
+
+	if (my $t = $args{item_type}) {
+		$t = [$t] if (!ref($t));
+		my @types = @$t;
+
+		$t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')';
+		push @binds, @types;
+	}
+
+
+	if ($args{format}) {
+		my ($t, $f) = split '-', $args{format};
+		my @types = split '', $t;
+		my @forms = split '', $f;
+		if (@types) {
+			$t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')';
+		}
+
+		if (@forms) {
+			$f_filter .= ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')';
+		}
+		push @binds, @types, @forms;
+	}
+
+	my $relevance = 'sum(f.sum)';
+	$relevance = 1 if (!$copies_visible);
+
+	my $rank = $relevance;
+	if (lc($sort) eq 'pubdate') {
+		$rank = <<"		RANK";
+			( FIRST ((
+				SELECT	COALESCE(SUBSTRING(frp.value FROM E'\\\\d+'),'9999')::INT
+				  FROM	$metabib_full_rec frp
+				  WHERE	frp.record = f.record
+				  	AND frp.tag = '260'
+					AND frp.subfield = 'c'
+				  LIMIT 1
+			)) )
+		RANK
+	} elsif (lc($sort) eq 'create_date') {
+		$rank = <<"		RANK";
+			( FIRST (( SELECT create_date FROM $br_table rbr WHERE rbr.id = f.record)) )
+		RANK
+	} elsif (lc($sort) eq 'edit_date') {
+		$rank = <<"		RANK";
+			( FIRST (( SELECT edit_date FROM $br_table rbr WHERE rbr.id = f.record)) )
+		RANK
+	} elsif (lc($sort) eq 'title') {
+		$rank = <<"		RANK";
+			( FIRST ((
+				SELECT	COALESCE(LTRIM(SUBSTR( frt.value, COALESCE(SUBSTRING(frt.ind2 FROM E'\\\\d+'),'0')::INT + 1 )),'zzzzzzzz')
+				  FROM	$metabib_full_rec frt
+				  WHERE	frt.record = f.record
+				  	AND frt.tag = '245'
+					AND frt.subfield = 'a'
+				  LIMIT 1
+			)) )
+		RANK
+	} elsif (lc($sort) eq 'author') {
+		$rank = <<"		RANK";
+			( FIRST((
+				SELECT	COALESCE(LTRIM(fra.value),'zzzzzzzz')
+				  FROM	$metabib_full_rec fra
+				  WHERE	fra.record = f.record
+				  	AND fra.tag LIKE '1%'
+					AND fra.subfield = 'a'
+				  ORDER BY fra.tag::text::int
+				  LIMIT 1
+			)) )
+		RANK
+	} else {
+		$sort = undef;
+	}
+
+
+	if ($copies_visible) {
+		$select = <<"		SQL";
+			SELECT	f.record, $relevance, count(DISTINCT cp.id), $rank
+	  	  	FROM	$search_table f,
+				$asset_call_number_table cn,
+				$asset_copy_table cp,
+				$cs_table cs,
+				$cl_table cl,
+				$br_table br,
+				$metabib_record_descriptor rd,
+				$descendants d
+	  	  	WHERE	br.id = f.record
+				AND cn.record = f.record
+				AND rd.record = f.record
+				AND cp.status = cs.id
+				AND cp.location = cl.id
+				AND br.deleted IS FALSE
+				AND cn.deleted IS FALSE
+				AND cp.deleted IS FALSE
+				$has_vols
+				$has_copies
+				$copies_visible
+				$t_filter
+				$f_filter
+				$a_filter
+				$l_filter
+				$lf_filter
+	  	  	GROUP BY f.record HAVING count(DISTINCT cp.id) > 0
+	  	  	ORDER BY 4 $sort_dir,3 DESC
+		SQL
+	} else {
+		$select = <<"		SQL";
+			SELECT	f.record, 1, 1, $rank
+	  	  	FROM	$search_table f,
+				$br_table br,
+				$metabib_record_descriptor rd
+	  	  	WHERE	br.id = f.record
+				AND rd.record = f.record
+				AND br.deleted IS FALSE
+				$t_filter
+				$f_filter
+				$a_filter
+				$l_filter
+				$lf_filter
+	  	  	GROUP BY 1,2,3 
+	  	  	ORDER BY 4 $sort_dir
+		SQL
+	}
+
+
+	$log->debug("Search SQL :: [$select]",DEBUG);
+
+	my $recs = metabib::full_rec->db_Main->selectall_arrayref("$select;", {}, @binds);
+	$log->debug("Search yielded ".scalar(@$recs)." results.",DEBUG);
+
+	my $max = 0;
+	$max = 1 if (!@$recs);
+	for (@$recs) {
+		$max = $$_[1] if ($$_[1] > $max);
+	}
+
+	my $count = @$recs;
+	for my $rec (@$recs[$offset .. $offset + $limit - 1]) {
+		next unless ($$rec[0]);
+		my ($rid,$rank,$junk,$skip) = @$rec;
+		$client->respond( [$rid, sprintf('%0.3f',$rank/$max), $count] );
+	}
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.biblio.full_rec.multi_search',
+	method		=> 'biblio_multi_search_full_rec',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.biblio.full_rec.multi_search.staff',
+	method		=> 'biblio_multi_search_full_rec',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+
+sub search_full_rec {
+	my $self = shift;
+	my $client = shift;
+
+	my %args = @_;
+	
+	my $term = $args{term};
+	my $limiters = $args{restrict};
+
+	my ($index_col) = metabib::full_rec->columns('FTS');
+	$index_col ||= 'value';
+	my $search_table = metabib::full_rec->table;
+
+	my $fts = OpenILS::Application::Storage::FTS->compile('default' => $term, 'value',"$index_col");
+
+	my $fts_where = $fts->sql_where_clause();
+	my @fts_ranks = $fts->fts_rank;
+
+	my $rank = join(' + ', @fts_ranks);
+
+	my @binds;
+	my @wheres;
+	for my $limit (@$limiters) {
+		if ($$limit{tag} =~ /^\d+$/ and $$limit{tag} < 10) {
+			# MARC control field; mfr.subfield is NULL
+			push @wheres, "( tag = ? AND $fts_where )";
+			push @binds, $$limit{tag};
+ 			$log->debug("Limiting query using { tag => $$limit{tag} }", DEBUG);
+		} else {
+			push @wheres, "( tag = ? AND subfield LIKE ? AND $fts_where )";
+			push @binds, $$limit{tag}, $$limit{subfield};
+ 			$log->debug("Limiting query using { tag => $$limit{tag}, subfield => $$limit{subfield} }", DEBUG);
+		}
+	}
+	my $where = join(' OR ', @wheres);
+
+	my $select = "SELECT record, sum($rank) FROM $search_table WHERE $where GROUP BY 1 ORDER BY 2 DESC;";
+
+	$log->debug("Search SQL :: [$select]",DEBUG);
+
+	my $recs = metabib::full_rec->db_Main->selectall_arrayref($select, {}, @binds);
+	$log->debug("Search yielded ".scalar(@$recs)." results.",DEBUG);
+
+	$client->respond($_) for (@$recs);
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.direct.metabib.full_rec.search_fts.value',
+	method		=> 'search_full_rec',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> 'open-ils.storage.direct.metabib.full_rec.search_fts.index_vector',
+	method		=> 'search_full_rec',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+
+
+# XXX factored most of the PG dependant stuff out of here... need to find a way to do "dependants".
+sub search_class_fts {
+	my $self = shift;
+	my $client = shift;
+	my %args = @_;
+	
+	my $term = $args{term};
+	my $ou = $args{org_unit};
+	my $ou_type = $args{depth};
+	my $limit = $args{limit};
+	my $offset = $args{offset};
+
+	my $limit_clause = '';
+	my $offset_clause = '';
+
+	$limit_clause = "LIMIT $limit" if (defined $limit and int($limit) > 0);
+	$offset_clause = "OFFSET $offset" if (defined $offset and int($offset) > 0);
+
+	my (@types,@forms);
+	my ($t_filter, $f_filter) = ('','');
+
+	if ($args{format}) {
+		my ($t, $f) = split '-', $args{format};
+		@types = split '', $t;
+		@forms = split '', $f;
+		if (@types) {
+			$t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')';
+		}
+
+		if (@forms) {
+			$f_filter .= ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')';
+		}
+	}
+
+
+
+	my $descendants = defined($ou_type) ?
+				"actor.org_unit_descendants($ou, $ou_type)" :
+				"actor.org_unit_descendants($ou)";
+
+	my $class = $self->{cdbi};
+	my $search_table = $class->table;
+
+	my $metabib_record_descriptor = metabib::record_descriptor->table;
+	my $metabib_metarecord = metabib::metarecord->table;
+	my $metabib_metarecord_source_map_table = metabib::metarecord_source_map->table;
+	my $asset_call_number_table = asset::call_number->table;
+	my $asset_copy_table = asset::copy->table;
+	my $cs_table = config::copy_status->table;
+	my $cl_table = asset::copy_location->table;
+
+	my ($index_col) = $class->columns('FTS');
+	$index_col ||= 'value';
+
+	(my $search_class = $self->api_name) =~ s/.*metabib.(\w+).search_fts.*/$1/o;
+	my $fts = OpenILS::Application::Storage::FTS->compile($search_class => $term, 'f.value', "f.$index_col");
+
+	my $fts_where = $fts->sql_where_clause;
+	my @fts_ranks = $fts->fts_rank;
+
+	my $rank = join(' + ', @fts_ranks);
+
+	my $has_vols = 'AND cn.owning_lib = d.id';
+	my $has_copies = 'AND cp.call_number = cn.id';
+	my $copies_visible = 'AND d.opac_visible IS TRUE AND cp.opac_visible IS TRUE AND cs.opac_visible IS TRUE AND cl.opac_visible IS TRUE';
+
+	my $visible_count = ', count(DISTINCT cp.id)';
+	my $visible_count_test = 'HAVING count(DISTINCT cp.id) > 0';
+
+	if ($self->api_name =~ /staff/o) {
+		$copies_visible = '';
+		$visible_count_test = '';
+		$has_copies = '' if ($ou_type == 0);
+		$has_vols = '' if ($ou_type == 0);
+	}
+
+	my $rank_calc = <<"	RANK";
+		, (SUM(	$rank
+			* CASE WHEN f.value ILIKE ? THEN 1.2 ELSE 1 END -- phrase order
+			* CASE WHEN f.value ILIKE ? THEN 1.5 ELSE 1 END -- first word match
+			* CASE WHEN f.value ~* ? THEN 2 ELSE 1 END -- only word match
+		)/COUNT(m.source)), MIN(COALESCE(CHAR_LENGTH(f.value),1))
+	RANK
+
+	$rank_calc = ',1 , 1' if ($self->api_name =~ /unordered/o);
+
+	if ($copies_visible) {
+		$select = <<"		SQL";
+			SELECT	m.metarecord $rank_calc $visible_count, CASE WHEN COUNT(DISTINCT m.source) = 1 THEN MAX(m.source) ELSE MAX(0) END
+	  	  	FROM	$search_table f,
+				$metabib_metarecord_source_map_table m,
+				$asset_call_number_table cn,
+				$asset_copy_table cp,
+				$cs_table cs,
+				$cl_table cl,
+				$metabib_record_descriptor rd,
+				$descendants d
+	  	  	WHERE	$fts_where
+		  		AND m.source = f.source
+				AND cn.record = m.source
+				AND rd.record = m.source
+				AND cp.status = cs.id
+				AND cp.location = cl.id
+				$has_vols
+				$has_copies
+				$copies_visible
+				$t_filter
+				$f_filter
+	  	  	GROUP BY 1 $visible_count_test
+	  	  	ORDER BY 2 DESC,3
+		  	$limit_clause $offset_clause
+		SQL
+	} else {
+		$select = <<"		SQL";
+			SELECT	m.metarecord $rank_calc, 0, CASE WHEN COUNT(DISTINCT m.source) = 1 THEN MAX(m.source) ELSE MAX(0) END
+	  	  	FROM	$search_table f,
+				$metabib_metarecord_source_map_table m,
+				$metabib_record_descriptor rd
+	  	  	WHERE	$fts_where
+		  		AND m.source = f.source
+				AND rd.record = m.source
+				$t_filter
+				$f_filter
+	  	  	GROUP BY 1, 4
+	  	  	ORDER BY 2 DESC,3
+		  	$limit_clause $offset_clause
+		SQL
+	}
+
+	$log->debug("Field Search SQL :: [$select]",DEBUG);
+
+	my $SQLstring = join('%',$fts->words);
+	my $REstring = join('\\s+',$fts->words);
+	my $first_word = ($fts->words)[0].'%';
+	my $recs = ($self->api_name =~ /unordered/o) ? 
+			$class->db_Main->selectall_arrayref($select, {}, @types, @forms) :
+			$class->db_Main->selectall_arrayref($select, {},
+				'%'.lc($SQLstring).'%',			# phrase order match
+				lc($first_word),			# first word match
+				'^\\s*'.lc($REstring).'\\s*/?\s*$',	# full exact match
+				@types, @forms
+			);
+	
+	$log->debug("Search yielded ".scalar(@$recs)." results.",DEBUG);
+
+	$client->respond($_) for (map { [@$_[0,1,3,4]] } @$recs);
+	return undef;
+}
+
+for my $class ( qw/title author subject keyword series identifier/ ) {
+	__PACKAGE__->register_method(
+		api_name	=> "open-ils.storage.metabib.$class.search_fts.metarecord",
+		method		=> 'search_class_fts',
+		api_level	=> 1,
+		stream		=> 1,
+		cdbi		=> "metabib::${class}_field_entry",
+		cachable	=> 1,
+	);
+	__PACKAGE__->register_method(
+		api_name	=> "open-ils.storage.metabib.$class.search_fts.metarecord.unordered",
+		method		=> 'search_class_fts',
+		api_level	=> 1,
+		stream		=> 1,
+		cdbi		=> "metabib::${class}_field_entry",
+		cachable	=> 1,
+	);
+	__PACKAGE__->register_method(
+		api_name	=> "open-ils.storage.metabib.$class.search_fts.metarecord.staff",
+		method		=> 'search_class_fts',
+		api_level	=> 1,
+		stream		=> 1,
+		cdbi		=> "metabib::${class}_field_entry",
+		cachable	=> 1,
+	);
+	__PACKAGE__->register_method(
+		api_name	=> "open-ils.storage.metabib.$class.search_fts.metarecord.staff.unordered",
+		method		=> 'search_class_fts',
+		api_level	=> 1,
+		stream		=> 1,
+		cdbi		=> "metabib::${class}_field_entry",
+		cachable	=> 1,
+	);
+}
+
+# XXX factored most of the PG dependant stuff out of here... need to find a way to do "dependants".
+sub search_class_fts_count {
+	my $self = shift;
+	my $client = shift;
+	my %args = @_;
+	
+	my $term = $args{term};
+	my $ou = $args{org_unit};
+	my $ou_type = $args{depth};
+	my $limit = $args{limit} || 100;
+	my $offset = $args{offset} || 0;
+
+	my $descendants = defined($ou_type) ?
+				"actor.org_unit_descendants($ou, $ou_type)" :
+				"actor.org_unit_descendants($ou)";
+		
+	my (@types,@forms);
+	my ($t_filter, $f_filter) = ('','');
+
+	if ($args{format}) {
+		my ($t, $f) = split '-', $args{format};
+		@types = split '', $t;
+		@forms = split '', $f;
+		if (@types) {
+			$t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')';
+		}
+
+		if (@forms) {
+			$f_filter .= ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')';
+		}
+	}
+
+
+	(my $search_class = $self->api_name) =~ s/.*metabib.(\w+).search_fts.*/$1/o;
+
+	my $class = $self->{cdbi};
+	my $search_table = $class->table;
+
+	my $metabib_record_descriptor = metabib::record_descriptor->table;
+	my $metabib_metarecord_source_map_table = metabib::metarecord_source_map->table;
+	my $asset_call_number_table = asset::call_number->table;
+	my $asset_copy_table = asset::copy->table;
+	my $cs_table = config::copy_status->table;
+	my $cl_table = asset::copy_location->table;
+
+	my ($index_col) = $class->columns('FTS');
+	$index_col ||= 'value';
+
+	my $fts = OpenILS::Application::Storage::FTS->compile($search_class => $term, 'value',"$index_col");
+
+	my $fts_where = $fts->sql_where_clause;
+
+	my $has_vols = 'AND cn.owning_lib = d.id';
+	my $has_copies = 'AND cp.call_number = cn.id';
+	my $copies_visible = 'AND d.opac_visible IS TRUE AND cp.opac_visible IS TRUE AND cs.opac_visible IS TRUE AND cl.opac_visible IS TRUE';
+	if ($self->api_name =~ /staff/o) {
+		$copies_visible = '';
+		$has_vols = '' if ($ou_type == 0);
+		$has_copies = '' if ($ou_type == 0);
+	}
+
+	# XXX test an "EXISTS version of descendant checking...
+	my $select;
+	if ($copies_visible) {
+		$select = <<"		SQL";
+		SELECT	count(distinct  m.metarecord)
+	  	  FROM	$search_table f,
+			$metabib_metarecord_source_map_table m,
+			$metabib_metarecord_source_map_table mr,
+			$asset_call_number_table cn,
+			$asset_copy_table cp,
+			$cs_table cs,
+			$cl_table cl,
+			$metabib_record_descriptor rd,
+			$descendants d
+	  	  WHERE	$fts_where
+		  	AND mr.source = f.source
+			AND mr.metarecord = m.metarecord
+			AND cn.record = m.source
+			AND rd.record = m.source
+			AND cp.status = cs.id
+			AND cp.location = cl.id
+			$has_vols
+			$has_copies
+			$copies_visible
+			$t_filter
+			$f_filter
+		SQL
+	} else {
+		$select = <<"		SQL";
+		SELECT	count(distinct  m.metarecord)
+	  	  FROM	$search_table f,
+			$metabib_metarecord_source_map_table m,
+			$metabib_metarecord_source_map_table mr,
+			$metabib_record_descriptor rd
+	  	  WHERE	$fts_where
+		  	AND mr.source = f.source
+			AND mr.metarecord = m.metarecord
+			AND rd.record = m.source
+			$t_filter
+			$f_filter
+		SQL
+	}
+
+	$log->debug("Field Search Count SQL :: [$select]",DEBUG);
+
+	my $recs = $class->db_Main->selectrow_arrayref($select, {}, @types, @forms)->[0];
+	
+	$log->debug("Count Search yielded $recs results.",DEBUG);
+
+	return $recs;
+
+}
+for my $class ( qw/title author subject keyword series identifier/ ) {
+	__PACKAGE__->register_method(
+		api_name	=> "open-ils.storage.metabib.$class.search_fts.metarecord_count",
+		method		=> 'search_class_fts_count',
+		api_level	=> 1,
+		stream		=> 1,
+		cdbi		=> "metabib::${class}_field_entry",
+		cachable	=> 1,
+	);
+	__PACKAGE__->register_method(
+		api_name	=> "open-ils.storage.metabib.$class.search_fts.metarecord_count.staff",
+		method		=> 'search_class_fts_count',
+		api_level	=> 1,
+		stream		=> 1,
+		cdbi		=> "metabib::${class}_field_entry",
+		cachable	=> 1,
+	);
+}
+
+
+# XXX factored most of the PG dependant stuff out of here... need to find a way to do "dependants".
+sub postfilter_search_class_fts {
+	my $self = shift;
+	my $client = shift;
+	my %args = @_;
+	
+	my $term = $args{term};
+	my $sort = $args{'sort'};
+	my $sort_dir = $args{sort_dir} || 'DESC';
+	my $ou = $args{org_unit};
+	my $ou_type = $args{depth};
+	my $limit = $args{limit} || 10;
+	my $visibility_limit = $args{visibility_limit} || 5000;
+	my $offset = $args{offset} || 0;
+
+	my $outer_limit = 1000;
+
+	my $limit_clause = '';
+	my $offset_clause = '';
+
+	$limit_clause = "LIMIT $outer_limit";
+	$offset_clause = "OFFSET $offset" if (defined $offset and int($offset) > 0);
+
+	my (@types,@forms,@lang,@aud,@lit_form);
+	my ($t_filter, $f_filter) = ('','');
+	my ($a_filter, $l_filter, $lf_filter) = ('','','');
+	my ($ot_filter, $of_filter) = ('','');
+	my ($oa_filter, $ol_filter, $olf_filter) = ('','','');
+
+	if (my $a = $args{audience}) {
+		$a = [$a] if (!ref($a));
+		@aud = @$a;
+			
+		$a_filter = ' AND rd.audience IN ('.join(',',map{'?'}@aud).')';
+		$oa_filter = ' AND ord.audience IN ('.join(',',map{'?'}@aud).')';
+	}
+
+	if (my $l = $args{language}) {
+		$l = [$l] if (!ref($l));
+		@lang = @$l;
+
+		$l_filter = ' AND rd.item_lang IN ('.join(',',map{'?'}@lang).')';
+		$ol_filter = ' AND ord.item_lang IN ('.join(',',map{'?'}@lang).')';
+	}
+
+	if (my $f = $args{lit_form}) {
+		$f = [$f] if (!ref($f));
+		@lit_form = @$f;
+
+		$lf_filter = ' AND rd.lit_form IN ('.join(',',map{'?'}@lit_form).')';
+		$olf_filter = ' AND ord.lit_form IN ('.join(',',map{'?'}@lit_form).')';
+	}
+
+	if ($args{format}) {
+		my ($t, $f) = split '-', $args{format};
+		@types = split '', $t;
+		@forms = split '', $f;
+		if (@types) {
+			$t_filter = ' AND rd.item_type IN ('.join(',',map{'?'}@types).')';
+			$ot_filter = ' AND ord.item_type IN ('.join(',',map{'?'}@types).')';
+		}
+
+		if (@forms) {
+			$f_filter .= ' AND rd.item_form IN ('.join(',',map{'?'}@forms).')';
+			$of_filter .= ' AND ord.item_form IN ('.join(',',map{'?'}@forms).')';
+		}
+	}
+
+
+	my $descendants = defined($ou_type) ?
+				"actor.org_unit_descendants($ou, $ou_type)" :
+				"actor.org_unit_descendants($ou)";
+
+	my $class = $self->{cdbi};
+	my $search_table = $class->table;
+
+	my $metabib_full_rec = metabib::full_rec->table;
+	my $metabib_record_descriptor = metabib::record_descriptor->table;
+	my $metabib_metarecord = metabib::metarecord->table;
+	my $metabib_metarecord_source_map_table = metabib::metarecord_source_map->table;
+	my $asset_call_number_table = asset::call_number->table;
+	my $asset_copy_table = asset::copy->table;
+	my $cs_table = config::copy_status->table;
+	my $cl_table = asset::copy_location->table;
+	my $br_table = biblio::record_entry->table;
+
+	my ($index_col) = $class->columns('FTS');
+	$index_col ||= 'value';
+
+	(my $search_class = $self->api_name) =~ s/.*metabib.(\w+).post_filter.*/$1/o;
+
+	my $fts = OpenILS::Application::Storage::FTS->compile($search_class => $term, 'f.value', "f.$index_col");
+
+	my $SQLstring = join('%',map { lc($_) } $fts->words);
+	my $REstring = '^' . join('\s+',map { lc($_) } $fts->words) . '\W*$';
+	my $first_word = lc(($fts->words)[0]).'%';
+
+	my $fts_where = $fts->sql_where_clause;
+	my @fts_ranks = $fts->fts_rank;
+
+	my %bonus = ();
+	$bonus{'metabib::identifier_field_entry'} =
+        $bonus{'metabib::keyword_field_entry'} = [
+            { 'CASE WHEN f.value ILIKE ? THEN 1.2 ELSE 1 END' => $SQLstring }
+        ];
+
+	$bonus{'metabib::title_field_entry'} =
+		$bonus{'metabib::series_field_entry'} = [
+			{ 'CASE WHEN f.value ILIKE ? THEN 1.5 ELSE 1 END' => $first_word },
+			{ 'CASE WHEN f.value ~* ? THEN 2 ELSE 1 END' => $REstring },
+			@{ $bonus{'metabib::keyword_field_entry'} }
+		];
+
+	my $bonus_list = join ' * ', map { keys %$_ } @{ $bonus{$class} };
+	$bonus_list ||= '1';
+
+	my @bonus_values = map { values %$_ } @{ $bonus{$class} };
+
+	my $relevance = join(' + ', @fts_ranks);
+	$relevance = <<"	RANK";
+			(SUM( ( $relevance )  * ( $bonus_list ) )/COUNT(m.source))
+	RANK
+
+	my $string_default_sort = 'zzzz';
+	$string_default_sort = 'AAAA' if ($sort_dir eq 'DESC');
+
+	my $number_default_sort = '9999';
+	$number_default_sort = '0000' if ($sort_dir eq 'DESC');
+
+	my $rank = $relevance;
+	if (lc($sort) eq 'pubdate') {
+		$rank = <<"		RANK";
+			( FIRST ((
+				SELECT	COALESCE(SUBSTRING(frp.value FROM E'\\\\d+'),'$number_default_sort')::INT
+				  FROM	$metabib_full_rec frp
+				  WHERE	frp.record = mr.master_record
+				  	AND frp.tag = '260'
+					AND frp.subfield = 'c'
+				  LIMIT 1
+			)) )
+		RANK
+	} elsif (lc($sort) eq 'create_date') {
+		$rank = <<"		RANK";
+			( FIRST (( SELECT create_date FROM $br_table rbr WHERE rbr.id = mr.master_record)) )
+		RANK
+	} elsif (lc($sort) eq 'edit_date') {
+		$rank = <<"		RANK";
+			( FIRST (( SELECT edit_date FROM $br_table rbr WHERE rbr.id = mr.master_record)) )
+		RANK
+	} elsif (lc($sort) eq 'title') {
+		$rank = <<"		RANK";
+			( FIRST ((
+				SELECT	COALESCE(LTRIM(SUBSTR( frt.value, COALESCE(SUBSTRING(frt.ind2 FROM E'\\\\d+'),'0')::INT + 1 )),'$string_default_sort')
+				  FROM	$metabib_full_rec frt
+				  WHERE	frt.record = mr.master_record
+				  	AND frt.tag = '245'
+					AND frt.subfield = 'a'
+				  LIMIT 1
+			)) )
+		RANK
+	} elsif (lc($sort) eq 'author') {
+		$rank = <<"		RANK";
+			( FIRST((
+				SELECT	COALESCE(LTRIM(fra.value),'$string_default_sort')
+				  FROM	$metabib_full_rec fra
+				  WHERE	fra.record = mr.master_record
+				  	AND fra.tag LIKE '1%'
+					AND fra.subfield = 'a'
+				  ORDER BY fra.tag::text::int
+				  LIMIT 1
+			)) )
+		RANK
+	} else {
+		$sort = undef;
+	}
+
+	my $select = <<"	SQL";
+		SELECT	m.metarecord,
+			$relevance,
+			CASE WHEN COUNT(DISTINCT smrs.source) = 1 THEN MIN(m.source) ELSE 0 END,
+			$rank
+  	  	FROM	$search_table f,
+			$metabib_metarecord_source_map_table m,
+			$metabib_metarecord_source_map_table smrs,
+			$metabib_metarecord mr,
+			$metabib_record_descriptor rd
+  	  	WHERE	$fts_where
+	  		AND smrs.metarecord = mr.id
+	  		AND m.source = f.source
+	  		AND m.metarecord = mr.id
+			AND rd.record = smrs.source
+			$t_filter
+			$f_filter
+			$a_filter
+			$l_filter
+			$lf_filter
+  	  	GROUP BY m.metarecord
+  	  	ORDER BY 4 $sort_dir, MIN(COALESCE(CHAR_LENGTH(f.value),1))
+		LIMIT $visibility_limit
+	SQL
+
+	if (0) {
+		$select = <<"		SQL";
+
+			SELECT	DISTINCT s.*
+			  FROM	$asset_call_number_table cn,
+				$metabib_metarecord_source_map_table mrs,
+				$asset_copy_table cp,
+				$cs_table cs,
+				$cl_table cl,
+				$br_table br,
+				$descendants d,
+				$metabib_record_descriptor ord,
+				($select) s
+			  WHERE	mrs.metarecord = s.metarecord
+				AND br.id = mrs.source
+				AND cn.record = mrs.source
+				AND cp.status = cs.id
+				AND cp.location = cl.id
+				AND cn.owning_lib = d.id
+				AND cp.call_number = cn.id
+				AND cp.opac_visible IS TRUE
+				AND cs.opac_visible IS TRUE
+				AND cl.opac_visible IS TRUE
+				AND d.opac_visible IS TRUE
+				AND br.active IS TRUE
+				AND br.deleted IS FALSE
+				AND ord.record = mrs.source
+				$ot_filter
+				$of_filter
+				$oa_filter
+				$ol_filter
+				$olf_filter
+			  ORDER BY 4 $sort_dir
+		SQL
+	} elsif ($self->api_name !~ /staff/o) {
+		$select = <<"		SQL";
+
+			SELECT	DISTINCT s.*
+			  FROM	($select) s
+			  WHERE	EXISTS (
+			  	SELECT	1
+				  FROM	$asset_call_number_table cn,
+					$metabib_metarecord_source_map_table mrs,
+					$asset_copy_table cp,
+					$cs_table cs,
+					$cl_table cl,
+					$br_table br,
+					$descendants d,
+					$metabib_record_descriptor ord
+				
+				  WHERE	mrs.metarecord = s.metarecord
+					AND br.id = mrs.source
+					AND cn.record = mrs.source
+					AND cp.status = cs.id
+					AND cp.location = cl.id
+					AND cp.circ_lib = d.id
+					AND cp.call_number = cn.id
+					AND cp.opac_visible IS TRUE
+					AND cs.opac_visible IS TRUE
+					AND cl.opac_visible IS TRUE
+					AND d.opac_visible IS TRUE
+					AND br.active IS TRUE
+					AND br.deleted IS FALSE
+					AND ord.record = mrs.source
+					$ot_filter
+					$of_filter
+					$oa_filter
+					$ol_filter
+					$olf_filter
+				  LIMIT 1
+				)
+			  ORDER BY 4 $sort_dir
+		SQL
+	} else {
+		$select = <<"		SQL";
+
+			SELECT	DISTINCT s.*
+			  FROM	($select) s
+			  WHERE	EXISTS (
+			  	SELECT	1
+				  FROM	$asset_call_number_table cn,
+					$asset_copy_table cp,
+					$metabib_metarecord_source_map_table mrs,
+					$br_table br,
+					$descendants d,
+					$metabib_record_descriptor ord
+				
+				  WHERE	mrs.metarecord = s.metarecord
+					AND br.id = mrs.source
+					AND cn.record = mrs.source
+					AND cn.id = cp.call_number
+					AND br.deleted IS FALSE
+					AND cn.deleted IS FALSE
+					AND ord.record = mrs.source
+					AND (	cn.owning_lib = d.id
+						OR (	cp.circ_lib = d.id
+							AND cp.deleted IS FALSE
+						)
+					)
+					$ot_filter
+					$of_filter
+					$oa_filter
+					$ol_filter
+					$olf_filter
+				  LIMIT 1
+				)
+				OR NOT EXISTS (
+				SELECT	1
+				  FROM	$asset_call_number_table cn,
+					$metabib_metarecord_source_map_table mrs,
+					$metabib_record_descriptor ord
+				  WHERE	mrs.metarecord = s.metarecord
+					AND cn.record = mrs.source
+					AND ord.record = mrs.source
+					$ot_filter
+					$of_filter
+					$oa_filter
+					$ol_filter
+					$olf_filter
+				  LIMIT 1
+				)
+			  ORDER BY 4 $sort_dir
+		SQL
+	}
+
+
+	$log->debug("Field Search SQL :: [$select]",DEBUG);
+
+	my $recs = $class->db_Main->selectall_arrayref(
+			$select, {},
+			(@bonus_values > 0 ? @bonus_values : () ),
+			( (!$sort && @bonus_values > 0) ? @bonus_values : () ),
+			@types, @forms, @aud, @lang, @lit_form,
+			@types, @forms, @aud, @lang, @lit_form,
+			($self->api_name =~ /staff/o ? (@types, @forms, @aud, @lang, @lit_form) : () ) );
+	
+	$log->debug("Search yielded ".scalar(@$recs)." results.",DEBUG);
+
+	my $max = 0;
+	$max = 1 if (!@$recs);
+	for (@$recs) {
+		$max = $$_[1] if ($$_[1] > $max);
+	}
+
+	my $count = scalar(@$recs);
+	for my $rec (@$recs[$offset .. $offset + $limit - 1]) {
+		my ($mrid,$rank,$skip) = @$rec;
+		$client->respond( [$mrid, sprintf('%0.3f',$rank/$max), $skip, $count] );
+	}
+	return undef;
+}
+
+for my $class ( qw/title author subject keyword series identifier/ ) {
+	__PACKAGE__->register_method(
+		api_name	=> "open-ils.storage.metabib.$class.post_filter.search_fts.metarecord",
+		method		=> 'postfilter_search_class_fts',
+		api_level	=> 1,
+		stream		=> 1,
+		cdbi		=> "metabib::${class}_field_entry",
+		cachable	=> 1,
+	);
+	__PACKAGE__->register_method(
+		api_name	=> "open-ils.storage.metabib.$class.post_filter.search_fts.metarecord.staff",
+		method		=> 'postfilter_search_class_fts',
+		api_level	=> 1,
+		stream		=> 1,
+		cdbi		=> "metabib::${class}_field_entry",
+		cachable	=> 1,
+	);
+}
+
+
+
+my $_cdbi = {	title	=> "metabib::title_field_entry",
+		author	=> "metabib::author_field_entry",
+		subject	=> "metabib::subject_field_entry",
+		keyword	=> "metabib::keyword_field_entry",
+		series	=> "metabib::series_field_entry",
+		identifier	=> "metabib::identifier_field_entry",
+};
+
+# XXX factored most of the PG dependant stuff out of here... need to find a way to do "dependants".
+sub postfilter_search_multi_class_fts {
+    my $self   = shift;
+    my $client = shift;
+    my %args   = @_;
+	
+    my $sort             = $args{'sort'};
+    my $sort_dir         = $args{sort_dir} || 'DESC';
+    my $ou               = $args{org_unit};
+    my $ou_type          = $args{depth};
+    my $limit            = $args{limit}  || 10;
+    my $offset           = $args{offset} ||  0;
+    my $visibility_limit = $args{visibility_limit} || 5000;
+
+	if (!$ou) {
+		$ou = actor::org_unit->search( { parent_ou => undef } )->next->id;
+	}
+
+	if (!defined($args{org_unit})) {
+		die "No target organizational unit passed to ".$self->api_name;
+	}
+
+	if (! scalar( keys %{$args{searches}} )) {
+		die "No search arguments were passed to ".$self->api_name;
+	}
+
+	my $outer_limit = 1000;
+
+	my $limit_clause  = '';
+	my $offset_clause = '';
+
+	$limit_clause  = "LIMIT $outer_limit";
+	$offset_clause = "OFFSET $offset" if (defined $offset and int($offset) > 0);
+
+	my ($avail_filter,@types,@forms,@lang,@aud,@lit_form,@vformats) = ('');
+	my ($t_filter,   $f_filter,   $v_filter) = ('','','');
+	my ($a_filter,   $l_filter,  $lf_filter) = ('','','');
+	my ($ot_filter, $of_filter,  $ov_filter) = ('','','');
+	my ($oa_filter, $ol_filter, $olf_filter) = ('','','');
+
+	if ($args{available}) {
+		$avail_filter = ' AND cp.status IN (0,7,12)';
+	}
+
+	if (my $a = $args{audience}) {
+		$a = [$a] if (!ref($a));
+		@aud = @$a;
+			
+		$a_filter  = ' AND  rd.audience IN ('.join(',',map{'?'}@aud).')';
+		$oa_filter = ' AND ord.audience IN ('.join(',',map{'?'}@aud).')';
+	}
+
+	if (my $l = $args{language}) {
+		$l = [$l] if (!ref($l));
+		@lang = @$l;
+
+		$l_filter  = ' AND  rd.item_lang IN ('.join(',',map{'?'}@lang).')';
+		$ol_filter = ' AND ord.item_lang IN ('.join(',',map{'?'}@lang).')';
+	}
+
+	if (my $f = $args{lit_form}) {
+		$f = [$f] if (!ref($f));
+		@lit_form = @$f;
+
+		$lf_filter  = ' AND  rd.lit_form IN ('.join(',',map{'?'}@lit_form).')';
+		$olf_filter = ' AND ord.lit_form IN ('.join(',',map{'?'}@lit_form).')';
+	}
+
+	if (my $f = $args{item_form}) {
+		$f = [$f] if (!ref($f));
+		@forms = @$f;
+
+		$f_filter  = ' AND  rd.item_form IN ('.join(',',map{'?'}@forms).')';
+		$of_filter = ' AND ord.item_form IN ('.join(',',map{'?'}@forms).')';
+	}
+
+	if (my $t = $args{item_type}) {
+		$t = [$t] if (!ref($t));
+		@types = @$t;
+
+		$t_filter  = ' AND  rd.item_type IN ('.join(',',map{'?'}@types).')';
+		$ot_filter = ' AND ord.item_type IN ('.join(',',map{'?'}@types).')';
+	}
+
+	if (my $v = $args{vr_format}) {
+		$v = [$v] if (!ref($v));
+		@vformats = @$v;
+
+		$v_filter  = ' AND  rd.vr_format IN ('.join(',',map{'?'}@vformats).')';
+		$ov_filter = ' AND ord.vr_format IN ('.join(',',map{'?'}@vformats).')';
+	}
+
+
+	# XXX legacy format and item type support
+	if ($args{format}) {
+		my ($t, $f) = split '-', $args{format};
+		@types = split '', $t;
+		@forms = split '', $f;
+		if (@types) {
+			$t_filter  = ' AND  rd.item_type IN ('.join(',',map{'?'}@types).')';
+			$ot_filter = ' AND ord.item_type IN ('.join(',',map{'?'}@types).')';
+		}
+
+		if (@forms) {
+			$f_filter  .= ' AND  rd.item_form IN ('.join(',',map{'?'}@forms).')';
+			$of_filter .= ' AND ord.item_form IN ('.join(',',map{'?'}@forms).')';
+		}
+	}
+
+
+
+	my $descendants = defined($ou_type) ?
+				"actor.org_unit_descendants($ou, $ou_type)" :
+				"actor.org_unit_descendants($ou)";
+
+    my $search_table_list = '';
+    my $fts_list          = '';
+    my $join_table_list   = '';
+    my @rank_list;
+
+	my $field_table = config::metabib_field->table;
+
+	my @bonus_lists;
+	my @bonus_values;
+	my $prev_search_group;
+	my $curr_search_group;
+	my $search_class;
+	my $search_field;
+	my $metabib_field;
+	for my $search_group (sort keys %{$args{searches}}) {
+		(my $search_group_name = $search_group) =~ s/\|/_/gso;
+		($search_class,$search_field) = split /\|/, $search_group;
+		$log->debug("Searching class [$search_class] and field [$search_field]",DEBUG);
+
+		if ($search_field) {
+			unless ( $metabib_field = config::metabib_field->search( field_class => $search_class, name => $search_field )->next ) {
+				$log->warn("Requested class [$search_class] or field [$search_field] does not exist!");
+				return undef;
+			}
+		}
+
+		$prev_search_group = $curr_search_group if ($curr_search_group);
+
+		$curr_search_group = $search_group_name;
+
+		my $class = $_cdbi->{$search_class};
+		my $search_table = $class->table;
+
+		my ($index_col) = $class->columns('FTS');
+		$index_col ||= 'value';
+
+		
+		my $fts = OpenILS::Application::Storage::FTS->compile($search_class => $args{searches}{$search_group}{term}, $search_group_name.'.value', "$search_group_name.$index_col");
+
+		my $fts_where = $fts->sql_where_clause;
+		my @fts_ranks = $fts->fts_rank;
+
+		my $SQLstring = join('%',map { lc($_) } $fts->words);
+		my $REstring = '^' . join('\s+',map { lc($_) } $fts->words) . '\W*$';
+		my $first_word = lc(($fts->words)[0]).'%';
+
+		$_.=" * (SELECT weight FROM $field_table WHERE $search_group_name.field = id)" for (@fts_ranks);
+		my $rank = join(' + ', @fts_ranks);
+
+		my %bonus = ();
+		$bonus{'keyword'} = [ { "CASE WHEN $search_group_name.value LIKE ? THEN 10 ELSE 1 END" => $SQLstring } ];
+		$bonus{'author'}  = [ { "CASE WHEN $search_group_name.value ILIKE ? THEN 10 ELSE 1 END" => $first_word } ];
+
+		$bonus{'series'} = [
+			{ "CASE WHEN $search_group_name.value LIKE ? THEN 1.5 ELSE 1 END" => $first_word },
+			{ "CASE WHEN $search_group_name.value ~ ? THEN 20 ELSE 1 END" => $REstring },
+		];
+
+		$bonus{'title'} = [ @{ $bonus{'series'} }, @{ $bonus{'keyword'} } ];
+
+		my $bonus_list = join ' * ', map { keys %$_ } @{ $bonus{$search_class} };
+		$bonus_list ||= '1';
+
+		push @bonus_lists, $bonus_list;
+		push @bonus_values, map { values %$_ } @{ $bonus{$search_class} };
+
+
+		#---------------------
+
+		$search_table_list .= "$search_table $search_group_name, ";
+		push @rank_list,$rank;
+		$fts_list .= " AND $fts_where AND m.source = $search_group_name.source";
+
+		if ($metabib_field) {
+			$join_table_list .= " AND $search_group_name.field = " . $metabib_field->id;
+			$metabib_field = undef;
+		}
+
+		if ($prev_search_group) {
+			$join_table_list .= " AND $prev_search_group.source = $curr_search_group.source";
+		}
+	}
+
+	my $metabib_record_descriptor = metabib::record_descriptor->table;
+	my $metabib_full_rec = metabib::full_rec->table;
+	my $metabib_metarecord = metabib::metarecord->table;
+	my $metabib_metarecord_source_map_table = metabib::metarecord_source_map->table;
+	my $asset_call_number_table = asset::call_number->table;
+	my $asset_copy_table = asset::copy->table;
+	my $cs_table = config::copy_status->table;
+	my $cl_table = asset::copy_location->table;
+	my $br_table = biblio::record_entry->table;
+	my $source_table = config::bib_source->table;
+
+	my $bonuses = join (' * ', @bonus_lists);
+	my $relevance = join (' + ', @rank_list);
+	$relevance = "SUM( ($relevance) * ($bonuses) )/COUNT(DISTINCT smrs.source)";
+
+	my $string_default_sort = 'zzzz';
+	$string_default_sort = 'AAAA' if ($sort_dir eq 'DESC');
+
+	my $number_default_sort = '9999';
+	$number_default_sort = '0000' if ($sort_dir eq 'DESC');
+
+
+
+	my $secondary_sort = <<"	SORT";
+		( FIRST ((
+			SELECT	COALESCE(LTRIM(SUBSTR( sfrt.value, COALESCE(SUBSTRING(sfrt.ind2 FROM E'\\\\d+'),'0')::INT + 1 )),'$string_default_sort')
+			  FROM	$metabib_full_rec sfrt,
+				$metabib_metarecord mr
+			  WHERE	sfrt.record = mr.master_record
+			  	AND sfrt.tag = '245'
+				AND sfrt.subfield = 'a'
+			  LIMIT 1
+		)) )
+	SORT
+
+	my $rank = $relevance;
+	if (lc($sort) eq 'pubdate') {
+		$rank = <<"		RANK";
+			( FIRST ((
+				SELECT	COALESCE(SUBSTRING(frp.value FROM E'\\\\d+'),'$number_default_sort')::INT
+				  FROM	$metabib_full_rec frp
+				  WHERE	frp.record = mr.master_record
+				  	AND frp.tag = '260'
+					AND frp.subfield = 'c'
+				  LIMIT 1
+			)) )
+		RANK
+	} elsif (lc($sort) eq 'create_date') {
+		$rank = <<"		RANK";
+			( FIRST (( SELECT create_date FROM $br_table rbr WHERE rbr.id = mr.master_record)) )
+		RANK
+	} elsif (lc($sort) eq 'edit_date') {
+		$rank = <<"		RANK";
+			( FIRST (( SELECT edit_date FROM $br_table rbr WHERE rbr.id = mr.master_record)) )
+		RANK
+	} elsif (lc($sort) eq 'title') {
+		$rank = <<"		RANK";
+			( FIRST ((
+				SELECT	COALESCE(LTRIM(SUBSTR( frt.value, COALESCE(SUBSTRING(frt.ind2 FROM E'\\\\d+'),'0')::INT + 1 )),'$string_default_sort')
+				  FROM	$metabib_full_rec frt
+				  WHERE	frt.record = mr.master_record
+				  	AND frt.tag = '245'
+					AND frt.subfield = 'a'
+				  LIMIT 1
+			)) )
+		RANK
+		$secondary_sort = <<"		SORT";
+			( FIRST ((
+				SELECT	COALESCE(SUBSTRING(sfrp.value FROM E'\\\\d+'),'$number_default_sort')::INT
+				  FROM	$metabib_full_rec sfrp
+				  WHERE	sfrp.record = mr.master_record
+				  	AND sfrp.tag = '260'
+					AND sfrp.subfield = 'c'
+				  LIMIT 1
+			)) )
+		SORT
+	} elsif (lc($sort) eq 'author') {
+		$rank = <<"		RANK";
+			( FIRST((
+				SELECT	COALESCE(LTRIM(fra.value),'$string_default_sort')
+				  FROM	$metabib_full_rec fra
+				  WHERE	fra.record = mr.master_record
+				  	AND fra.tag LIKE '1%'
+					AND fra.subfield = 'a'
+				  ORDER BY fra.tag::text::int
+				  LIMIT 1
+			)) )
+		RANK
+	} else {
+		push @bonus_values, @bonus_values;
+		$sort = undef;
+	}
+
+
+	my $select = <<"	SQL";
+		SELECT	m.metarecord,
+			$relevance,
+			CASE WHEN COUNT(DISTINCT smrs.source) = 1 THEN FIRST(m.source) ELSE 0 END,
+			$rank,
+			$secondary_sort
+  	  	FROM	$search_table_list
+			$metabib_metarecord mr,
+			$metabib_metarecord_source_map_table m,
+			$metabib_metarecord_source_map_table smrs
+	  	WHERE	m.metarecord = smrs.metarecord 
+			AND mr.id = m.metarecord
+  	  		$fts_list
+			$join_table_list
+  	  	GROUP BY m.metarecord
+  	  	-- ORDER BY 4 $sort_dir
+		LIMIT $visibility_limit
+	SQL
+
+	if ($self->api_name !~ /staff/o) {
+		$select = <<"		SQL";
+
+			SELECT	s.*
+			  FROM	($select) s
+			  WHERE	EXISTS (
+			  	SELECT	1
+				  FROM	$asset_call_number_table cn,
+					$metabib_metarecord_source_map_table mrs,
+					$asset_copy_table cp,
+					$cs_table cs,
+					$cl_table cl,
+					$br_table br,
+					$descendants d,
+					$metabib_record_descriptor ord
+				  WHERE	mrs.metarecord = s.metarecord
+					AND br.id = mrs.source
+					AND cn.record = mrs.source
+					AND cp.status = cs.id
+					AND cp.location = cl.id
+					AND cp.circ_lib = d.id
+					AND cp.call_number = cn.id
+					AND cp.opac_visible IS TRUE
+					AND cs.opac_visible IS TRUE
+					AND cl.opac_visible IS TRUE
+					AND d.opac_visible IS TRUE
+					AND br.active IS TRUE
+					AND br.deleted IS FALSE
+					AND cp.deleted IS FALSE
+					AND cn.deleted IS FALSE
+					AND ord.record = mrs.source
+					$ot_filter
+					$of_filter
+					$ov_filter
+					$oa_filter
+					$ol_filter
+					$olf_filter
+					$avail_filter
+				  LIMIT 1
+			  	)
+				OR EXISTS (
+				SELECT	1
+				  FROM	$br_table br,
+					$metabib_metarecord_source_map_table mrs,
+					$metabib_record_descriptor ord,
+					$source_table src
+				  WHERE	mrs.metarecord = s.metarecord
+					AND ord.record = mrs.source
+					AND br.id = mrs.source
+					AND br.source = src.id
+					AND src.transcendant IS TRUE
+					$ot_filter
+					$of_filter
+					$ov_filter
+					$oa_filter
+					$ol_filter
+					$olf_filter
+				)
+			  ORDER BY 4 $sort_dir, 5
+		SQL
+	} else {
+		$select = <<"		SQL";
+
+			SELECT	DISTINCT s.*
+			  FROM	($select) s,
+				$metabib_metarecord_source_map_table omrs,
+				$metabib_record_descriptor ord
+			  WHERE	omrs.metarecord = s.metarecord
+				AND ord.record = omrs.source
+			  	AND (	EXISTS (
+					  	SELECT	1
+						  FROM	$asset_call_number_table cn,
+							$asset_copy_table cp,
+							$descendants d,
+							$br_table br
+						  WHERE	br.id = omrs.source
+							AND cn.record = omrs.source
+							AND br.deleted IS FALSE
+							AND cn.deleted IS FALSE
+							AND cp.call_number = cn.id
+							AND (	cn.owning_lib = d.id
+								OR (	cp.circ_lib = d.id
+									AND cp.deleted IS FALSE
+								)
+							)
+							$avail_filter
+						  LIMIT 1
+					)
+					OR NOT EXISTS (
+						SELECT	1
+						  FROM	$asset_call_number_table cn
+						  WHERE	cn.record = omrs.source
+							AND cn.deleted IS FALSE
+						  LIMIT 1
+					)
+					OR EXISTS (
+					SELECT	1
+					  FROM	$br_table br,
+						$metabib_metarecord_source_map_table mrs,
+						$metabib_record_descriptor ord,
+						$source_table src
+					  WHERE	mrs.metarecord = s.metarecord
+						AND br.id = mrs.source
+						AND br.source = src.id
+						AND src.transcendant IS TRUE
+						$ot_filter
+						$of_filter
+						$ov_filter
+						$oa_filter
+						$ol_filter
+						$olf_filter
+					)
+				)
+				$ot_filter
+				$of_filter
+				$ov_filter
+				$oa_filter
+				$ol_filter
+				$olf_filter
+
+			  ORDER BY 4 $sort_dir, 5
+		SQL
+	}
+
+
+	$log->debug("Field Search SQL :: [$select]",DEBUG);
+
+	my $recs = $_cdbi->{title}->db_Main->selectall_arrayref(
+			$select, {},
+			@bonus_values,
+			@types, @forms, @vformats, @aud, @lang, @lit_form,
+			@types, @forms, @vformats, @aud, @lang, @lit_form,
+			# ($self->api_name =~ /staff/o ? (@types, @forms, @aud, @lang, @lit_form) : () )
+	);
+	
+	$log->debug("Search yielded ".scalar(@$recs)." results.",DEBUG);
+
+	my $max = 0;
+	$max = 1 if (!@$recs);
+	for (@$recs) {
+		$max = $$_[1] if ($$_[1] > $max);
+	}
+
+	my $count = scalar(@$recs);
+	for my $rec (@$recs[$offset .. $offset + $limit - 1]) {
+		next unless ($$rec[0]);
+		my ($mrid,$rank,$skip) = @$rec;
+		$client->respond( [$mrid, sprintf('%0.3f',$rank/$max), $skip, $count] );
+	}
+	return undef;
+}
+
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.metabib.post_filter.multiclass.search_fts.metarecord",
+	method		=> 'postfilter_search_multi_class_fts',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.metabib.post_filter.multiclass.search_fts.metarecord.staff",
+	method		=> 'postfilter_search_multi_class_fts',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.metabib.multiclass.search_fts",
+	method		=> 'postfilter_search_multi_class_fts',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.metabib.multiclass.search_fts.staff",
+	method		=> 'postfilter_search_multi_class_fts',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+
+# XXX factored most of the PG dependant stuff out of here... need to find a way to do "dependants".
+sub biblio_search_multi_class_fts {
+	my $self = shift;
+	my $client = shift;
+	my %args = @_;
+	
+    my $sort             = $args{'sort'};
+    my $sort_dir         = $args{sort_dir} || 'DESC';
+    my $ou               = $args{org_unit};
+    my $ou_type          = $args{depth};
+    my $limit            = $args{limit}  || 10;
+    my $offset           = $args{offset} ||  0;
+    my $pref_lang        = $args{prefered_language} || 'eng';
+    my $visibility_limit = $args{visibility_limit}  || 5000;
+
+	if (!$ou) {
+		$ou = actor::org_unit->search( { parent_ou => undef } )->next->id;
+	}
+
+	if (! scalar( keys %{$args{searches}} )) {
+		die "No search arguments were passed to ".$self->api_name;
+	}
+
+	my $outer_limit = 1000;
+
+	my $limit_clause  = '';
+	my $offset_clause = '';
+
+	$limit_clause  = "LIMIT $outer_limit";
+	$offset_clause = "OFFSET $offset" if (defined $offset and int($offset) > 0);
+
+	my ($avail_filter,@types,@forms,@lang,@aud,@lit_form,@vformats) = ('');
+	my ($t_filter,   $f_filter,   $v_filter) = ('','','');
+	my ($a_filter,   $l_filter,  $lf_filter) = ('','','');
+	my ($ot_filter, $of_filter,  $ov_filter) = ('','','');
+	my ($oa_filter, $ol_filter, $olf_filter) = ('','','');
+
+	if ($args{available}) {
+		$avail_filter = ' AND cp.status IN (0,7,12)';
+	}
+
+	if (my $a = $args{audience}) {
+		$a = [$a] if (!ref($a));
+		@aud = @$a;
+			
+		$a_filter  = ' AND rd.audience  IN ('.join(',',map{'?'}@aud).')';
+		$oa_filter = ' AND ord.audience IN ('.join(',',map{'?'}@aud).')';
+	}
+
+	if (my $l = $args{language}) {
+		$l = [$l] if (!ref($l));
+		@lang = @$l;
+
+		$l_filter  = ' AND rd.item_lang  IN ('.join(',',map{'?'}@lang).')';
+		$ol_filter = ' AND ord.item_lang IN ('.join(',',map{'?'}@lang).')';
+	}
+
+	if (my $f = $args{lit_form}) {
+		$f = [$f] if (!ref($f));
+		@lit_form = @$f;
+
+		$lf_filter  = ' AND rd.lit_form  IN ('.join(',',map{'?'}@lit_form).')';
+		$olf_filter = ' AND ord.lit_form IN ('.join(',',map{'?'}@lit_form).')';
+	}
+
+	if (my $f = $args{item_form}) {
+		$f = [$f] if (!ref($f));
+		@forms = @$f;
+
+		$f_filter  = ' AND rd.item_form  IN ('.join(',',map{'?'}@forms).')';
+		$of_filter = ' AND ord.item_form IN ('.join(',',map{'?'}@forms).')';
+	}
+
+	if (my $t = $args{item_type}) {
+		$t = [$t] if (!ref($t));
+		@types = @$t;
+
+		$t_filter  = ' AND rd.item_type  IN ('.join(',',map{'?'}@types).')';
+		$ot_filter = ' AND ord.item_type IN ('.join(',',map{'?'}@types).')';
+	}
+
+	if (my $v = $args{vr_format}) {
+		$v = [$v] if (!ref($v));
+		@vformats = @$v;
+
+		$v_filter  = ' AND rd.vr_format  IN ('.join(',',map{'?'}@vformats).')';
+		$ov_filter = ' AND ord.vr_format IN ('.join(',',map{'?'}@vformats).')';
+	}
+
+	# XXX legacy format and item type support
+	if ($args{format}) {
+		my ($t, $f) = split '-', $args{format};
+		@types = split '', $t;
+		@forms = split '', $f;
+		if (@types) {
+			$t_filter  = ' AND rd.item_type  IN ('.join(',',map{'?'}@types).')';
+			$ot_filter = ' AND ord.item_type IN ('.join(',',map{'?'}@types).')';
+		}
+
+		if (@forms) {
+			$f_filter  .= ' AND rd.item_form  IN ('.join(',',map{'?'}@forms).')';
+			$of_filter .= ' AND ord.item_form IN ('.join(',',map{'?'}@forms).')';
+		}
+	}
+
+
+	my $descendants = defined($ou_type) ?
+				"actor.org_unit_descendants($ou, $ou_type)" :
+				"actor.org_unit_descendants($ou)";
+
+	my $search_table_list = '';
+	my $fts_list = '';
+	my $join_table_list = '';
+	my @rank_list;
+
+	my $field_table = config::metabib_field->table;
+
+	my @bonus_lists;
+	my @bonus_values;
+	my $prev_search_group;
+	my $curr_search_group;
+	my $search_class;
+	my $search_field;
+	my $metabib_field;
+	for my $search_group (sort keys %{$args{searches}}) {
+		(my $search_group_name = $search_group) =~ s/\|/_/gso;
+		($search_class,$search_field) = split /\|/, $search_group;
+		$log->debug("Searching class [$search_class] and field [$search_field]",DEBUG);
+
+		if ($search_field) {
+			unless ( $metabib_field = config::metabib_field->search( field_class => $search_class, name => $search_field )->next ) {
+				$log->warn("Requested class [$search_class] or field [$search_field] does not exist!");
+				return undef;
+			}
+		}
+
+		$prev_search_group = $curr_search_group if ($curr_search_group);
+
+		$curr_search_group = $search_group_name;
+
+		my $class = $_cdbi->{$search_class};
+		my $search_table = $class->table;
+
+		my ($index_col) = $class->columns('FTS');
+		$index_col ||= 'value';
+
+		
+		my $fts = OpenILS::Application::Storage::FTS->compile($search_class => $args{searches}{$search_group}{term}, $search_group_name.'.value', "$search_group_name.$index_col");
+
+		my $fts_where = $fts->sql_where_clause;
+		my @fts_ranks = $fts->fts_rank;
+
+		my $SQLstring = join('%',map { lc($_) } $fts->words) .'%';
+		my $REstring = '^' . join('\s+',map { lc($_) } $fts->words) . '\W*$';
+		my $first_word = lc(($fts->words)[0]).'%';
+
+		$_.=" * (SELECT weight FROM $field_table WHERE $search_group_name.field = id)" for (@fts_ranks);
+		my $rank = join('  + ', @fts_ranks);
+
+		my %bonus = ();
+		$bonus{'subject'} = [];
+		$bonus{'author'}  = [ { "CASE WHEN $search_group_name.value ILIKE ? THEN 1.5 ELSE 1 END" => $first_word } ];
+
+		$bonus{'keyword'} = [ { "CASE WHEN $search_group_name.value ILIKE ? THEN 10 ELSE 1 END" => $SQLstring } ];
+
+		$bonus{'series'} = [
+			{ "CASE WHEN $search_group_name.value ILIKE ? THEN 1.5 ELSE 1 END" => $first_word },
+			{ "CASE WHEN $search_group_name.value ~ ? THEN 20 ELSE 1 END" => $REstring },
+		];
+
+		$bonus{'title'} = [ @{ $bonus{'series'} }, @{ $bonus{'keyword'} } ];
+
+		if ($pref_lang) {
+			push @{ $bonus{'title'}   }, { "CASE WHEN rd.item_lang = ? THEN 10 ELSE 1 END" => $pref_lang };
+			push @{ $bonus{'author'}  }, { "CASE WHEN rd.item_lang = ? THEN 10 ELSE 1 END" => $pref_lang };
+			push @{ $bonus{'subject'} }, { "CASE WHEN rd.item_lang = ? THEN 10 ELSE 1 END" => $pref_lang };
+			push @{ $bonus{'keyword'} }, { "CASE WHEN rd.item_lang = ? THEN 10 ELSE 1 END" => $pref_lang };
+			push @{ $bonus{'series'}  }, { "CASE WHEN rd.item_lang = ? THEN 10 ELSE 1 END" => $pref_lang };
+		}
+
+		my $bonus_list = join ' * ', map { keys %$_ } @{ $bonus{$search_class} };
+		$bonus_list ||= '1';
+
+		push @bonus_lists, $bonus_list;
+		push @bonus_values, map { values %$_ } @{ $bonus{$search_class} };
+
+		#---------------------
+
+		$search_table_list .= "$search_table $search_group_name, ";
+		push @rank_list,$rank;
+		$fts_list .= " AND $fts_where AND b.id = $search_group_name.source";
+
+		if ($metabib_field) {
+			$fts_list .= " AND $curr_search_group.field = " . $metabib_field->id;
+			$metabib_field = undef;
+		}
+
+		if ($prev_search_group) {
+			$join_table_list .= " AND $prev_search_group.source = $curr_search_group.source";
+		}
+	}
+
+	my $metabib_record_descriptor = metabib::record_descriptor->table;
+	my $metabib_full_rec = metabib::full_rec->table;
+	my $metabib_metarecord = metabib::metarecord->table;
+	my $metabib_metarecord_source_map_table = metabib::metarecord_source_map->table;
+	my $asset_call_number_table = asset::call_number->table;
+	my $asset_copy_table = asset::copy->table;
+	my $cs_table = config::copy_status->table;
+	my $cl_table = asset::copy_location->table;
+	my $br_table = biblio::record_entry->table;
+	my $source_table = config::bib_source->table;
+
+
+	my $bonuses = join (' * ', @bonus_lists);
+	my $relevance = join (' + ', @rank_list);
+	$relevance = "AVG( ($relevance) * ($bonuses) )";
+
+	my $string_default_sort = 'zzzz';
+	$string_default_sort = 'AAAA' if ($sort_dir eq 'DESC');
+
+	my $number_default_sort = '9999';
+	$number_default_sort = '0000' if ($sort_dir eq 'DESC');
+
+	my $rank = $relevance;
+	if (lc($sort) eq 'pubdate') {
+		$rank = <<"		RANK";
+			( FIRST ((
+				SELECT	COALESCE(SUBSTRING(frp.value FROM E'\\\\d{4}'),'$number_default_sort')::INT
+				  FROM	$metabib_full_rec frp
+				  WHERE	frp.record = b.id
+				  	AND frp.tag = '260'
+					AND frp.subfield = 'c'
+				  LIMIT 1
+			)) )
+		RANK
+	} elsif (lc($sort) eq 'create_date') {
+		$rank = <<"		RANK";
+			( FIRST (( SELECT create_date FROM $br_table rbr WHERE rbr.id = b.id)) )
+		RANK
+	} elsif (lc($sort) eq 'edit_date') {
+		$rank = <<"		RANK";
+			( FIRST (( SELECT edit_date FROM $br_table rbr WHERE rbr.id = b.id)) )
+		RANK
+	} elsif (lc($sort) eq 'title') {
+		$rank = <<"		RANK";
+			( FIRST ((
+				SELECT	COALESCE(LTRIM(SUBSTR( frt.value, COALESCE(SUBSTRING(frt.ind2 FROM E'\\\\d+'),'0')::INT + 1 )),'$string_default_sort')
+				  FROM	$metabib_full_rec frt
+				  WHERE	frt.record = b.id
+				  	AND frt.tag = '245'
+					AND frt.subfield = 'a'
+				  LIMIT 1
+			)) )
+		RANK
+	} elsif (lc($sort) eq 'author') {
+		$rank = <<"		RANK";
+			( FIRST((
+				SELECT	COALESCE(LTRIM(fra.value),'$string_default_sort')
+				  FROM	$metabib_full_rec fra
+				  WHERE	fra.record = b.id
+				  	AND fra.tag LIKE '1%'
+					AND fra.subfield = 'a'
+				  ORDER BY fra.tag::text::int
+				  LIMIT 1
+			)) )
+		RANK
+	} else {
+		push @bonus_values, @bonus_values;
+		$sort = undef;
+	}
+
+
+	my $select = <<"	SQL";
+		SELECT	b.id,
+			$relevance AS rel,
+			$rank AS rank,
+			b.source
+  	  	FROM	$search_table_list
+			$metabib_record_descriptor rd,
+			$source_table src,
+			$br_table b
+	  	WHERE	rd.record = b.id
+			AND b.active IS TRUE
+			AND b.deleted IS FALSE
+			$fts_list
+			$join_table_list
+			$t_filter
+			$f_filter
+			$v_filter
+			$a_filter
+			$l_filter
+			$lf_filter
+  	  	GROUP BY b.id, b.source
+  	  	ORDER BY 3 $sort_dir
+		LIMIT $visibility_limit
+	SQL
+
+	if ($self->api_name !~ /staff/o) {
+		$select = <<"		SQL";
+
+			SELECT	s.*
+			  FROM	($select) s
+			  	LEFT OUTER JOIN $source_table src ON (s.source = src.id)
+			  WHERE	EXISTS (
+			  	SELECT	1
+				  FROM	$asset_call_number_table cn,
+					$asset_copy_table cp,
+					$cs_table cs,
+					$cl_table cl,
+					$descendants d
+				  WHERE	cn.record = s.id
+					AND cp.status = cs.id
+					AND cp.location = cl.id
+					AND cp.call_number = cn.id
+					AND cp.opac_visible IS TRUE
+					AND cs.opac_visible IS TRUE
+					AND cl.opac_visible IS TRUE
+					AND d.opac_visible IS TRUE
+					AND cp.deleted IS FALSE
+					AND cn.deleted IS FALSE
+					AND cp.circ_lib = d.id
+					$avail_filter
+				  LIMIT 1
+			  	)
+				OR src.transcendant IS TRUE
+			  ORDER BY 3 $sort_dir
+		SQL
+	} else {
+		$select = <<"		SQL";
+
+			SELECT	s.*
+			  FROM	($select) s
+			  	LEFT OUTER JOIN $source_table src ON (s.source = src.id)
+			  WHERE	EXISTS (
+			  	SELECT	1
+				  FROM	$asset_call_number_table cn,
+					$asset_copy_table cp,
+					$descendants d
+				  WHERE	cn.record = s.id
+					AND cp.call_number = cn.id
+					AND cn.deleted IS FALSE
+					AND cp.circ_lib = d.id
+					AND cp.deleted IS FALSE
+					$avail_filter
+				  LIMIT 1
+				)
+				OR NOT EXISTS (
+				SELECT	1
+				  FROM	$asset_call_number_table cn
+				  WHERE	cn.record = s.id
+				  LIMIT 1
+				)
+				OR src.transcendant IS TRUE
+			  ORDER BY 3 $sort_dir
+		SQL
+	}
+
+
+	$log->debug("Field Search SQL :: [$select]",DEBUG);
+
+	my $recs = $_cdbi->{title}->db_Main->selectall_arrayref(
+			$select, {},
+			@bonus_values, @types, @forms, @vformats, @aud, @lang, @lit_form
+	);
+	
+	$log->debug("Search yielded ".scalar(@$recs)." results.",DEBUG);
+
+	my $count = scalar(@$recs);
+	for my $rec (@$recs[$offset .. $offset + $limit - 1]) {
+		next unless ($$rec[0]);
+		my ($mrid,$rank) = @$rec;
+		$client->respond( [$mrid, sprintf('%0.3f',$rank), $count] );
+	}
+	return undef;
+}
+
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.biblio.multiclass.search_fts.record",
+	method		=> 'biblio_search_multi_class_fts',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.biblio.multiclass.search_fts.record.staff",
+	method		=> 'biblio_search_multi_class_fts',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.biblio.multiclass.search_fts",
+	method		=> 'biblio_search_multi_class_fts',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.biblio.multiclass.search_fts.staff",
+	method		=> 'biblio_search_multi_class_fts',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+
+
+my %locale_map;
+my $default_preferred_language;
+my $default_preferred_language_weight;
+
+# XXX factored most of the PG dependant stuff out of here... need to find a way to do "dependants".
+sub staged_fts {
+    my $self   = shift;
+    my $client = shift;
+    my %args   = @_;
+
+    if (!$locale_map{COMPLETE}) {
+
+        my @locales = config::i18n_locale->search_where({ code => { '<>' => '' } });
+        for my $locale ( @locales ) {
+            $locale_map{lc($locale->code)} = $locale->marc_code;
+        }
+        $locale_map{COMPLETE} = 1;
+
+    }
+
+    if (!$default_preferred_language) {
+
+        $default_preferred_language = OpenSRF::Utils::SettingsClient
+            ->new
+            ->config_value(
+                apps => 'open-ils.storage' => app_settings => 'default_preferred_language'
+        );
+
+    }
+
+    if (!$default_preferred_language_weight) {
+
+        $default_preferred_language_weight = OpenSRF::Utils::SettingsClient
+            ->new
+            ->config_value(
+                apps => 'open-ils.storage' => app_settings => 'default_preferred_language_weight'
+        );
+
+    }
+
+    # inclusion, exclusion, delete_adjusted_inclusion, delete_adjusted_exclusion
+    my $estimation_strategy = $args{estimation_strategy} || 'inclusion';
+
+    my $ou     = $args{org_unit};
+    my $limit  = $args{limit}  || 10;
+    my $offset = $args{offset} ||  0;
+
+	if (!$ou) {
+		$ou = actor::org_unit->search( { parent_ou => undef } )->next->id;
+	}
+
+	if (! scalar( keys %{$args{searches}} )) {
+		die "No search arguments were passed to ".$self->api_name;
+	}
+
+	my (@between,@statuses,@locations,@types,@forms,@lang,@aud,@lit_form,@vformats,@bib_level);
+
+    if (!defined($args{preferred_language})) {
+		my $ses_locale = $client->session ? $client->session->session_locale : $default_preferred_language;
+        $args{preferred_language} =
+            $locale_map{ lc($ses_locale) } || 'eng';
+    }
+
+    if (!defined($args{preferred_language_weight})) {
+        $args{preferred_language_weight} = $default_preferred_language_weight || 2;
+    }
+
+	if ($args{available}) {
+		@statuses = (0,7,12);
+	}
+
+	if (my $s = $args{locations}) {
+		$s = [$s] if (!ref($s));
+		@locations = @$s;
+	}
+
+	if (my $b = $args{between}) {
+		if (ref($b) && @$b == 2) {
+		    @between = @$b;
+        }
+	}
+
+	if (my $s = $args{statuses}) {
+		$s = [$s] if (!ref($s));
+		@statuses = @$s;
+	}
+
+	if (my $a = $args{audience}) {
+		$a = [$a] if (!ref($a));
+		@aud = @$a;
+	}
+
+	if (my $l = $args{language}) {
+		$l = [$l] if (!ref($l));
+		@lang = @$l;
+	}
+
+	if (my $f = $args{lit_form}) {
+		$f = [$f] if (!ref($f));
+		@lit_form = @$f;
+	}
+
+	if (my $f = $args{item_form}) {
+		$f = [$f] if (!ref($f));
+		@forms = @$f;
+	}
+
+	if (my $t = $args{item_type}) {
+		$t = [$t] if (!ref($t));
+		@types = @$t;
+	}
+
+	if (my $b = $args{bib_level}) {
+		$b = [$b] if (!ref($b));
+		@bib_level = @$b;
+	}
+
+	if (my $v = $args{vr_format}) {
+		$v = [$v] if (!ref($v));
+		@vformats = @$v;
+	}
+
+	# XXX legacy format and item type support
+	if ($args{format}) {
+		my ($t, $f) = split '-', $args{format};
+		@types = split '', $t;
+		@forms = split '', $f;
+	}
+
+    my %stored_proc_search_args;
+	for my $search_group (sort keys %{$args{searches}}) {
+		(my $search_group_name = $search_group) =~ s/\|/_/gso;
+		my ($search_class,$search_field) = split /\|/, $search_group;
+		$log->debug("Searching class [$search_class] and field [$search_field]",DEBUG);
+
+		if ($search_field) {
+			unless ( config::metabib_field->search( field_class => $search_class, name => $search_field )->next ) {
+				$log->warn("Requested class [$search_class] or field [$search_field] does not exist!");
+				return undef;
+			}
+		}
+
+		my $class = $_cdbi->{$search_class};
+		my $search_table = $class->table;
+
+		my ($index_col) = $class->columns('FTS');
+		$index_col ||= 'value';
+
+		
+		my $fts = OpenILS::Application::Storage::FTS->compile(
+            $search_class => $args{searches}{$search_group}{term},
+            $search_group_name.'.value',
+            "$search_group_name.$index_col"
+        );
+		$fts->sql_where_clause; # this builds the ranks for us
+
+		my @fts_ranks   = $fts->fts_rank;
+		my @fts_queries = $fts->fts_query;
+		my @phrases = map { lc($_) } $fts->phrases;
+		my @words   = map { lc($_) } $fts->words;
+
+        $stored_proc_search_args{$search_group} = {
+            fts_rank    => \@fts_ranks,
+            fts_query   => \@fts_queries,
+            phrase      => \@phrases,
+            word        => \@words,
+        };
+
+	}
+
+	my $param_search_ou = $ou;
+	my $param_depth = $args{depth}; $param_depth = 'NULL' unless (defined($param_depth) and length($param_depth) > 0 );
+	my $param_searches = OpenSRF::Utils::JSON->perl2JSON( \%stored_proc_search_args ); $param_searches =~ s/\$//go; $param_searches = '$$'.$param_searches.'$$';
+	my $param_statuses  = '$${' . join(',', map { s/\$//go; "\"$_\"" } @statuses ) . '}$$';
+	my $param_locations = '$${' . join(',', map { s/\$//go; "\"$_\"" } @locations) . '}$$';
+	my $param_audience  = '$${' . join(',', map { s/\$//go; "\"$_\"" } @aud      ) . '}$$';
+	my $param_language  = '$${' . join(',', map { s/\$//go; "\"$_\"" } @lang     ) . '}$$';
+	my $param_lit_form  = '$${' . join(',', map { s/\$//go; "\"$_\"" } @lit_form ) . '}$$';
+	my $param_types     = '$${' . join(',', map { s/\$//go; "\"$_\"" } @types    ) . '}$$';
+	my $param_forms     = '$${' . join(',', map { s/\$//go; "\"$_\"" } @forms    ) . '}$$';
+	my $param_vformats  = '$${' . join(',', map { s/\$//go; "\"$_\"" } @vformats ) . '}$$';
+    my $param_bib_level = '$${' . join(',', map { s/\$//go; "\"$_\"" } @bib_level) . '}$$';
+	my $param_before = $args{before}; $param_before = 'NULL' unless (defined($param_before) and length($param_before) > 0 );
+	my $param_after  = $args{after} ; $param_after  = 'NULL' unless (defined($param_after ) and length($param_after ) > 0 );
+	my $param_during = $args{during}; $param_during = 'NULL' unless (defined($param_during) and length($param_during) > 0 );
+    my $param_between = '$${"' . join('","', map { int($_) } @between) . '"}$$';
+	my $param_pref_lang = $args{preferred_language}; $param_pref_lang =~ s/\$//go; $param_pref_lang = '$$'.$param_pref_lang.'$$';
+	my $param_pref_lang_multiplier = $args{preferred_language_weight}; $param_pref_lang_multiplier ||= 'NULL';
+	my $param_sort = $args{'sort'}; $param_sort =~ s/\$//go; $param_sort = '$$'.$param_sort.'$$';
+	my $param_sort_desc = defined($args{sort_dir}) && $args{sort_dir} =~ /^d/io ? "'t'" : "'f'";
+	my $metarecord = $self->api_name =~ /metabib/o ? "'t'" : "'f'";
+	my $staff = $self->api_name =~ /staff/o ? "'t'" : "'f'";
+    my $param_rel_limit = $args{core_limit};  $param_rel_limit ||= 'NULL';
+    my $param_chk_limit = $args{check_limit}; $param_chk_limit ||= 'NULL';
+    my $param_skip_chk  = $args{skip_check};  $param_skip_chk  ||= 'NULL';
+
+	my $sth = metabib::metarecord_source_map->db_Main->prepare(<<"    SQL");
+        SELECT  *
+          FROM  search.staged_fts(
+                    $param_search_ou\:\:INT,
+                    $param_depth\:\:INT,
+                    $param_searches\:\:TEXT,
+                    $param_statuses\:\:INT[],
+                    $param_locations\:\:INT[],
+                    $param_audience\:\:TEXT[],
+                    $param_language\:\:TEXT[],
+                    $param_lit_form\:\:TEXT[],
+                    $param_types\:\:TEXT[],
+                    $param_forms\:\:TEXT[],
+                    $param_vformats\:\:TEXT[],
+                    $param_bib_level\:\:TEXT[],
+                    $param_before\:\:TEXT,
+                    $param_after\:\:TEXT,
+                    $param_during\:\:TEXT,
+                    $param_between\:\:TEXT[],
+                    $param_pref_lang\:\:TEXT,
+                    $param_pref_lang_multiplier\:\:REAL,
+                    $param_sort\:\:TEXT,
+                    $param_sort_desc\:\:BOOL,
+                    $metarecord\:\:BOOL,
+                    $staff\:\:BOOL,
+                    $param_rel_limit\:\:INT,
+                    $param_chk_limit\:\:INT,
+                    $param_skip_chk\:\:INT
+                );
+    SQL
+
+    $sth->execute;
+
+    my $recs = $sth->fetchall_arrayref({});
+    my $summary_row = pop @$recs;
+
+    my $total    = $$summary_row{total};
+    my $checked  = $$summary_row{checked};
+    my $visible  = $$summary_row{visible};
+    my $deleted  = $$summary_row{deleted};
+    my $excluded = $$summary_row{excluded};
+
+    my $estimate = $visible;
+    if ( $total > $checked && $checked ) {
+
+        $$summary_row{hit_estimate} = FTS_paging_estimate($self, $client, $checked, $visible, $excluded, $deleted, $total);
+        $estimate = $$summary_row{estimated_hit_count} = $$summary_row{hit_estimate}{$estimation_strategy};
+
+    }
+
+    delete $$summary_row{id};
+    delete $$summary_row{rel};
+    delete $$summary_row{record};
+
+    $client->respond( $summary_row );
+
+	$log->debug("Search yielded ".scalar(@$recs)." checked, visible results with an approximate visible total of $estimate.",DEBUG);
+
+	for my $rec (@$recs[$offset .. $offset + $limit - 1]) {
+        delete $$rec{checked};
+        delete $$rec{visible};
+        delete $$rec{excluded};
+        delete $$rec{deleted};
+        delete $$rec{total};
+        $$rec{rel} = sprintf('%0.3f',$$rec{rel});
+
+		$client->respond( $rec );
+	}
+	return undef;
+}
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.biblio.multiclass.staged.search_fts",
+	method		=> 'staged_fts',
+	api_level	=> 0,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.biblio.multiclass.staged.search_fts.staff",
+	method		=> 'staged_fts',
+	api_level	=> 0,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.metabib.multiclass.staged.search_fts",
+	method		=> 'staged_fts',
+	api_level	=> 0,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.metabib.multiclass.staged.search_fts.staff",
+	method		=> 'staged_fts',
+	api_level	=> 0,
+	stream		=> 1,
+	cachable	=> 1,
+);
+
+sub FTS_paging_estimate {
+    my $self   = shift;
+    my $client = shift;
+
+    my $checked  = shift;
+    my $visible  = shift;
+    my $excluded = shift;
+    my $deleted  = shift;
+    my $total    = shift;
+
+    my $deleted_ratio = $deleted / $checked;
+    my $delete_adjusted_total = $total - ( $total * $deleted_ratio );
+
+    my $exclusion_ratio = $excluded / $checked;
+    my $delete_adjusted_exclusion_ratio = $excluded / ($checked - $deleted);
+
+    my $inclusion_ratio = $visible / $checked;
+    my $delete_adjusted_inclusion_ratio = $visible / ($checked - $deleted);
+
+    return {
+        exclusion                   => int($delete_adjusted_total - ( $delete_adjusted_total * $exclusion_ratio )),
+        inclusion                   => int($delete_adjusted_total * $inclusion_ratio),
+        delete_adjusted_exclusion   => int($delete_adjusted_total - ( $delete_adjusted_total * $delete_adjusted_exclusion_ratio )),
+        delete_adjusted_inclusion   => int($delete_adjusted_total * $delete_adjusted_inclusion_ratio)
+    };
+}
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.fts_paging_estimate",
+	method		=> 'FTS_paging_estimate',
+    argc        => 5,
+    strict      => 1,
+	api_level	=> 1,
+    signature   => {
+        'return'=> q#
+            Hash of estimation values based on four variant estimation strategies:
+                exclusion -- Estimate based on the ratio of excluded records on the current superpage;
+                inclusion -- Estimate based on the ratio of visible records on the current superpage;
+                delete_adjusted_exclusion -- Same as exclusion strategy, but the ratio is adjusted by deleted count;
+                delete_adjusted_inclusion -- Same as inclusion strategy, but the ratio is adjusted by deleted count;
+        #,
+        desc    => q#
+            Helper method used to determin the approximate number of
+            hits for a search that spans multiple superpages.  For
+            sparse superpages, the inclusion estimate will likely be the
+            best estimate.  The exclusion strategy is the original, but
+            inclusion is the default.
+        #,
+        params  => [
+            {   name    => 'checked',
+                desc    => 'Number of records check -- nominally the size of a superpage, or a remaining amount from the last superpage.',
+                type    => 'number'
+            },
+            {   name    => 'visible',
+                desc    => 'Number of records visible to the search location on the current superpage.',
+                type    => 'number'
+            },
+            {   name    => 'excluded',
+                desc    => 'Number of records excluded from the search location on the current superpage.',
+                type    => 'number'
+            },
+            {   name    => 'deleted',
+                desc    => 'Number of deleted records on the current superpage.',
+                type    => 'number'
+            },
+            {   name    => 'total',
+                desc    => 'Total number of records up to check_limit (superpage_size * max_superpages).',
+                type    => 'number'
+            }
+        ]
+    }
+);
+
+
+sub xref_count {
+    my $self   = shift;
+    my $client = shift;
+    my $args   = shift;
+
+    my $term  = $$args{term};
+    my $limit = $$args{max} || 1;
+    my $min   = $$args{min} || 1;
+	my @classes = @{$$args{class}};
+
+	$limit = $min if ($min > $limit);
+
+	if (!@classes) {
+		@classes = ( qw/ title author subject series keyword / );
+	}
+
+	my %matches;
+	my $bre_table = biblio::record_entry->table;
+	my $cn_table  = asset::call_number->table;
+	my $cp_table  = asset::copy->table;
+
+	for my $search_class ( @classes ) {
+
+		my $class = $_cdbi->{$search_class};
+		my $search_table = $class->table;
+
+		my ($index_col) = $class->columns('FTS');
+		$index_col ||= 'value';
+
+		
+		my $where = OpenILS::Application::Storage::FTS
+			->compile($search_class => $term, $search_class.'.value', "$search_class.$index_col")
+			->sql_where_clause;
+
+		my $SQL = <<"		SQL";
+			SELECT	COUNT(DISTINCT X.source)
+			  FROM	(SELECT	$search_class.source
+				  FROM	$search_table $search_class
+					JOIN $bre_table b ON (b.id = $search_class.source)
+				  WHERE	$where
+				  	AND NOT b.deleted
+					AND b.active
+				  LIMIT $limit) X
+			  HAVING COUNT(DISTINCT X.source) >= $min;
+		SQL
+
+		my $res = $class->db_Main->selectrow_arrayref( $SQL );
+		$matches{$search_class} = $res ? $res->[0] : 0;
+	}
+
+	return \%matches;
+}
+__PACKAGE__->register_method(
+    api_name  => "open-ils.storage.search.xref",
+    method    => 'xref_count',
+    api_level => 1,
+);
+
+sub query_parser_fts {
+    my $self = shift;
+    my $client = shift;
+    my %args = @_;
+
+
+    # grab the query parser and initialize it
+    my $parser = $OpenILS::Application::Storage::QParser;
+    $parser->use;
+
+    if (!$parser->initialization_complete) {
+        my $cstore = OpenSRF::AppSession->create( 'open-ils.cstore' );
+        $parser->initialize(
+            config_metabib_field_index_norm_map =>
+                $cstore->request(
+                    'open-ils.cstore.direct.config.metabib_field_index_norm_map.search.atomic',
+                    { id => { "!=" => undef } },
+                    { flesh => 1, flesh_fields => { cmfinm => [qw/norm/] }, order_by => [{ class => "cmfinm", field => "pos" }] }
+                )->gather(1),
+            search_relevance_adjustment         =>
+                $cstore->request(
+                    'open-ils.cstore.direct.search.relevance_adjustment.search.atomic',
+                    { id => { "!=" => undef } }
+                )->gather(1),
+            config_metabib_field                =>
+                $cstore->request(
+                    'open-ils.cstore.direct.config.metabib_field.search.atomic',
+                    { id => { "!=" => undef } }
+                )->gather(1),
+            config_metabib_search_alias         =>
+                $cstore->request(
+                    'open-ils.cstore.direct.config.metabib_search_alias.search.atomic',
+                    { alias => { "!=" => undef } }
+                )->gather(1),
+        );
+
+        $cstore->disconnect;
+        die("Cannot initialize $parser!") unless ($parser->initialization_complete);
+    }
+
+
+    # populate the locale/language map
+    if (!$locale_map{COMPLETE}) {
+
+        my @locales = config::i18n_locale->search_where({ code => { '<>' => '' } });
+        for my $locale ( @locales ) {
+            $locale_map{lc($locale->code)} = $locale->marc_code;
+        }
+        $locale_map{COMPLETE} = 1;
+
+    }
+
+    # I hope we have a query!
+	if (! $args{query} ) {
+		die "No query was passed to ".$self->api_name;
+	}
+
+
+    my $simple_plan = $args{_simple_plan};
+    # remove bad chunks of the %args hash
+    for my $bad ( grep { /^_/ } keys(%args)) {
+        delete($args{$bad});
+    }
+
+
+    # parse the query and supply any query-level %arg-based defaults
+    # we expect, and make use of, query, superpage, superpage_size, debug and core_limit args
+    my $query = $parser->new( %args )->parse;
+
+
+    # set the locale-based default prefered location
+    if (!$query->parse_tree->find_filter('preferred_language')) {
+        $parser->default_preferred_language( $args{preferred_language} );
+        if (!$parser->default_preferred_language) {
+		    my $ses_locale = $client->session ? $client->session->session_locale : '';
+            $parser->default_preferred_language( $locale_map{ lc($ses_locale) } );
+        }
+        $parser->default_preferred_language(
+            OpenSRF::Utils::SettingsClient->new->config_value(
+                apps => 'open-ils.storage' => app_settings => 'default_preferred_language'
+            )
+        ) if (!$parser->default_preferred_language);
+    }
+
+
+    # set the global default language multiplier
+    if (!$query->parse_tree->find_filter('preferred_language_weight') and !$query->parse_tree->find_filter('preferred_language_multiplier')) {
+        $parser->default_preferred_language_multiplier($args{preferred_language_weight});
+        $parser->default_preferred_language_multiplier($args{preferred_language_multiplier});
+        $parser->default_preferred_language_multiplier(
+            OpenSRF::Utils::SettingsClient->new->config_value(
+                apps => 'open-ils.storage' => app_settings => 'default_preferred_language_weight'
+            )
+        ) if (!$parser->default_preferred_language_multiplier);
+    }
+
+    # gather the site, if one is specified, defaulting to the in-query version
+	my $ou = $args{org_unit};
+	if (my ($filter) = $query->parse_tree->find_filter('site')) {
+            $ou = $filter->args->[0] if (@{$filter->args});
+    }
+	$ou = actor::org_unit->search( { shortname => $ou } )->next->id if ($ou and $ou !~ /^\d+$/);
+
+
+    # gather lasso, as with $ou
+	my $lasso = $args{lasso};
+	if (my ($filter) = $query->parse_tree->find_filter('lasso')) {
+            $lasso = $filter->args->[0] if (@{$filter->args});
+    }
+	$lasso = actor::org_lasso->search( { name => $lasso } )->next->id if ($lasso and $lasso !~ /^\d+$/);
+    $lasso = -$lasso if ($lasso);
+
+
+#    # XXX once we have org_unit containers, we can make user-defined lassos .. WHEEE
+#    # gather user lasso, as with $ou and lasso
+#    my $mylasso = $args{my_lasso};
+#    if (my ($filter) = $query->parse_tree->find_filter('my_lasso')) {
+#            $mylasso = $filter->args->[0] if (@{$filter->args});
+#    }
+#    $mylasso = actor::org_unit->search( { name => $mylasso } )->next->id if ($mylasso and $mylasso !~ /^\d+$/);
+
+
+    # if we have a lasso, go with that, otherwise ... ou
+    $ou = $lasso if ($lasso);
+
+
+    # get the default $ou if we have nothing
+	$ou = actor::org_unit->search( { parent_ou => undef } )->next->id if (!$ou and !$lasso and !$mylasso);
+
+
+    # XXX when user lassos are here, check to make sure we don't have one -- it'll be passed in the depth, with an ou of 0
+    # gather the depth, if one is specified, defaulting to the in-query version
+	my $depth = $args{depth};
+	if (my ($filter) = $query->parse_tree->find_filter('depth')) {
+            $depth = $filter->args->[0] if (@{$filter->args});
+    }
+	$depth = actor::org_unit->search_where( [{ name => $depth },{ opac_label => $depth }], {limit => 1} )->next->id if ($depth and $depth !~ /^\d+$/);
+
+
+    # gather the limit or default to 10
+	my $limit = $args{check_limit} || 'NULL';
+	if (my ($filter) = $query->parse_tree->find_filter('limit')) {
+            $limit = $filter->args->[0] if (@{$filter->args});
+    }
+	if (my ($filter) = $query->parse_tree->find_filter('check_limit')) {
+            $limit = $filter->args->[0] if (@{$filter->args});
+    }
+
+
+    # gather the offset or default to 0
+	my $offset = $args{skip_check} || $args{offset} || 0;
+	if (my ($filter) = $query->parse_tree->find_filter('offset')) {
+            $offset = $filter->args->[0] if (@{$filter->args});
+    }
+	if (my ($filter) = $query->parse_tree->find_filter('skip_check')) {
+            $offset = $filter->args->[0] if (@{$filter->args});
+    }
+
+
+    # gather the estimation strategy or default to inclusion
+    my $estimation_strategy = $args{estimation_strategy} || 'inclusion';
+	if (my ($filter) = $query->parse_tree->find_filter('estimation_strategy')) {
+            $estimation_strategy = $filter->args->[0] if (@{$filter->args});
+    }
+
+
+    # gather the estimation strategy or default to inclusion
+    my $core_limit = $args{core_limit};
+	if (my ($filter) = $query->parse_tree->find_filter('core_limit')) {
+            $core_limit = $filter->args->[0] if (@{$filter->args});
+    }
+
+
+    # gather statuses, and then forget those if we have an #available modifier
+    my @statuses;
+    if (my ($filter) = $query->parse_tree->find_filter('statuses')) {
+        @statuses = @{$filter->args} if (@{$filter->args});
+    }
+    @statuses = (0,7,12) if ($query->parse_tree->find_modifier('available'));
+
+
+    # gather locations
+    my @location;
+    if (my ($filter) = $query->parse_tree->find_filter('locations')) {
+        @location = @{$filter->args} if (@{$filter->args});
+    }
+
+
+    my $param_check = $limit || $query->superpage_size || 'NULL';
+    my $param_offset = $offset || 'NULL';
+    my $param_limit = $core_limit || 'NULL';
+
+    my $sp = $query->superpage || 1;
+    if ($sp > 1) {
+        $param_offset = ($sp - 1) * $sp_size;
+    }
+
+	my $param_search_ou = $ou;
+	my $param_depth = $depth; $param_depth = 'NULL' unless (defined($depth) and length($depth) > 0 );
+	my $param_core_query = "\$core_query_$$\$" . $query->parse_tree->toSQL . "\$core_query_$$\$";
+	my $param_statuses = '$${' . join(',', map { s/\$//go; "\"$_\""} @statuses) . '}$$';
+	my $param_locations = '$${' . join(',', map { s/\$//go; "\"$_\""} @location) . '}$$';
+	my $staff = ($self->api_name =~ /staff/ or $query->parse_tree->find_modifier('staff')) ? "'t'" : "'f'";
+	my $metarecord = ($self->api_name =~ /metabib/ or $query->parse_tree->find_modifier('metabib') or $query->parse_tree->find_modifier('metarecord')) ? "'t'" : "'f'";
+
+	my $sth = metabib::metarecord_source_map->db_Main->prepare(<<"    SQL");
+        SELECT  * /* bib search */
+          FROM  search.query_parser_fts(
+                    $param_search_ou\:\:INT,
+                    $param_depth\:\:INT,
+                    $param_core_query\:\:TEXT,
+                    $param_statuses\:\:INT[],
+                    $param_locations\:\:INT[],
+                    $param_offset\:\:INT,
+                    $param_check\:\:INT,
+                    $param_limit\:\:INT,
+                    $metarecord\:\:BOOL,
+                    $staff\:\:BOOL
+                );
+    SQL
+
+    $sth->execute;
+
+    my $recs = $sth->fetchall_arrayref({});
+    my $summary_row = pop @$recs;
+
+    my $total    = $$summary_row{total};
+    my $checked  = $$summary_row{checked};
+    my $visible  = $$summary_row{visible};
+    my $deleted  = $$summary_row{deleted};
+    my $excluded = $$summary_row{excluded};
+
+    my $estimate = $visible;
+    if ( $total > $checked && $checked ) {
+
+        $$summary_row{hit_estimate} = FTS_paging_estimate($self, $client, $checked, $visible, $excluded, $deleted, $total);
+        $estimate = $$summary_row{estimated_hit_count} = $$summary_row{hit_estimate}{$estimation_strategy};
+
+    }
+
+    delete $$summary_row{id};
+    delete $$summary_row{rel};
+    delete $$summary_row{record};
+
+    if (defined($simple_plan)) {
+        $$summary_row{complex_query} = $simple_plan ? 0 : 1;
+    } else {
+        $$summary_row{complex_query} = $query->simple_plan ? 0 : 1;
+    }
+
+    $client->respond( $summary_row );
+
+	$log->debug("Search yielded ".scalar(@$recs)." checked, visible results with an approximate visible total of $estimate.",DEBUG);
+
+	for my $rec (@$recs) {
+        delete $$rec{checked};
+        delete $$rec{visible};
+        delete $$rec{excluded};
+        delete $$rec{deleted};
+        delete $$rec{total};
+        $$rec{rel} = sprintf('%0.3f',$$rec{rel});
+
+		$client->respond( $rec );
+	}
+	return undef;
+}
+
+sub query_parser_fts_wrapper {
+	my $self = shift;
+	my $client = shift;
+	my %args = @_;
+
+ 	$log->debug("Entering compatability wrapper function for old-style staged search", DEBUG);
+    # grab the query parser and initialize it
+    my $parser = $OpenILS::Application::Storage::QParser;
+    $parser->use;
+
+    if (!$parser->initialization_complete) {
+        my $cstore = OpenSRF::AppSession->create( 'open-ils.cstore' );
+        $parser->initialize(
+            config_metabib_field_index_norm_map =>
+                $cstore->request(
+                    'open-ils.cstore.direct.config.metabib_field_index_norm_map.search.atomic',
+                    { id => { "!=" => undef } },
+                    { flesh => 1, flesh_fields => { cmfinm => [qw/norm/] }, order_by => [{ class => "cmfinm", field => "pos" }] }
+                )->gather(1),
+            search_relevance_adjustment         =>
+                $cstore->request(
+                    'open-ils.cstore.direct.search.relevance_adjustment.search.atomic',
+                    { id => { "!=" => undef } }
+                )->gather(1),
+            config_metabib_field                =>
+                $cstore->request(
+                    'open-ils.cstore.direct.config.metabib_field.search.atomic',
+                    { id => { "!=" => undef } }
+                )->gather(1),
+            config_metabib_search_alias         =>
+                $cstore->request(
+                    'open-ils.cstore.direct.config.metabib_search_alias.search.atomic',
+                    { alias => { "!=" => undef } }
+                )->gather(1),
+        );
+
+        $cstore->disconnect;
+        die("Cannot initialize $parser!") unless ($parser->initialization_complete);
+    }
+
+	if (! scalar( keys %{$args{searches}} )) {
+		die "No search arguments were passed to ".$self->api_name;
+	}
+
+ 	$log->debug("Constructing QueryParser query from staged search hash ...", DEBUG);
+    my $base_query = '';
+    for my $sclass ( keys %{$args{searches}} ) {
+ 	    $log->debug(" --> staged search key: $sclass --> term: $args{searches}{$sclass}{term}", DEBUG);
+        $base_query .= " $sclass: $args{searches}{$sclass}{term}";
+    }
+
+    my $query = $base_query;
+    $log->debug("Full base query: $base_query", DEBUG);
+
+    $query = "$args{facets} $query" if  ($args{facets});
+
+    if (!$locale_map{COMPLETE}) {
+
+        my @locales = config::i18n_locale->search_where({ code => { '<>' => '' } });
+        for my $locale ( @locales ) {
+            $locale_map{lc($locale->code)} = $locale->marc_code;
+        }
+        $locale_map{COMPLETE} = 1;
+
+    }
+
+    my $base_plan = $parser->new( query => $base_query )->parse;
+
+    $query = "preferred_language($args{preferred_language}) $query"
+        if ($args{preferred_language} and !$base_plan->parse_tree->find_filter('preferred_language'));
+    $query = "preferred_language_weight($args{preferred_language_weight}) $query"
+        if ($args{preferred_language_weight} and !$base_plan->parse_tree->find_filter('preferred_language_weight') and !$base_plan->parse_tree->find_filter('preferred_language_multiplier'));
+
+    $query = "estimation_strategy($args{estimation_strategy}) $query" if ($args{estimation_strategy});
+    $query = "site($args{org_unit}) $query" if ($args{org_unit});
+    $query = "depth($args{depth}) $query" if (defined($args{depth}));
+    $query = "sort($args{sort}) $query" if ($args{sort});
+    $query = "limit($args{limit}) $query" if ($args{limit});
+    $query = "core_limit($args{core_limit}) $query" if ($args{core_limit});
+    $query = "skip_check($args{skip_check}) $query" if ($args{skip_check});
+    $query = "superpage($args{superpage}) $query" if ($args{superpage});
+    $query = "offset($args{offset}) $query" if ($args{offset});
+    $query = "#metarecord $query" if ($self->api_name =~ /metabib/);
+    $query = "#available $query" if ($args{available});
+    $query = "#descending $query" if ($args{sort_dir} && $args{sort_dir} =~ /^d/i);
+    $query = "#staff $query" if ($self->api_name =~ /staff/);
+    $query = "before($args{before}) $query" if (defined($args{before}) and $args{before} =~ /^\d+$/);
+    $query = "after($args{after}) $query" if (defined($args{after}) and $args{after} =~ /^\d+$/);
+    $query = "during($args{during}) $query" if (defined($args{during}) and $args{during} =~ /^\d+$/);
+    $query = "between($args{between}[0],$args{between}[1]) $query"
+        if ( ref($args{between}) and @{$args{between}} == 2 and $args{between}[0] =~ /^\d+$/ and $args{between}[1] =~ /^\d+$/ );
+
+
+	my (@between,@statuses,@locations,@types,@forms,@lang,@aud,@lit_form,@vformats,@bib_level);
+
+	# XXX legacy format and item type support
+	if ($args{format}) {
+		my ($t, $f) = split '-', $args{format};
+		$args{item_type} = [ split '', $t ];
+		$args{item_form} = [ split '', $f ];
+	}
+
+    for my $filter ( qw/locations statuses between audience language lit_form item_form item_type bib_level vr_format/ ) {
+    	if (my $s = $args{$filter}) {
+    		$s = [$s] if (!ref($s));
+
+    		my @filter_list = @$s;
+
+            next if ($filter eq 'between' and scalar(@filter_list) != 2);
+            next if (@filter_list == 0);
+
+            my $filter_string = join ',', @filter_list;
+            $query = "$filter($filter_string) $query";
+	    }
+    }
+
+    $log->debug("Full QueryParser query: $query", DEBUG);
+
+    return query_parser_fts($self, $client, query => $query, _simple_plan => $base_plan->simple_plan );
+}
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.biblio.multiclass.staged.search_fts",
+	method		=> 'query_parser_fts_wrapper',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.biblio.multiclass.staged.search_fts.staff",
+	method		=> 'query_parser_fts_wrapper',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.metabib.multiclass.staged.search_fts",
+	method		=> 'query_parser_fts_wrapper',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+__PACKAGE__->register_method(
+	api_name	=> "open-ils.storage.metabib.multiclass.staged.search_fts.staff",
+	method		=> 'query_parser_fts_wrapper',
+	api_level	=> 1,
+	stream		=> 1,
+	cachable	=> 1,
+);
+
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/money.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/money.pm
new file mode 100644
index 0000000000..22ab1f308d
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/money.pm
@@ -0,0 +1,612 @@
+package OpenILS::Application::Storage::Publisher::money;
+use base qw/OpenILS::Application::Storage/;
+use OpenSRF::Utils::Logger qw/:level/;
+
+my $log = 'OpenSRF::Utils::Logger';
+
+sub _make_mbts {
+        my @xacts = @_;
+
+        my @mbts;
+        for my $x (@xacts) {
+                my $s = new Fieldmapper::money::billable_transaction_summary;
+                $s->id( $x->id );
+                $s->usr( $x->usr );
+                $s->xact_start( $x->xact_start );
+                $s->xact_finish( $x->xact_finish );
+
+                my $to = 0;
+                my $lb = undef;
+                for my $b ($x->billings) {
+                        next if ($b->voided);
+			#$log->debug( "billing is ".$b->amount, DEBUG );
+                        $to += ($b->amount * 100);
+                        $lb ||= $b->billing_ts;
+                        if ($b->billing_ts ge $lb) {
+                                $lb = $b->billing_ts;
+                                $s->last_billing_note($b->note);
+                                $s->last_billing_ts($b->billing_ts);
+                                $s->last_billing_type($b->billing_type);
+                        }
+                }
+
+                $s->total_owed( sprintf('%0.2f', ($to) / 100 ) );
+
+                my $tp = 0;
+                my $lp = undef;
+                for my $p ($x->payments) {
+			#$log->debug( "payment is ".$p->amount." voided = ".$p->voided, DEBUG );
+                        next if ($p->voided eq 't');
+                        $tp += ($p->amount * 100);
+                        $lp ||= $p->payment_ts;
+                        if ($p->payment_ts ge $lp) {
+                                $lp = $p->payment_ts;
+                                $s->last_payment_note($p->note);
+                                $s->last_payment_ts($p->payment_ts);
+                                $s->last_payment_type($p->payment_type);
+                        }
+                }
+                $s->total_paid( sprintf('%0.2f', ($tp) / 100 ) );
+
+                $s->balance_owed( sprintf('%0.2f', (($to) - ($tp)) / 100) );
+		#$log->debug( "balance of ".$x->id." == ".$s->balance_owed, DEBUG );
+
+                if (action::circulation->retrieve($x->id)) {
+                    $s->xact_type( 'circulation' );
+                } elsif (money::grocery->retrieve($x->id)) {
+                    $s->xact_type( 'grocery' );
+                } elsif (booking::reservation->retrieve($x->id)) {
+                    $s->xact_type( 'reservation' );
+                }
+
+                push @mbts, $s;
+        }
+
+        return @mbts;
+}
+
+sub search_mbts {
+	my $self = shift;
+	my $client = shift;
+	my $search = shift;
+
+	my @xacts = money::billable_transaction->search_where( $search );
+	$client->respond( $_ ) for (_make_mbts(@xacts));
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	method		=> 'search_mbts',
+	api_name	=> 'open-ils.storage.money.billable_transaction.summary.search',
+	stream		=> 1,
+	argc		=> 1,
+);
+
+sub search_ous {
+	my $self = shift;
+	my $client = shift;
+	my $usr = shift;
+
+	my @xacts = $self->method_lookup( 'open-ils.storage.money.billable_transaction.summary.search' )->run( { usr => $usr, xact_finish => undef } );
+
+	my ($total,$owed,$paid) = (0.0,0.0,0.0);
+	for my $x (@xacts) {
+		$total += $x->total_owed;
+		$owed += $x->balance_owed;
+		$paid += $x->total_paid;
+	}
+
+	my $ous = Fieldmapper::money::open_user_summary->new;
+	$ous->usr( $usr );
+	$ous->total_paid( sprintf('%0.2f', $paid) );
+	$ous->total_owed( sprintf('%0.2f', $total) );
+	$ous->balance_owed( sprintf('%0.2f', $owed) );
+
+	return $ous;
+}
+__PACKAGE__->register_method(
+	method		=> 'search_ous',
+	api_name	=> 'open-ils.storage.money.open_user_summary.search',
+	argc		=> 1,
+);
+
+
+sub new_collections {
+	my $self = shift;
+	my $client = shift;
+	my $age = shift;
+	my $amount = shift;
+	my @loc = @_;
+
+	my $mct = money::collections_tracker->table;
+	my $mb = money::billing->table;
+	my $circ = action::circulation->table;
+	my $mg = money::grocery->table;
+	my $res = booking::reservation->table;
+	my $descendants = "actor.org_unit_descendants((select id from actor.org_unit where shortname = ?))";
+
+	my $SQL = <<"	SQL";
+
+select
+        usr,
+        MAX(last_billing) as last_pertinent_billing,
+        SUM(total_billing) - SUM(COALESCE(p.amount,0)) as threshold_amount
+  from  (select
+                x.id,
+                x.usr,
+                MAX(b.billing_ts) as last_billing,
+                SUM(b.amount) AS total_billing
+          from  action.circulation x
+                left join money.collections_tracker c ON (c.usr = x.usr AND c.location = ?)
+                join money.billing b on (b.xact = x.id)
+          where x.xact_finish is null
+                and c.id is null
+                and x.circ_lib in (XX)
+                and b.billing_ts < current_timestamp - ? * '1 day'::interval
+                and not b.voided
+          group by 1,2
+
+                  union all
+
+         select
+                x.id,
+                x.usr,
+                MAX(b.billing_ts) as last_billing,
+                SUM(b.amount) AS total_billing
+          from  money.grocery x
+                left join money.collections_tracker c ON (c.usr = x.usr AND c.location = ?)
+                join money.billing b on (b.xact = x.id)
+          where x.xact_finish is null
+                and c.id is null
+                and x.billing_location in (XX)
+                and b.billing_ts < current_timestamp - ? * '1 day'::interval
+                and not b.voided
+          group by 1,2
+
+                  union all
+
+         select
+                x.id,
+                x.usr,
+                MAX(b.billing_ts) as last_billing,
+                SUM(b.amount) AS total_billing
+          from  booking.reservation x
+                left join money.collections_tracker c ON (c.usr = x.usr AND c.location = ?)
+                join money.billing b on (b.xact = x.id)
+          where x.xact_finish is null
+                and c.id is null
+                and x.pickup_lib in (XX)
+                and b.billing_ts < current_timestamp - ? * '1 day'::interval
+                and not b.voided
+          group by 1,2
+        ) full_list
+        left join money.payment p on (full_list.id = p.xact)
+  group by 1
+  having SUM(total_billing) - SUM(COALESCE(p.amount,0)) > ?
+;
+	SQL
+
+	my @l_ids;
+	for my $l (@loc) {
+		my ($org) = actor::org_unit->search( shortname => uc($l) );
+		next unless $org;
+
+		my $o_list = actor::org_unit->db_Main->selectcol_arrayref( "SELECT id FROM actor.org_unit_descendants(?);", {}, $org->id );
+		next unless (@$o_list);
+
+		my $o_txt = join ',' => @$o_list;
+
+		(my $real_sql = $SQL) =~ s/XX/$o_txt/gsm;
+
+		my $sth = money::collections_tracker->db_Main->prepare($real_sql);
+		$sth->execute( $org->id, $age, $org->id, $age, $org->id, $age, $amount );
+
+		while (my $row = $sth->fetchrow_hashref) {
+			#$row->{usr} = actor::user->retrieve($row->{usr})->to_fieldmapper;
+			$client->respond( $row );
+		}
+	}
+	return undef;
+}
+__PACKAGE__->register_method(
+	method		=> 'new_collections',
+	api_name	=> 'open-ils.storage.money.collections.users_of_interest',
+	stream		=> 1,
+	argc		=> 3,
+);
+
+sub users_owing_money {
+	my $self = shift;
+	my $client = shift;
+	my $start = shift;
+	my $end = shift;
+	my $amount = shift;
+	my @loc = @_;
+
+	my $mct = money::collections_tracker->table;
+	my $mb = money::billing->table;
+	my $circ = action::circulation->table;
+	my $mg = money::grocery->table;
+	my $descendants = "actor.org_unit_descendants((select id from actor.org_unit where shortname = ?))";
+
+	my $SQL = <<"	SQL";
+
+select
+        usr,
+        SUM(total_billing) - SUM(COALESCE(p.amount,0)) as threshold_amount
+  from  (select
+                x.id,
+                x.usr,
+                SUM(b.amount) AS total_billing
+          from  action.circulation x
+                join money.billing b on (b.xact = x.id)
+          where x.xact_finish is null
+                and x.circ_lib in (XX)
+                and b.billing_ts between ? and ?
+                and not b.voided
+          group by 1,2
+
+                  union all
+
+         select
+                x.id,
+                x.usr,
+                SUM(b.amount) AS total_billing
+          from  money.grocery x
+                join money.billing b on (b.xact = x.id)
+          where x.xact_finish is null
+                and x.billing_location in (XX)
+                and b.billing_ts between ? and ?
+                and not b.voided
+          group by 1,2
+
+                  union all
+
+         select
+                x.id,
+                x.usr,
+                SUM(b.amount) AS total_billing
+          from  booking.reservation x
+                join money.billing b on (b.xact = x.id)
+          where x.xact_finish is null
+                and x.pickup_lib in (XX)
+                and b.billing_ts between ? and ?
+                and not b.voided
+          group by 1,2
+        ) full_list
+        left join money.payment p on (full_list.id = p.xact)
+  group by 1
+  having SUM(total_billing) - SUM(COALESCE(p.amount,0)) > ?
+;
+	SQL
+
+	my @l_ids;
+	for my $l (@loc) {
+		my ($org) = actor::org_unit->search( shortname => uc($l) );
+		next unless $org;
+
+		my $o_list = actor::org_unit->db_Main->selectcol_arrayref( "SELECT id FROM actor.org_unit_descendants(?);", {}, $org->id );
+		next unless (@$o_list);
+
+		my $o_txt = join ',' => @$o_list;
+
+		(my $real_sql = $SQL) =~ s/XX/$o_txt/gsm;
+
+		my $sth = money::collections_tracker->db_Main->prepare($real_sql);
+		$sth->execute( $start, $end, $start, $end, $amount );
+
+		while (my $row = $sth->fetchrow_hashref) {
+			#$row->{usr} = actor::user->retrieve($row->{usr})->to_fieldmapper;
+			$client->respond( $row );
+		}
+	}
+	return undef;
+}
+__PACKAGE__->register_method(
+	method		=> 'users_owing_money',
+	api_name	=> 'open-ils.storage.money.collections.users_owing_money',
+	stream		=> 1,
+	argc		=> 4,
+);
+
+sub active_in_collections {
+	my $self = shift;
+	my $client = shift;
+	my $startdate = shift;
+	my $enddate = shift;
+	my @loc = @_;
+
+	my $mct = money::collections_tracker->table;
+	my $mb = money::billing->table;
+	my $circ = action::circulation->table;
+	my $mg = money::grocery->table;
+
+	my $SQL = <<"	SQL";
+SELECT  usr,
+        MAX(last_pertinent_billing) AS last_pertinent_billing,
+        MAX(last_pertinent_payment) AS last_pertinent_payment
+  FROM  (
+                SELECT  lt.usr,
+                        NULL::TIMESTAMPTZ AS last_pertinent_billing,
+                        NULL::TIMESTAMPTZ AS last_pertinent_payment
+                  FROM  booking.reservation lt
+                        JOIN money.collections_tracker cl ON (lt.usr = cl.usr)
+                        JOIN money.billing bl ON (lt.id = bl.xact)
+                  WHERE cl.location = ?
+                        AND lt.pickup_lib IN (XX)
+                        AND bl.void_time BETWEEN ? AND ?
+                  GROUP BY 1
+
+                                UNION ALL
+                SELECT  lt.usr,
+                        MAX(bl.billing_ts) AS last_pertinent_billing,
+                        NULL::TIMESTAMPTZ AS last_pertinent_payment
+                  FROM  booking.reservation lt
+                        JOIN money.collections_tracker cl ON (lt.usr = cl.usr)
+                        JOIN money.billing bl ON (lt.id = bl.xact)
+                  WHERE cl.location = ?
+                        AND lt.pickup_lib IN (XX)
+                        AND bl.billing_ts BETWEEN ? AND ?
+                  GROUP BY 1
+
+                                UNION ALL
+                SELECT  lt.usr,
+                        NULL::TIMESTAMPTZ AS last_pertinent_billing,
+                        MAX(pm.payment_ts) AS last_pertinent_payment
+                  FROM  booking.reservation lt
+                        JOIN money.collections_tracker cl ON (lt.usr = cl.usr)
+                        JOIN money.payment pm ON (lt.id = pm.xact)
+                  WHERE cl.location = ?
+                        AND lt.pickup_lib IN (XX)
+                        AND pm.payment_ts BETWEEN ? AND ?
+                  GROUP BY 1
+
+                                UNION ALL
+                 SELECT  lt.usr,
+                        NULL::TIMESTAMPTZ AS last_pertinent_billing,
+                        NULL::TIMESTAMPTZ AS last_pertinent_payment
+                  FROM  money.grocery lt
+                        JOIN money.collections_tracker cl ON (lt.usr = cl.usr)
+                        JOIN money.billing bl ON (lt.id = bl.xact)
+                  WHERE cl.location = ?
+                        AND lt.billing_location IN (XX)
+                        AND bl.void_time BETWEEN ? AND ?
+                  GROUP BY 1
+
+                                UNION ALL
+                SELECT  lt.usr,
+                        MAX(bl.billing_ts) AS last_pertinent_billing,
+                        NULL::TIMESTAMPTZ AS last_pertinent_payment
+                  FROM  money.grocery lt
+                        JOIN money.collections_tracker cl ON (lt.usr = cl.usr)
+                        JOIN money.billing bl ON (lt.id = bl.xact)
+                  WHERE cl.location = ?
+                        AND lt.billing_location IN (XX)
+                        AND bl.billing_ts BETWEEN ? AND ?
+                  GROUP BY 1
+
+                                UNION ALL
+                SELECT  lt.usr,
+                        NULL::TIMESTAMPTZ AS last_pertinent_billing,
+                        MAX(pm.payment_ts) AS last_pertinent_payment
+                  FROM  money.grocery lt
+                        JOIN money.collections_tracker cl ON (lt.usr = cl.usr)
+                        JOIN money.payment pm ON (lt.id = pm.xact)
+                  WHERE cl.location = ?
+                        AND lt.billing_location IN (XX)
+                        AND pm.payment_ts BETWEEN ? AND ?
+                  GROUP BY 1
+
+                                UNION ALL
+                SELECT  lt.usr,
+                        NULL::TIMESTAMPTZ AS last_pertinent_billing,
+                        NULL::TIMESTAMPTZ AS last_pertinent_payment
+                  FROM  action.circulation lt
+                        JOIN money.collections_tracker cl ON (lt.usr = cl.usr)
+                  WHERE cl.location = ?
+                        AND lt.circ_lib IN (XX)
+                        AND lt.checkin_time BETWEEN ? AND ?
+                  GROUP BY 1
+
+                                UNION ALL
+                SELECT  lt.usr,
+                        NULL::TIMESTAMPTZ AS last_pertinent_billing,
+                        MAX(pm.payment_ts) AS last_pertinent_payment
+                  FROM  action.circulation lt
+                        JOIN money.collections_tracker cl ON (lt.usr = cl.usr)
+                        JOIN money.payment pm ON (lt.id = pm.xact)
+                  WHERE cl.location = ?
+                        AND lt.circ_lib IN (XX)
+                        AND pm.payment_ts BETWEEN ? AND ?
+                  GROUP BY 1
+
+                                UNION ALL
+                SELECT  lt.usr,
+                        NULL::TIMESTAMPTZ AS last_pertinent_billing,
+                        NULL::TIMESTAMPTZ AS last_pertinent_payment
+                  FROM  action.circulation lt
+                        JOIN money.collections_tracker cl ON (lt.usr = cl.usr)
+                        JOIN money.billing bl ON (lt.id = bl.xact)
+                  WHERE cl.location = ?
+                        AND lt.circ_lib IN (XX)
+                        AND bl.void_time BETWEEN ? AND ?
+                  GROUP BY 1
+
+                                UNION ALL
+                SELECT  lt.usr,
+                        MAX(bl.billing_ts) AS last_pertinent_billing,
+                        NULL::TIMESTAMPTZ AS last_pertinent_payment
+                  FROM  action.circulation lt
+                        JOIN money.collections_tracker cl ON (lt.usr = cl.usr)
+                        JOIN money.billing bl ON (lt.id = bl.xact)
+                  WHERE cl.location = ?
+                        AND lt.circ_lib IN (XX)
+                        AND bl.billing_ts BETWEEN ? AND ?
+                  GROUP BY 1
+        ) foo
+  GROUP BY 1
+;
+	SQL
+
+	my @l_ids;
+	for my $l (@loc) {
+		my ($org) = actor::org_unit->search( shortname => uc($l) );
+		next unless $org;
+
+		my $o_list = actor::org_unit->db_Main->selectcol_arrayref( "SELECT id FROM actor.org_unit_descendants(?);", {}, $org->id );
+		next unless (@$o_list);
+
+		my $o_txt = join ',' => @$o_list;
+
+		(my $real_sql = $SQL) =~ s/XX/$o_txt/gsm;
+
+		my $sth = money::collections_tracker->db_Main->prepare($real_sql);
+		$sth->execute(
+            # reservation queries
+			$org->id, $startdate, $enddate,
+			$org->id, $startdate, $enddate,
+			$org->id, $startdate, $enddate,
+
+            # grocery queries
+			$org->id, $startdate, $enddate,
+			$org->id, $startdate, $enddate,
+			$org->id, $startdate, $enddate,
+
+            # circ queries
+			$org->id, $startdate, $enddate,
+			$org->id, $startdate, $enddate,
+			$org->id, $startdate, $enddate,
+			$org->id, $startdate, $enddate
+		);
+
+		while (my $row = $sth->fetchrow_hashref) {
+			$row->{usr} = actor::user->retrieve($row->{usr})->to_fieldmapper;
+			$client->respond( $row );
+		}
+	}
+	return undef;
+}
+__PACKAGE__->register_method(
+	method		=> 'active_in_collections',
+	api_name	=> 'open-ils.storage.money.collections.users_with_activity',
+	stream		=> 1,
+	argc		=> 3,
+);
+
+sub ou_desk_payments {
+	my $self = shift;
+	my $client = shift;
+	my $lib = shift;
+	my $startdate = shift;
+	my $enddate = shift;
+
+	return undef unless ($startdate =~ /^\d{4}-\d{2}-\d{2}$/o);
+	return undef unless ($enddate =~ /^\d{4}-\d{2}-\d{2}$/o);
+	return undef unless ($lib =~ /^\d+$/o);
+
+	my $sql = <<"	SQL";
+
+	SELECT	ws.id as workstation,
+		SUM( CASE WHEN p.payment_type = 'cash_payment' THEN p.amount ELSE 0.0 END ) as cash_payment,
+		SUM( CASE WHEN p.payment_type = 'check_payment' THEN p.amount ELSE 0.0 END ) as check_payment,
+		SUM( CASE WHEN p.payment_type = 'credit_card_payment' THEN p.amount ELSE 0.0 END ) as credit_card_payment
+	  FROM	money.desk_payment_view p
+		JOIN actor.workstation ws ON (ws.id = p.cash_drawer)
+	  WHERE	p.payment_ts >= '$startdate'
+		AND p.payment_ts < '$enddate'::TIMESTAMPTZ + INTERVAL '1 day'
+		AND p.voided IS FALSE
+		AND ws.owning_lib = $lib
+	 GROUP BY 1
+	 ORDER BY 1;
+
+	SQL
+
+	my $rows = money::payment->db_Main->selectall_arrayref( $sql );
+
+	for my $r (@$rows) {
+		my $x = new Fieldmapper::money::workstation_payment_summary;
+		$x->workstation( actor::workstation->retrieve($$r[0])->to_fieldmapper );
+		$x->cash_payment($$r[1]);
+		$x->check_payment($$r[2]);
+		$x->credit_card_payment($$r[3]);
+
+		$client->respond($x);
+	}
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	method		=> 'ou_desk_payments',
+	api_name	=> 'open-ils.storage.money.org_unit.desk_payments',
+	stream		=> 1,
+	argc		=> 3,
+);
+
+sub ou_user_payments {
+	my $self = shift;
+	my $client = shift;
+	my $lib = shift;
+	my $startdate = shift;
+	my $enddate = shift;
+
+	return undef unless ($startdate =~ /^\d{4}-\d{2}-\d{2}$/o);
+	return undef unless ($enddate =~ /^\d{4}-\d{2}-\d{2}$/o);
+	return undef unless ($lib =~ /^\d+$/o);
+
+	my $sql = <<"	SQL";
+
+       	SELECT	au.id as usr,
+		SUM( CASE WHEN p.payment_type = 'forgive_payment' THEN p.amount ELSE 0.0 END ) as forgive_payment,
+		SUM( CASE WHEN p.payment_type = 'work_payment' THEN p.amount ELSE 0.0 END ) as work_payment,
+		SUM( CASE WHEN p.payment_type = 'credit_payment' THEN p.amount ELSE 0.0 END ) as credit_payment,
+		SUM( CASE WHEN p.payment_type = 'goods_payment' THEN p.amount ELSE 0.0 END ) as goods_payment
+          FROM  money.bnm_payment_view p
+                JOIN actor.usr au ON (au.id = p.accepting_usr)
+          WHERE p.payment_ts >= '$startdate'
+                AND p.payment_ts < '$enddate'::TIMESTAMPTZ + INTERVAL '1 day'
+                AND p.voided IS FALSE
+                AND au.home_ou = $lib
+		AND p.payment_type IN ('credit_payment','forgive_payment','work_payment','goods_payment')
+         GROUP BY 1
+         ORDER BY 1;
+
+	SQL
+
+	my $rows = money::payment->db_Main->selectall_arrayref( $sql );
+
+	for my $r (@$rows) {
+		my $x = new Fieldmapper::money::user_payment_summary;
+		$x->usr( actor::user->retrieve($$r[0])->to_fieldmapper );
+		$x->forgive_payment($$r[1]);
+		$x->work_payment($$r[2]);
+		$x->credit_payment($$r[3]);
+		$x->goods_payment($$r[4]);
+
+		$client->respond($x);
+	}
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	method		=> 'ou_user_payments',
+	api_name	=> 'open-ils.storage.money.org_unit.user_payments',
+	stream		=> 1,
+	argc		=> 3,
+);
+
+sub mark_unrecovered {
+	my $self = shift;
+	my $xact = shift;
+
+    my $x = money::billable_xact->retrieve($xact);
+    $x->unrecovered( 't' );
+    return $x->update;
+}
+__PACKAGE__->register_method(
+	method		=> 'mark_unrecovered',
+	api_name	=> 'open-ils.storage.money.billable_xact.mark_unrecovered',
+	argc		=> 1,
+);
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/permission.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/permission.pm
new file mode 100644
index 0000000000..5253627bc9
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Publisher/permission.pm
@@ -0,0 +1,110 @@
+package OpenILS::Application::Storage::Publisher::permission;
+use base qw/OpenILS::Application::Storage/;
+#use OpenILS::Application::Storage::CDBI::config;
+
+
+sub retrieve_all {
+	my $self = shift;
+	my $client = shift;
+
+	for my $rec ( permission::grp_tree->retrieve_all ) {
+		$client->respond( $rec->to_fieldmapper );
+	}
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	method		=> 'retrieve_all',
+	api_name	=> 'open-ils.storage.direct.permission.grp_tree.retrieve.all',
+	argc		=> 0,
+	stream		=> 1,
+);
+
+sub retrieve_perms {
+	my $self = shift;
+	my $client = shift;
+
+	for my $rec ( sort { $a->code cmp $b->code } permission::perm_list->retrieve_all ) {
+		$client->respond( $rec->to_fieldmapper );
+	}
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	method		=> 'retrieve_perms',
+	api_name	=> 'open-ils.storage.direct.permission.perm_list.retrieve.all',
+	argc		=> 0,
+	stream		=> 1,
+);
+
+sub usr_has_perm {
+	my $self = shift;
+	my $client = shift;
+	my $usr = shift;
+	my $perm = shift;
+	my $target = shift;
+
+	return permission::usr_grp_map->db_Main->selectrow_arrayref(<<"	SQL",{}, "$usr", "$perm", "$target")->[0];
+		SELECT permission.usr_has_perm(?,?,?)
+	SQL
+}
+__PACKAGE__->register_method(
+	method		=> 'usr_has_perm',
+	api_name	=> 'open-ils.storage.permission.user_has_perm',
+	argc		=> 3,
+);
+
+sub usr_has_home_perm {
+	my $self = shift;
+	my $client = shift;
+	my $usr = shift;
+	my $perm = shift;
+	my $target = shift;
+
+	return permission::usr_grp_map->db_Main->selectrow_arrayref(<<"	SQL",{}, "$usr", "$perm", "$target")->[0];
+		SELECT permission.usr_has_home_perm(?,?,?)
+	SQL
+}
+__PACKAGE__->register_method(
+	method		=> 'usr_has_home_perm',
+	api_name	=> 'open-ils.storage.permission.user_has_home_perm',
+	argc		=> 3,
+);
+
+sub usr_has_work_perm {
+	my $self = shift;
+	my $client = shift;
+	my $usr = shift;
+	my $perm = shift;
+	my $target = shift;
+
+	return permission::usr_grp_map->db_Main->selectrow_arrayref(<<"	SQL",{}, "$usr", "$perm", "$target")->[0];
+		SELECT permission.usr_has_work_perm(?,?,?)
+	SQL
+}
+__PACKAGE__->register_method(
+	method		=> 'usr_has_work_perm',
+	api_name	=> 'open-ils.storage.permission.user_has_work_perm',
+	argc		=> 3,
+);
+
+sub usr_perms {
+	my $self = shift;
+	my $client = shift;
+	my $usr = shift;
+
+	my $sth = permission::usr_perm_map->db_Main->prepare('SELECT DISTINCT * FROM permission.usr_perms(?)');
+	$sth->execute("$usr");
+
+	$client->respond( $_->to_fieldmapper ) for ( map { permission::usr_perm_map->construct($_) } $sth->fetchall_hash );
+
+	return undef;
+}
+__PACKAGE__->register_method(
+	method		=> 'usr_perms',
+	api_name	=> 'open-ils.storage.permission.user_perms',
+	argc		=> 1,
+	stream		=> 1,
+);
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/QueryParser.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/QueryParser.pm
new file mode 100644
index 0000000000..6338384388
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/QueryParser.pm
@@ -0,0 +1,1091 @@
+package QueryParser;
+our %parser_config = (
+    QueryParser => {
+        filters => [],
+        modifiers => [],
+        operators => { 
+            'and' => '&&',
+            'or' => '||',
+            group_start => '(',
+            group_end => ')',
+            required => '+',
+            modifier => '#'
+        }
+    }
+);
+
+sub facet_class_count {
+    my $self = shift;
+    return @{$self->facet_classes};
+}
+
+sub search_class_count {
+    my $self = shift;
+    return @{$self->search_classes};
+}
+
+sub filter_count {
+    my $self = shift;
+    return @{$self->filters};
+}
+
+sub modifier_count {
+    my $self = shift;
+    return @{$self->modifiers};
+}
+
+sub custom_data {
+    my $class = shift;
+    $class = ref($class) || $class;
+
+    $parser_config{$class}{custom_data} ||= {};
+    return $parser_config{$class}{custom_data};
+}
+
+sub operators {
+    my $class = shift;
+    $class = ref($class) || $class;
+
+    $parser_config{$class}{operators} ||= {};
+    return $parser_config{$class}{operators};
+}
+
+sub filters {
+    my $class = shift;
+    $class = ref($class) || $class;
+
+    $parser_config{$class}{filters} ||= [];
+    return $parser_config{$class}{filters};
+}
+
+sub modifiers {
+    my $class = shift;
+    $class = ref($class) || $class;
+
+    $parser_config{$class}{modifiers} ||= [];
+    return $parser_config{$class}{modifiers};
+}
+
+sub new {
+    my $class = shift;
+    $class = ref($class) || $class;
+
+    my %opts = @_;
+
+    my $self = bless {} => $class;
+
+    for my $o (keys %{QueryParser->operators}) {
+        $class->operator($o => QueryParser->operator($o)) unless ($class->operator($o));
+    }
+
+    for my $opt ( keys %opts) {
+        $self->$opt( $opts{$opt} ) if ($self->can($opt));
+    }
+
+    return $self;
+}
+
+sub new_plan {
+    my $self = shift;
+    my $pkg = ref($self) || $self;
+    return do{$pkg.'::query_plan'}->new( QueryParser => $self, @_ );
+}
+
+sub add_search_filter {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $filter = shift;
+
+    return $filter if (grep { $_ eq $filter } @{$pkg->filters});
+    push @{$pkg->filters}, $filter;
+    return $filter;
+}
+
+sub add_search_modifier {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $modifier = shift;
+
+    return $modifier if (grep { $_ eq $modifier } @{$pkg->modifiers});
+    push @{$pkg->modifiers}, $modifier;
+    return $modifier;
+}
+
+sub add_facet_class {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $class = shift;
+
+    return $class if (grep { $_ eq $class } @{$pkg->facet_classes});
+
+    push @{$pkg->facet_classes}, $class;
+    $pkg->facet_fields->{$class} = [];
+
+    return $class;
+}
+
+sub add_search_class {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $class = shift;
+
+    return $class if (grep { $_ eq $class } @{$pkg->search_classes});
+
+    push @{$pkg->search_classes}, $class;
+    $pkg->search_fields->{$class} = [];
+    $pkg->default_search_class( $pkg->search_classes->[0] ) if (@{$pkg->search_classes} == 1);
+
+    return $class;
+}
+
+sub operator {
+    my $class = shift;
+    $class = ref($class) || $class;
+    my $opname = shift;
+    my $op = shift;
+
+    return undef unless ($opname);
+
+    $parser_config{$class}{operators} ||= {};
+    $parser_config{$class}{operators}{$opname} = $op if ($op);
+
+    return $parser_config{$class}{operators}{$opname};
+}
+
+sub facet_classes {
+    my $class = shift;
+    $class = ref($class) || $class;
+    my $classes = shift;
+
+    $parser_config{$class}{facet_classes} ||= [];
+    $parser_config{$class}{facet_classes} = $classes if (ref($classes) && @$classes);
+    return $parser_config{$class}{facet_classes};
+}
+
+sub search_classes {
+    my $class = shift;
+    $class = ref($class) || $class;
+    my $classes = shift;
+
+    $parser_config{$class}{classes} ||= [];
+    $parser_config{$class}{classes} = $classes if (ref($classes) && @$classes);
+    return $parser_config{$class}{classes};
+}
+
+sub add_query_normalizer {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $class = shift;
+    my $field = shift;
+    my $func = shift;
+    my $params = shift || [];
+
+    return $func if (grep { $_ eq $func } @{$pkg->query_normalizers->{$class}->{$field}});
+
+    push(@{$pkg->query_normalizers->{$class}->{$field}}, { function => $func, params => $params });
+
+    return $func;
+}
+
+sub query_normalizers {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+
+    my $class = shift;
+    my $field = shift;
+
+    $parser_config{$pkg}{normalizers} ||= {};
+    if ($class) {
+        if ($field) {
+            $parser_config{$pkg}{normalizers}{$class}{$field} ||= [];
+            return $parser_config{$pkg}{normalizers}{$class}{$field};
+        } else {
+            return $parser_config{$pkg}{normalizers}{$class};
+        }
+    }
+
+    return $parser_config{$pkg}{normalizers};
+}
+
+sub default_search_class {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $class = shift;
+    $QueryParser::parser_config{$pkg}{default_class} = $pkg->add_search_class( $class ) if $class;
+
+    return $QueryParser::parser_config{$pkg}{default_class};
+}
+
+sub remove_facet_class {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $class = shift;
+
+    return $class if (!grep { $_ eq $class } @{$pkg->facet_classes});
+
+    $pkg->facet_classes( [ grep { $_ ne $class } @{$pkg->facet_classes} ] );
+    delete $QueryParser::parser_config{$pkg}{facet_fields}{$class};
+
+    return $class;
+}
+
+sub remove_search_class {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $class = shift;
+
+    return $class if (!grep { $_ eq $class } @{$pkg->search_classes});
+
+    $pkg->search_classes( [ grep { $_ ne $class } @{$pkg->search_classes} ] );
+    delete $QueryParser::parser_config{$pkg}{fields}{$class};
+
+    return $class;
+}
+
+sub add_facet_field {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $class = shift;
+    my $field = shift;
+
+    $pkg->add_facet_class( $class );
+
+    return { $class => $field }  if (grep { $_ eq $field } @{$pkg->facet_fields->{$class}});
+
+    push @{$pkg->facet_fields->{$class}}, $field;
+
+    return { $class => $field };
+}
+
+sub facet_fields {
+    my $class = shift;
+    $class = ref($class) || $class;
+
+    $parser_config{$class}{facet_fields} ||= {};
+    return $parser_config{$class}{facet_fields};
+}
+
+sub add_search_field {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $class = shift;
+    my $field = shift;
+
+    $pkg->add_search_class( $class );
+
+    return { $class => $field }  if (grep { $_ eq $field } @{$pkg->search_fields->{$class}});
+
+    push @{$pkg->search_fields->{$class}}, $field;
+
+    return { $class => $field };
+}
+
+sub search_fields {
+    my $class = shift;
+    $class = ref($class) || $class;
+
+    $parser_config{$class}{fields} ||= {};
+    return $parser_config{$class}{fields};
+}
+
+sub add_search_class_alias {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $class = shift;
+    my $alias = shift;
+
+    $pkg->add_search_class( $class );
+
+    return { $class => $alias }  if (grep { $_ eq $alias } @{$pkg->search_class_aliases->{$class}});
+
+    push @{$pkg->search_class_aliases->{$class}}, $alias;
+
+    return { $class => $alias };
+}
+
+sub search_class_aliases {
+    my $class = shift;
+    $class = ref($class) || $class;
+
+    $parser_config{$class}{class_map} ||= {};
+    return $parser_config{$class}{class_map};
+}
+
+sub add_search_field_alias {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $class = shift;
+    my $field = shift;
+    my $alias = shift;
+
+    return { $class => { $field => $alias } }  if (grep { $_ eq $alias } @{$pkg->search_field_aliases->{$class}{$field}});
+
+    push @{$pkg->search_field_aliases->{$class}{$field}}, $alias;
+
+    return { $class => { $field => $alias } };
+}
+
+sub search_field_aliases {
+    my $class = shift;
+    $class = ref($class) || $class;
+
+    $parser_config{$class}{field_alias_map} ||= {};
+    return $parser_config{$class}{field_alias_map};
+}
+
+sub remove_facet_field {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $class = shift;
+    my $field = shift;
+
+    return { $class => $field }  if (!$pkg->facet_fields->{$class} || !grep { $_ eq $field } @{$pkg->facet_fields->{$class}});
+
+    $pkg->facet_fields->{$class} = [ grep { $_ ne $field } @{$pkg->facet_fields->{$class}} ];
+
+    return { $class => $field };
+}
+
+sub remove_search_field {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $class = shift;
+    my $field = shift;
+
+    return { $class => $field }  if (!$pkg->search_fields->{$class} || !grep { $_ eq $field } @{$pkg->search_fields->{$class}});
+
+    $pkg->search_fields->{$class} = [ grep { $_ ne $field } @{$pkg->search_fields->{$class}} ];
+
+    return { $class => $field };
+}
+
+sub remove_search_field_alias {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $class = shift;
+    my $field = shift;
+    my $alias = shift;
+
+    return { $class => { $field => $alias } }  if (!$pkg->search_field_aliases->{$class}{$field} || !grep { $_ eq $alias } @{$pkg->search_field_aliases->{$class}{$field}});
+
+    $pkg->search_field_aliases->{$class}{$field} = [ grep { $_ ne $alias } @{$pkg->search_field_aliases->{$class}{$field}} ];
+
+    return { $class => { $field => $alias } };
+}
+
+sub remove_search_class_alias {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $class = shift;
+    my $alias = shift;
+
+    return { $class => $alias }  if (!$pkg->search_class_aliases->{$class} || !grep { $_ eq $alias } @{$pkg->search_class_aliases->{$class}});
+
+    $pkg->search_class_aliases->{$class} = [ grep { $_ ne $alias } @{$pkg->search_class_aliases->{$class}} ];
+
+    return { $class => $alias };
+}
+
+sub debug {
+    my $self = shift;
+    my $q = shift;
+    $self->{_debug} = $q if (defined $q);
+    return $self->{_debug};
+}
+
+sub query {
+    my $self = shift;
+    my $q = shift;
+    $self->{_query} = $q if (defined $q);
+    return $self->{_query};
+}
+
+sub parse_tree {
+    my $self = shift;
+    my $q = shift;
+    $self->{_parse_tree} = $q if (defined $q);
+    return $self->{_parse_tree};
+}
+
+sub parse {
+    my $self = shift;
+    my $pkg = ref($self) || $self;
+    warn " ** parse package is $pkg\n" if $self->debug;
+    $self->parse_tree(
+        $self->decompose(
+            $self->query( shift() )
+        )
+    );
+
+    return $self;
+}
+
+sub decompose {
+    my $self = shift;
+    my $pkg = ref($self) || $self;
+
+    warn " ** decompose package is $pkg\n" if $self->debug;
+
+    $_ = shift;
+    my $current_class = shift || $self->default_search_class;
+
+    my $recursing = shift || 0;
+
+    # Build the search class+field uber-regexp
+    my $search_class_re = '^\s*(';
+    my $first_class = 1;
+
+    my %seen_classes;
+    for my $class ( keys %{$pkg->search_fields} ) {
+
+        for my $field ( @{$pkg->search_fields->{$class}} ) {
+
+            for my $alias ( @{$pkg->search_field_aliases->{$class}{$field}} ) {
+                $alias = qr/$alias/;
+                s/(^|\s+)$alias[:=]/$1$class\|$field:/g;
+            }
+        }
+
+        $search_class_re .= '|' unless ($first_class);
+        $first_class = 0;
+        $search_class_re .= $class . '(?:\|\w+)*';
+        $seen_classes{$class} = 1;
+    }
+
+    for my $class ( keys %{$pkg->search_class_aliases} ) {
+
+        for my $alias ( @{$pkg->search_class_aliases->{$class}} ) {
+            $alias = qr/$alias/;
+            s/(^|[^|])\b$alias\|/$1$class\|/g;
+            s/(^|[^|])\b$alias[:=]/$1$class:/g;
+        }
+
+        $search_class_re .= '|' unless ($first_class);
+        $first_class = 0;
+
+        $search_class_re .= $class . '(?:\|\w+)*' if (!$seen_classes{$class});
+        $seen_classes{$class} = 1;
+    }
+    $search_class_re .= '):';
+
+    warn " ** Search class RE: $search_class_re\n" if $self->debug;
+
+    my $required_re = $pkg->operator('required');
+    $required_re = qr/^\s*\Q$required_re\E/;
+    my $and_re = $pkg->operator('and');
+    $and_re = qr/^\s*\Q$and_re\E/;
+
+    my $or_re = $pkg->operator('or');
+    $or_re = qr/^\s*\Q$or_re\E/;
+
+    my $group_start_re = $pkg->operator('group_start');
+    $group_start_re = qr/^\s*\Q$group_start_re\E/;
+
+    my $group_end = $pkg->operator('group_end');
+    my $group_end_re = qr/^\s*\Q$group_end\E/;
+
+    my $modifier_tag_re = $pkg->operator('modifier');
+    $modifier_tag_re = qr/^\s*\Q$modifier_tag_re\E/;
+
+
+    # Build the filter and modifier uber-regexps
+    my $facet_re = '^\s*((?:' . join( '|', @{$pkg->facet_classes}) . ')(?:\|\w+)*)\[(.+?)\]';
+    warn " Facet RE: $facet_re\n" if $self->debug;
+
+    my $filter_re = '^\s*(' . join( '|', @{$pkg->filters}) . ')\(([^()]+)\)';
+    my $filter_as_class_re = '^\s*(' . join( '|', @{$pkg->filters}) . '):\s*(\S+)';
+
+    my $modifier_re = '^\s*'.$modifier_tag_re.'(' . join( '|', @{$pkg->modifiers}) . ')\b';
+    my $modifier_as_class_re = '^\s*(' . join( '|', @{$pkg->modifiers}) . '):\s*(\S+)';
+
+    my $struct = $self->new_plan( level => $recursing );
+    my $remainder = '';
+
+    my $last_type = '';
+    while (!$remainder) {
+        if (/^\s*$/) { # end of an explicit group
+            last;
+        } elsif (/$group_end_re/) { # end of an explicit group
+            warn "Encountered explicit group end\n" if $self->debug;
+
+            $_ = $';
+            $remainder = $';
+
+            $last_type = '';
+        } elsif ($self->filter_count && /$filter_re/) { # found a filter
+            warn "Encountered search filter: $1 set to $2\n" if $self->debug;
+
+            $_ = $';
+            $struct->new_filter( $1 => [ split '[, ]+', $2 ] );
+
+            $last_type = '';
+        } elsif ($self->filter_count && /$filter_as_class_re/) { # found a filter
+            warn "Encountered search filter: $1 set to $2\n" if $self->debug;
+
+            $_ = $';
+            $struct->new_filter( $1 => [ split '[, ]+', $2 ] );
+
+            $last_type = '';
+        } elsif ($self->modifier_count && /$modifier_re/) { # found a modifier
+            warn "Encountered search modifier: $1\n" if $self->debug;
+
+            $_ = $';
+            if (!$struct->top_plan) {
+                warn "  Search modifiers only allowed at the top level of the query\n" if $self->debug;
+            } else {
+                $struct->new_modifier($1);
+            }
+
+            $last_type = '';
+        } elsif ($self->modifier_count && /$modifier_as_class_re/) { # found a modifier
+            warn "Encountered search modifier: $1\n" if $self->debug;
+
+            my $mod = $1;
+
+            $_ = $';
+            if (!$struct->top_plan) {
+                warn "  Search modifiers only allowed at the top level of the query\n" if $self->debug;
+            } elsif ($2 =~ /^[ty1]/i) {
+                $struct->new_modifier($mod);
+            }
+
+            $last_type = '';
+        } elsif (/$group_start_re/) { # start of an explicit group
+            warn "Encountered explicit group start\n" if $self->debug;
+
+            my ($substruct, $subremainder) = $self->decompose( $', $current_class, $recursing + 1 );
+            $struct->add_node( $substruct );
+            $_ = $subremainder;
+
+            $last_type = '';
+        } elsif (/$and_re/) { # ANDed expression
+            $_ = $';
+            next if ($last_type eq 'AND');
+            next if ($last_type eq 'OR');
+            warn "Encountered AND\n" if $self->debug;
+
+            $struct->joiner( '&' );
+
+            $last_type = 'AND';
+        } elsif (/$or_re/) { # ORed expression
+            $_ = $';
+            next if ($last_type eq 'AND');
+            next if ($last_type eq 'OR');
+            warn "Encountered OR\n" if $self->debug;
+
+            $struct->joiner( '|' );
+
+            $last_type = 'OR';
+        } elsif ($self->facet_class_count && /$facet_re/) { # changing current class
+            warn "Encountered facet: $1 => $2\n" if $self->debug;
+
+            my $facet = $1;
+            my $facet_value = [ split '\s*#\s*', $2 ];
+            $struct->new_facet( $facet => $facet_value );
+            $_ = $';
+
+            $last_type = '';
+        } elsif ($self->search_class_count && /$search_class_re/) { # changing current class
+
+            if ($last_type eq 'CLASS') {
+                $struct->remove_last_node( $current_class );
+                warn "Encountered class change with no searches!\n" if $self->debug;
+            }
+
+            warn "Encountered class change: $1\n" if $self->debug;
+
+            $current_class = $1;
+            $struct->classed_node( $current_class );
+            $_ = $';
+
+            $last_type = 'CLASS';
+        } elsif (/^\s*"([^"]+)"/) { # phrase, always anded
+            warn "Encountered phrase: $1\n" if $self->debug;
+
+            $struct->joiner( '&' );
+            my $phrase = $1;
+
+            my $class_node = $struct->classed_node($current_class);
+            $class_node->add_phrase( $phrase );
+            $_ = $phrase . $';
+
+            $last_type = '';
+        } elsif (/$required_re([^\s)]+)/) { # phrase, always anded
+            warn "Encountered required atom (mini phrase): $1\n" if $self->debug;
+
+            my $phrase = $1;
+
+            my $class_node = $struct->classed_node($current_class);
+            $class_node->add_phrase( $phrase );
+            $_ = $phrase . $';
+            $struct->joiner( '&' );
+
+            $last_type = '';
+        } elsif (/^\s*([^$group_end\s]+)/o) { # atom
+            warn "Encountered atom: $1\n" if $self->debug;
+            warn "Remainder: $'\n" if $self->debug;
+
+            my $atom = $1;
+            my $after = $';
+
+            $_ = $after;
+            $last_type = '';
+
+            my $negator = ($atom =~ s/^-//o) ? '!' : '';
+            my $truncate = ($atom =~ s/\*$//o) ? '*' : '';
+
+            if (!grep { $atom eq $_ } ('&','|')) { # throw away & and |, not allowed in tsquery, and not really useful anyway
+                my $class_node = $struct->classed_node($current_class);
+                $class_node->add_fts_atom( $atom, suffix => $truncate, prefix => $negator, node => $class_node );
+                $struct->joiner( '&' );
+            }
+        } 
+
+        last unless ($_);
+
+    }
+
+    return $struct if !wantarray;
+    return ($struct, $remainder);
+}
+
+sub find_class_index {
+    my $class = shift;
+    my $query = shift;
+
+    my ($class_part, @field_parts) = split '\|', $class;
+    $class_part ||= $class;
+
+    for my $idx ( 0 .. scalar(@$query) - 1 ) {
+        next unless ref($$query[$idx]);
+        return $idx if ( $$query[$idx]{requested_class} && $class eq $$query[$idx]{requested_class} );
+    }
+
+    push(@$query, { classname => $class_part, (@field_parts ? (fields => \@field_parts) : ()), requested_class => $class, ftsquery => [], phrases => [] });
+    return -1;
+}
+
+sub core_limit {
+    my $self = shift;
+    my $l = shift;
+    $self->{core_limit} = $l if ($l);
+    return $self->{core_limit};
+}
+
+sub superpage {
+    my $self = shift;
+    my $l = shift;
+    $self->{superpage} = $l if ($l);
+    return $self->{superpage};
+}
+
+sub superpage_size {
+    my $self = shift;
+    my $l = shift;
+    $self->{superpage_size} = $l if ($l);
+    return $self->{superpage_size};
+}
+
+
+#-------------------------------
+package QueryParser::query_plan;
+
+sub QueryParser {
+    my $self = shift;
+    return undef unless ref($self);
+    return $self->{QueryParser};
+}
+
+sub new {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my %args = (query => [], joiner => '&', @_);
+
+    return bless \%args => $pkg;
+}
+
+sub new_node {
+    my $self = shift;
+    my $pkg = ref($self) || $self;
+    my $node = do{$pkg.'::node'}->new( plan => $self, @_ );
+    $self->add_node( $node );
+    return $node;
+}
+
+sub new_facet {
+    my $self = shift;
+    my $pkg = ref($self) || $self;
+    my $name = shift;
+    my $args = shift;
+
+    my $node = do{$pkg.'::facet'}->new( plan => $self, name => $name, 'values' => $args );
+    $self->add_node( $node );
+
+    return $node;
+}
+
+sub new_filter {
+    my $self = shift;
+    my $pkg = ref($self) || $self;
+    my $name = shift;
+    my $args = shift;
+
+    my $node = do{$pkg.'::filter'}->new( plan => $self, name => $name, args => $args );
+    $self->add_filter( $node );
+
+    return $node;
+}
+
+sub find_filter {
+    my $self = shift;
+    my $needle = shift;;
+    return undef unless ($needle);
+    return grep { $_->name eq $needle } @{ $self->filters };
+}
+
+sub find_modifier {
+    my $self = shift;
+    my $needle = shift;;
+    return undef unless ($needle);
+    return grep { $_->name eq $needle } @{ $self->modifiers };
+}
+
+sub new_modifier {
+    my $self = shift;
+    my $pkg = ref($self) || $self;
+    my $name = shift;
+
+    my $node = do{$pkg.'::modifier'}->new( $name );
+    $self->add_modifier( $node );
+
+    return $node;
+}
+
+sub classed_node {
+    my $self = shift;
+    my $requested_class = shift;
+
+    my $node;
+    for my $n (@{$self->{query}}) {
+        next unless (ref($n) && $n->isa( 'QueryParser::query_plan::node' ));
+        if ($n->requested_class eq $requested_class) {
+            $node = $n;
+            last;
+        }
+    }
+
+    if (!$node) {
+        $node = $self->new_node;
+        $node->requested_class( $requested_class );
+    }
+
+    return $node;
+}
+
+sub remove_last_node {
+    my $self = shift;
+    my $requested_class = shift;
+
+    my $old = pop(@{$self->query_nodes});
+    pop(@{$self->query_nodes}) if (@{$self->query_nodes});
+
+    return $old;
+}
+
+sub query_nodes {
+    my $self = shift;
+    return $self->{query};
+}
+
+sub add_node {
+    my $self = shift;
+    my $node = shift;
+
+    $self->{query} ||= [];
+    push(@{$self->{query}}, $self->joiner) if (@{$self->{query}});
+    push(@{$self->{query}}, $node);
+
+    return $self;
+}
+
+sub top_plan {
+    my $self = shift;
+
+    return $self->{level} ? 0 : 1;
+}
+
+sub plan_level {
+    my $self = shift;
+    return $self->{level};
+}
+
+sub joiner {
+    my $self = shift;
+    my $joiner = shift;
+
+    $self->{joiner} = $joiner if ($joiner);
+    return $self->{joiner};
+}
+
+sub modifiers {
+    my $self = shift;
+    $self->{modifiers} ||= [];
+    return $self->{modifiers};
+}
+
+sub add_modifier {
+    my $self = shift;
+    my $modifier = shift;
+
+    $self->{modifiers} ||= [];
+    return $self if (grep {$$_ eq $$modifier} @{$self->{modifiers}});
+
+    push(@{$self->{modifiers}}, $modifier);
+
+    return $self;
+}
+
+sub facets {
+    my $self = shift;
+    $self->{facets} ||= [];
+    return $self->{facets};
+}
+
+sub add_facet {
+    my $self = shift;
+    my $facet = shift;
+
+    $self->{facets} ||= [];
+    return $self if (grep {$_->name eq $facet->name} @{$self->{facets}});
+
+    push(@{$self->{facets}}, $facet);
+
+    return $self;
+}
+
+sub filters {
+    my $self = shift;
+    $self->{filters} ||= [];
+    return $self->{filters};
+}
+
+sub add_filter {
+    my $self = shift;
+    my $filter = shift;
+
+    $self->{filters} ||= [];
+    return $self if (grep {$_->name eq $filter->name} @{$self->{filters}});
+
+    push(@{$self->{filters}}, $filter);
+
+    return $self;
+}
+
+
+#-------------------------------
+package QueryParser::query_plan::node;
+
+sub new {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my %args = @_;
+
+    return bless \%args => $pkg;
+}
+
+sub new_atom {
+    my $self = shift;
+    my $pkg = ref($self) || $self;
+    return do{$pkg.'::atom'}->new( @_ );
+}
+
+sub requested_class { # also split into classname and fields
+    my $self = shift;
+    my $class = shift;
+
+    if ($class) {
+        my ($class_part, @field_parts) = split '\|', $class;
+        $class_part ||= $class;
+
+        $self->{requested_class} = $class;
+        $self->{classname} = $class_part;
+        $self->{fields} = \@field_parts;
+    }
+
+    return $self->{requested_class};
+}
+
+sub plan {
+    my $self = shift;
+    my $plan = shift;
+
+    $self->{plan} = $plan if ($plan);
+    return $self->{plan};
+}
+
+sub classname {
+    my $self = shift;
+    my $class = shift;
+
+    $self->{classname} = $class if ($class);
+    return $self->{classname};
+}
+
+sub fields {
+    my $self = shift;
+    my @fields = @_;
+
+    $self->{fields} ||= [];
+    $self->{fields} = \@fields if (@fields);
+    return $self->{fields};
+}
+
+sub phrases {
+    my $self = shift;
+    my @phrases = @_;
+
+    $self->{phrases} ||= [];
+    $self->{phrases} = \@phrases if (@phrases);
+    return $self->{phrases};
+}
+
+sub add_phrase {
+    my $self = shift;
+    my $phrase = shift;
+
+    push(@{$self->phrases}, $phrase);
+
+    return $self;
+}
+
+sub query_atoms {
+    my $self = shift;
+    my @query_atoms = @_;
+
+    $self->{query_atoms} ||= [];
+    $self->{query_atoms} = \@query_atoms if (@query_atoms);
+    return $self->{query_atoms};
+}
+
+sub add_fts_atom {
+    my $self = shift;
+    my $atom = shift;
+
+    if (!ref($atom)) {
+        my $content = $atom;
+        my @parts = @_;
+
+        $atom = $self->new_atom( content => $content, @parts );
+    }
+
+    push(@{$self->query_atoms}, $self->plan->joiner) if (@{$self->query_atoms});
+    push(@{$self->query_atoms}, $atom);
+
+    return $self;
+}
+
+#-------------------------------
+package QueryParser::query_plan::node::atom;
+
+sub new {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my %args = @_;
+
+    return bless \%args => $pkg;
+}
+
+sub node {
+    my $self = shift;
+    return undef unless (ref $self);
+    return $self->{node};
+}
+
+sub content {
+    my $self = shift;
+    return undef unless (ref $self);
+    return $self->{content};
+}
+
+sub prefix {
+    my $self = shift;
+    return undef unless (ref $self);
+    return $self->{prefix};
+}
+
+sub suffix {
+    my $self = shift;
+    return undef unless (ref $self);
+    return $self->{suffix};
+}
+
+#-------------------------------
+package QueryParser::query_plan::filter;
+
+sub new {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my %args = @_;
+
+    return bless \%args => $pkg;
+}
+
+sub plan {
+    my $self = shift;
+    return $self->{plan};
+}
+
+sub name {
+    my $self = shift;
+    return $self->{name};
+}
+
+sub args {
+    my $self = shift;
+    return $self->{args};
+}
+
+#-------------------------------
+package QueryParser::query_plan::facet;
+
+sub new {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my %args = @_;
+
+    return bless \%args => $pkg;
+}
+
+sub plan {
+    my $self = shift;
+    return $self->{plan};
+}
+
+sub name {
+    my $self = shift;
+    return $self->{name};
+}
+
+sub values {
+    my $self = shift;
+    return $self->{'values'};
+}
+
+#-------------------------------
+package QueryParser::query_plan::modifier;
+
+sub new {
+    my $pkg = shift;
+    $pkg = ref($pkg) || $pkg;
+    my $modifier = shift;
+
+    return bless \$modifier => $pkg;
+}
+
+sub name {
+    my $self = shift;
+    return $$self;
+}
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/SuperCat.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/SuperCat.pm
new file mode 100644
index 0000000000..eed53b1bc7
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/SuperCat.pm
@@ -0,0 +1,3398 @@
+# We'll be working with XML, so...
+use XML::LibXML;
+use XML::LibXSLT;
+use Unicode::Normalize;
+
+# ... and this has some handy common methods
+use OpenILS::Application::AppUtils;
+
+my $parser = new XML::LibXML;
+my $U = 'OpenILS::Application::AppUtils';
+
+
+package OpenILS::Application::SuperCat;
+
+use strict;
+use warnings;
+use OpenILS::Utils::Normalize qw( naco_normalize );
+
+# All OpenSRF applications must be based on OpenSRF::Application or
+# a subclass thereof.  Makes sense, eh?
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+
+# This is the client class, used for connecting to open-ils.storage
+use OpenSRF::AppSession;
+
+# This is an extension of Error.pm that supplies some error types to throw
+use OpenSRF::EX qw(:try);
+
+# This is a helper class for querying the OpenSRF Settings application ...
+use OpenSRF::Utils::SettingsClient;
+
+# ... and here we have the built in logging helper ...
+use OpenSRF::Utils::Logger qw($logger);
+
+# ... and this is our OpenILS object (en|de)coder and psuedo-ORM package.
+use OpenILS::Utils::Fieldmapper;
+
+our (
+  $_parser,
+  $_xslt,
+  %record_xslt,
+  %metarecord_xslt,
+  %holdings_data_cache,
+);
+
+sub child_init {
+	# we need an XML parser
+	$_parser = new XML::LibXML;
+
+	# and an xslt parser
+	$_xslt = new XML::LibXSLT;
+
+	# parse the MODS xslt ...
+	my $mods33_xslt = $_parser->parse_file(
+		OpenSRF::Utils::SettingsClient
+			->new
+			->config_value( dirs => 'xsl' ).
+		"/MARC21slim2MODS33.xsl"
+	);
+	# and stash a transformer
+	$record_xslt{mods33}{xslt} = $_xslt->parse_stylesheet( $mods33_xslt );
+	$record_xslt{mods33}{namespace_uri} = 'http://www.loc.gov/mods/v3';
+	$record_xslt{mods33}{docs} = 'http://www.loc.gov/mods/';
+	$record_xslt{mods33}{schema_location} = 'http://www.loc.gov/standards/mods/v3/mods-3-3.xsd';
+
+	# parse the MODS xslt ...
+	my $mods32_xslt = $_parser->parse_file(
+		OpenSRF::Utils::SettingsClient
+			->new
+			->config_value( dirs => 'xsl' ).
+		"/MARC21slim2MODS32.xsl"
+	);
+	# and stash a transformer
+	$record_xslt{mods32}{xslt} = $_xslt->parse_stylesheet( $mods32_xslt );
+	$record_xslt{mods32}{namespace_uri} = 'http://www.loc.gov/mods/v3';
+	$record_xslt{mods32}{docs} = 'http://www.loc.gov/mods/';
+	$record_xslt{mods32}{schema_location} = 'http://www.loc.gov/standards/mods/v3/mods-3-2.xsd';
+
+	# parse the MODS xslt ...
+	my $mods3_xslt = $_parser->parse_file(
+		OpenSRF::Utils::SettingsClient
+			->new
+			->config_value( dirs => 'xsl' ).
+		"/MARC21slim2MODS3.xsl"
+	);
+	# and stash a transformer
+	$record_xslt{mods3}{xslt} = $_xslt->parse_stylesheet( $mods3_xslt );
+	$record_xslt{mods3}{namespace_uri} = 'http://www.loc.gov/mods/v3';
+	$record_xslt{mods3}{docs} = 'http://www.loc.gov/mods/';
+	$record_xslt{mods3}{schema_location} = 'http://www.loc.gov/standards/mods/v3/mods-3-1.xsd';
+
+	# parse the MODS xslt ...
+	my $mods_xslt = $_parser->parse_file(
+		OpenSRF::Utils::SettingsClient
+			->new
+			->config_value( dirs => 'xsl' ).
+		"/MARC21slim2MODS.xsl"
+	);
+	# and stash a transformer
+	$record_xslt{mods}{xslt} = $_xslt->parse_stylesheet( $mods_xslt );
+	$record_xslt{mods}{namespace_uri} = 'http://www.loc.gov/mods/';
+	$record_xslt{mods}{docs} = 'http://www.loc.gov/mods/';
+	$record_xslt{mods}{schema_location} = 'http://www.loc.gov/standards/mods/mods.xsd';
+
+	# parse the ATOM entry xslt ...
+	my $atom_xslt = $_parser->parse_file(
+		OpenSRF::Utils::SettingsClient
+			->new
+			->config_value( dirs => 'xsl' ).
+		"/MARC21slim2ATOM.xsl"
+	);
+	# and stash a transformer
+	$record_xslt{atom}{xslt} = $_xslt->parse_stylesheet( $atom_xslt );
+	$record_xslt{atom}{namespace_uri} = 'http://www.w3.org/2005/Atom';
+	$record_xslt{atom}{docs} = 'http://www.ietf.org/rfc/rfc4287.txt';
+
+	# parse the RDFDC xslt ...
+	my $rdf_dc_xslt = $_parser->parse_file(
+		OpenSRF::Utils::SettingsClient
+			->new
+			->config_value( dirs => 'xsl' ).
+		"/MARC21slim2RDFDC.xsl"
+	);
+	# and stash a transformer
+	$record_xslt{rdf_dc}{xslt} = $_xslt->parse_stylesheet( $rdf_dc_xslt );
+	$record_xslt{rdf_dc}{namespace_uri} = 'http://purl.org/dc/elements/1.1/';
+	$record_xslt{rdf_dc}{schema_location} = 'http://purl.org/dc/elements/1.1/';
+
+	# parse the SRWDC xslt ...
+	my $srw_dc_xslt = $_parser->parse_file(
+		OpenSRF::Utils::SettingsClient
+			->new
+			->config_value( dirs => 'xsl' ).
+		"/MARC21slim2SRWDC.xsl"
+	);
+	# and stash a transformer
+	$record_xslt{srw_dc}{xslt} = $_xslt->parse_stylesheet( $srw_dc_xslt );
+	$record_xslt{srw_dc}{namespace_uri} = 'info:srw/schema/1/dc-schema';
+	$record_xslt{srw_dc}{schema_location} = 'http://www.loc.gov/z3950/agency/zing/srw/dc-schema.xsd';
+
+	# parse the OAIDC xslt ...
+	my $oai_dc_xslt = $_parser->parse_file(
+		OpenSRF::Utils::SettingsClient
+			->new
+			->config_value( dirs => 'xsl' ).
+		"/MARC21slim2OAIDC.xsl"
+	);
+	# and stash a transformer
+	$record_xslt{oai_dc}{xslt} = $_xslt->parse_stylesheet( $oai_dc_xslt );
+	$record_xslt{oai_dc}{namespace_uri} = 'http://www.openarchives.org/OAI/2.0/oai_dc/';
+	$record_xslt{oai_dc}{schema_location} = 'http://www.openarchives.org/OAI/2.0/oai_dc.xsd';
+
+	# parse the RSS xslt ...
+	my $rss_xslt = $_parser->parse_file(
+		OpenSRF::Utils::SettingsClient
+			->new
+			->config_value( dirs => 'xsl' ).
+		"/MARC21slim2RSS2.xsl"
+	);
+	# and stash a transformer
+	$record_xslt{rss2}{xslt} = $_xslt->parse_stylesheet( $rss_xslt );
+
+	# parse the FGDC xslt ...
+	my $fgdc_xslt = $_parser->parse_file(
+		OpenSRF::Utils::SettingsClient
+			->new
+			->config_value( dirs => 'xsl' ).
+		"/MARC21slim2FGDC.xsl"
+	);
+	# and stash a transformer
+	$record_xslt{fgdc}{xslt} = $_xslt->parse_stylesheet( $fgdc_xslt );
+	$record_xslt{fgdc}{docs} = 'http://www.fgdc.gov/metadata/csdgm/index_html';
+	$record_xslt{fgdc}{schema_location} = 'http://www.fgdc.gov/metadata/fgdc-std-001-1998.xsd';
+
+	register_record_transforms();
+
+	return 1;
+}
+
+sub register_record_transforms {
+	for my $type ( keys %record_xslt ) {
+		__PACKAGE__->register_method(
+			method    => 'retrieve_record_transform',
+			api_name  => "open-ils.supercat.record.$type.retrieve",
+			api_level => 1,
+			argc      => 1,
+			signature =>
+				{ desc     => "Returns the \U$type\E representation ".
+				              "of the requested bibliographic record",
+				  params   =>
+			  		[
+						{ name => 'bibId',
+						  desc => 'An OpenILS biblio::record_entry id',
+						  type => 'number' },
+					],
+			  	'return' =>
+		  			{ desc => "The bib record in \U$type\E",
+					  type => 'string' }
+				}
+		);
+
+		__PACKAGE__->register_method(
+			method    => 'retrieve_isbn_transform',
+			api_name  => "open-ils.supercat.isbn.$type.retrieve",
+			api_level => 1,
+			argc      => 1,
+			signature =>
+				{ desc     => "Returns the \U$type\E representation ".
+				              "of the requested bibliographic record",
+				  params   =>
+			  		[
+						{ name => 'isbn',
+						  desc => 'An ISBN',
+						  type => 'string' },
+					],
+			  	'return' =>
+		  			{ desc => "The bib record in \U$type\E",
+					  type => 'string' }
+				}
+		);
+	}
+}
+
+sub tree_walker {
+	my $tree = shift;
+	my $field = shift;
+	my $filter = shift;
+
+	return unless ($tree && ref($tree->$field));
+
+	my @things = $filter->($tree);
+	for my $v ( @{$tree->$field} ){
+		push @things, $filter->($v);
+		push @things, tree_walker($v, $field, $filter);
+	}
+	return @things
+}
+
+sub cn_browse {
+	my $self = shift;
+	my $client = shift;
+
+	my $label = shift;
+	my $ou = shift;
+	my $page_size = shift || 9;
+	my $page = shift || 0;
+	my $statuses = shift || [];
+	my $copy_locations = shift || [];
+
+	my ($before_limit,$after_limit) = (0,0);
+	my ($before_offset,$after_offset) = (0,0);
+
+	if (!$page) {
+		$before_limit = $after_limit = int($page_size / 2);
+		$after_limit += 1 if ($page_size % 2);
+	} else {
+		$before_offset = $after_offset = int($page_size / 2);
+		$before_offset += 1 if ($page_size % 2);
+		$before_limit = $after_limit = $page_size;
+	}
+
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+
+	my $o_search = { shortname => $ou };
+	if (!$ou || $ou eq '-') {
+		$o_search = { parent_ou => undef };
+	}
+
+	my $orgs = $_storage->request(
+		"open-ils.cstore.direct.actor.org_unit.search",
+		$o_search,
+		{ flesh		=> 100,
+		  flesh_fields	=> { aou	=> [qw/children/] }
+		}
+	)->gather(1);
+
+	my @ou_ids = tree_walker($orgs, 'children', sub {shift->id}) if $orgs;
+
+	$logger->debug("Searching for CNs at orgs [".join(',',@ou_ids)."], based on $ou");
+
+	my @list = ();
+
+    my @cp_filter = ();
+    if (@$statuses || @$copy_locations) {
+        @cp_filter = (
+            '-exists' => {
+                from  => 'acp',
+				where => {
+                    call_number => { '=' => { '+acn' => 'id' } },
+                    deleted     => 'f',
+                    ((@$statuses)       ? ( status   => $statuses)       : ()),
+				    ((@$copy_locations) ? ( location => $copy_locations) : ())
+                }
+            }
+        );
+    }
+
+	if ($page <= 0) {
+		my $before = $_storage->request(
+			"open-ils.cstore.direct.asset.call_number.search.atomic",
+			{ label		=> { "<" => { transform => "oils_text_as_bytea", value => ["oils_text_as_bytea", $label] } },
+			  owning_lib	=> \@ou_ids,
+              deleted => 'f',
+              @cp_filter
+			},
+			{ flesh		=> 1,
+			  flesh_fields	=> { acn => [qw/record owning_lib/] },
+			  order_by	=> { acn => "oils_text_as_bytea(label_sortkey) desc, oils_text_as_bytea(label) desc, id desc, owning_lib desc" },
+			  limit		=> $before_limit,
+			  offset	=> abs($page) * $page_size - $before_offset,
+			}
+		)->gather(1);
+		push @list, reverse(@$before);
+	}
+
+	if ($page >= 0) {
+		my $after = $_storage->request(
+			"open-ils.cstore.direct.asset.call_number.search.atomic",
+			{ label		=> { ">=" => { transform => "oils_text_as_bytea", value => ["oils_text_as_bytea", $label] } },
+			  owning_lib	=> \@ou_ids,
+              deleted => 'f',
+              @cp_filter
+			},
+			{ flesh		=> 1,
+			  flesh_fields	=> { acn => [qw/record owning_lib/] },
+			  order_by	=> { acn => "oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib" },
+			  limit		=> $after_limit,
+			  offset	=> abs($page) * $page_size - $after_offset,
+			}
+		)->gather(1);
+		push @list, @$after;
+	}
+
+	return \@list;
+}
+__PACKAGE__->register_method(
+	method    => 'cn_browse',
+	api_name  => 'open-ils.supercat.call_number.browse',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the XML representation of the requested bibliographic record's holdings
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'label',
+				  desc => 'The target call number lable',
+				  type => 'string' },
+				{ name => 'org_unit',
+				  desc => 'The org unit shortname (or "-" or undef for global) to browse',
+				  type => 'string' },
+				{ name => 'page_size',
+				  desc => 'Count of call numbers to retrieve, default is 9',
+				  type => 'number' },
+				{ name => 'page',
+				  desc => 'The page of call numbers to retrieve, calculated based on page_size.  Can be positive, negative or 0.',
+				  type => 'number' },
+				{ name => 'statuses',
+				  desc => 'Array of statuses to filter copies by, optional and can be undef.',
+				  type => 'array' },
+				{ name => 'locations',
+				  desc => 'Array of copy locations to filter copies by, optional and can be undef.',
+				  type => 'array' },
+			],
+		  'return' =>
+		  	{ desc => 'Call numbers with owning_lib and record fleshed',
+			  type => 'array' }
+		}
+);
+
+sub cn_startwith {
+	my $self = shift;
+	my $client = shift;
+
+	my $label = shift;
+	my $ou = shift;
+	my $limit = shift || 10;
+	my $page = shift || 0;
+	my $statuses = shift || [];
+	my $copy_locations = shift || [];
+
+
+	my $offset = abs($page) * $limit;
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+
+	my $o_search = { shortname => $ou };
+	if (!$ou || $ou eq '-') {
+		$o_search = { parent_ou => undef };
+	}
+
+	my $orgs = $_storage->request(
+		"open-ils.cstore.direct.actor.org_unit.search",
+		$o_search,
+		{ flesh		=> 100,
+		  flesh_fields	=> { aou	=> [qw/children/] }
+		}
+	)->gather(1);
+
+	my @ou_ids = tree_walker($orgs, 'children', sub {shift->id}) if $orgs;
+
+	$logger->debug("Searching for CNs at orgs [".join(',',@ou_ids)."], based on $ou");
+
+	my @list = ();
+
+    my @cp_filter = ();
+    if (@$statuses || @$copy_locations) {
+        @cp_filter = (
+            '-exists' => {
+                from  => 'acp',
+				where => {
+                    call_number => { '=' => { '+acn' => 'id' } },
+                    deleted     => 'f',
+                    ((@$statuses)       ? ( status   => $statuses)       : ()),
+				    ((@$copy_locations) ? ( location => $copy_locations) : ())
+                }
+            }
+        );
+    }
+
+	if ($page < 0) {
+		my $before = $_storage->request(
+			"open-ils.cstore.direct.asset.call_number.search.atomic",
+			{ label		=> { "<" => { transform => "oils_text_as_bytea", value => ["oils_text_as_bytea", $label] } },
+			  owning_lib	=> \@ou_ids,
+              deleted => 'f',
+              @cp_filter
+			},
+			{ flesh		=> 1,
+			  flesh_fields	=> { acn => [qw/record owning_lib/] },
+			  order_by	=> { acn => "oils_text_as_bytea(label_sortkey) desc, oils_text_as_bytea(label) desc, id desc, owning_lib desc" },
+			  limit		=> $limit,
+			  offset	=> $offset,
+			}
+		)->gather(1);
+		push @list, reverse(@$before);
+	}
+
+	if ($page >= 0) {
+		my $after = $_storage->request(
+			"open-ils.cstore.direct.asset.call_number.search.atomic",
+			{ label		=> { ">=" => { transform => "oils_text_as_bytea", value => ["oils_text_as_bytea", $label] } },
+			  owning_lib	=> \@ou_ids,
+              deleted => 'f',
+              @cp_filter
+			},
+			{ flesh		=> 1,
+			  flesh_fields	=> { acn => [qw/record owning_lib/] },
+			  order_by	=> { acn => "oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib" },
+			  limit		=> $limit,
+			  offset	=> $offset,
+			}
+		)->gather(1);
+		push @list, @$after;
+	}
+
+	return \@list;
+}
+__PACKAGE__->register_method(
+	method    => 'cn_startwith',
+	api_name  => 'open-ils.supercat.call_number.startwith',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the XML representation of the requested bibliographic record's holdings
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'label',
+				  desc => 'The target call number lable',
+				  type => 'string' },
+				{ name => 'org_unit',
+				  desc => 'The org unit shortname (or "-" or undef for global) to browse',
+				  type => 'string' },
+				{ name => 'page_size',
+				  desc => 'Count of call numbers to retrieve, default is 9',
+				  type => 'number' },
+				{ name => 'page',
+				  desc => 'The page of call numbers to retrieve, calculated based on page_size.  Can be positive, negative or 0.',
+				  type => 'number' },
+				{ name => 'statuses',
+				  desc => 'Array of statuses to filter copies by, optional and can be undef.',
+				  type => 'array' },
+				{ name => 'locations',
+				  desc => 'Array of copy locations to filter copies by, optional and can be undef.',
+				  type => 'array' },
+			],
+		  'return' =>
+		  	{ desc => 'Call numbers with owning_lib and record fleshed',
+			  type => 'array' }
+		}
+);
+
+
+sub new_books_by_item {
+	my $self = shift;
+	my $client = shift;
+
+	my $ou = shift;
+	my $page_size = shift || 10;
+	my $page = shift || 1;
+	my $statuses = shift || [];
+	my $copy_locations = shift || [];
+
+    my $offset = $page_size * ($page - 1);
+
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+
+	my @ou_ids;
+	if ($ou && $ou ne '-') {
+		my $orgs = $_storage->request(
+			"open-ils.cstore.direct.actor.org_unit.search",
+			{ shortname => $ou },
+			{ flesh		=> 100,
+			  flesh_fields	=> { aou	=> [qw/children/] }
+			}
+		)->gather(1);
+		@ou_ids = tree_walker($orgs, 'children', sub {shift->id}) if $orgs;
+	}
+
+	$logger->debug("Searching for records with new copies at orgs [".join(',',@ou_ids)."], based on $ou");
+	my $cns = $_storage->request(
+		"open-ils.cstore.json_query.atomic",
+		{ select	=> { acn => ['record'],
+                         acp => [{ aggregate => 1 => transform => max => column => create_date => alias => 'create_date'}]
+                       },
+		  from		=> { 'acn' => { 'acp' => { field => call_number => fkey => 'id' } } },
+		  where		=>
+			{ '+acp' =>
+				{ deleted => 'f',
+				  ((@ou_ids)          ? ( circ_lib => \@ou_ids)        : ()),
+				  ((@$statuses)       ? ( status   => $statuses)       : ()),
+				  ((@$copy_locations) ? ( location => $copy_locations) : ())
+				}, 
+			  '+acn' => { record => { '>' => 0 } },
+			}, 
+		  order_by	=> { acp => { create_date => { transform => 'max', direction => 'desc' } } },
+		  limit		=> $page_size,
+		  offset	=> $offset
+		}
+	)->gather(1);
+
+	return [ map { $_->{record} } @$cns ];
+}
+__PACKAGE__->register_method(
+	method    => 'new_books_by_item',
+	api_name  => 'open-ils.supercat.new_book_list',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the XML representation of the requested bibliographic record's holdings
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'org_unit',
+				  desc => 'The org unit shortname (or "-" or undef for global) to list',
+				  type => 'string' },
+				{ name => 'page_size',
+				  desc => 'Count of records to retrieve, default is 10',
+				  type => 'number' },
+				{ name => 'page',
+				  desc => 'The page of records to retrieve, calculated based on page_size.  Starts at 1.',
+				  type => 'number' },
+				{ name => 'statuses',
+				  desc => 'Array of statuses to filter copies by, optional and can be undef.',
+				  type => 'array' },
+				{ name => 'locations',
+				  desc => 'Array of copy locations to filter copies by, optional and can be undef.',
+				  type => 'array' },
+			],
+		  'return' =>
+		  	{ desc => 'Record IDs',
+			  type => 'array' }
+		}
+);
+
+
+sub general_browse {
+	my $self = shift;
+	my $client = shift;
+    return tag_sf_browse($self, $client, $self->{tag}, $self->{subfield}, @_);
+}
+__PACKAGE__->register_method(
+	method    => 'general_browse',
+	api_name  => 'open-ils.supercat.title.browse',
+	tag       => 'tnf', subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested org-scoped record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target title', type => 'string' },
+			  { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' },
+			  { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' },
+			  { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ],
+		  'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_browse',
+	api_name  => 'open-ils.supercat.author.browse',
+	tag       => [qw/100 110 111/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested org-scoped record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target author', type => 'string' },
+			  { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' },
+			  { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' },
+			  { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ],
+		  'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_browse',
+	api_name  => 'open-ils.supercat.subject.browse',
+	tag       => [qw/600 610 611 630 648 650 651 653 655 656 662 690 691 696 697 698 699/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested org-scoped record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target subject', type => 'string' },
+			  { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' },
+			  { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' },
+			  { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ],
+		  'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_browse',
+	api_name  => 'open-ils.supercat.topic.browse',
+	tag       => [qw/650 690/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested org-scoped record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target topical subject', type => 'string' },
+			  { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' },
+			  { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' },
+			  { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ],
+		  'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_browse',
+	api_name  => 'open-ils.supercat.series.browse',
+	tag       => [qw/440 490 800 810 811 830/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested org-scoped record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target series', type => 'string' },
+			  { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' },
+			  { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' },
+			  { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ],
+		  'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' }
+		}
+);
+
+
+sub tag_sf_browse {
+	my $self = shift;
+	my $client = shift;
+
+	my $tag = shift;
+	my $subfield = shift;
+	my $value = shift;
+	my $ou = shift;
+	my $page_size = shift || 9;
+	my $page = shift || 0;
+	my $statuses = shift || [];
+	my $copy_locations = shift || [];
+
+	my ($before_limit,$after_limit) = (0,0);
+	my ($before_offset,$after_offset) = (0,0);
+
+	if (!$page) {
+		$before_limit = $after_limit = int($page_size / 2);
+		$after_limit += 1 if ($page_size % 2);
+	} else {
+		$before_offset = $after_offset = int($page_size / 2);
+		$before_offset += 1 if ($page_size % 2);
+		$before_limit = $after_limit = $page_size;
+	}
+
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+
+	my @ou_ids;
+	if ($ou && $ou ne '-') {
+		my $orgs = $_storage->request(
+			"open-ils.cstore.direct.actor.org_unit.search",
+			{ shortname => $ou },
+			{ flesh		=> 100,
+			  flesh_fields	=> { aou	=> [qw/children/] }
+			}
+		)->gather(1);
+		@ou_ids = tree_walker($orgs, 'children', sub {shift->id}) if $orgs;
+	}
+
+	$logger->debug("Searching for records at orgs [".join(',',@ou_ids)."], based on $ou");
+
+	my @list = ();
+
+	if ($page <= 0) {
+		my $before = $_storage->request(
+			"open-ils.cstore.json_query.atomic",
+			{ select	=> { mfr => [qw/record value/] },
+			  from		=> 'mfr',
+			  where		=>
+				{ '+mfr'	=>
+					{ tag	=> $tag,
+					  subfield => $subfield,
+					  value => { '<' => lc($value) }
+					},
+                  '-or' => [
+		    		{ '-exists'	=>
+	    				{ select=> { acp => [ 'id' ] },
+    					  from	=> { acn => { acp => { field => 'call_number', fkey => 'id' } } },
+					      where	=>
+				    		{ '+acn' => { record => { '=' => { '+mfr' => 'record' } } },
+			    			  '+acp' =>
+								{ deleted => 'f',
+								  ((@ou_ids)          ? ( circ_lib => \@ou_ids)        : ()),
+								  ((@$statuses)       ? ( status   => $statuses)       : ()),
+								  ((@$copy_locations) ? ( location => $copy_locations) : ())
+								}
+		    				},
+	    				  limit => 1
+    					}
+                    },
+                    { '-exists'	=>
+    					{ select=> { auri => [ 'id' ] },
+	    				  from	=> { acn => { auricnm => { field => 'call_number', fkey => 'id', join => { auri => { field => 'id', fkey => 'uri' } } } } },
+		    			  where	=>
+			    			{ '+acn' => { record => { '=' => { '+mfr' => 'record' } }, (@ou_ids) ? ( owning_lib => \@ou_ids) : () },
+				    		  '+auri' => { active => 't' }
+					    	},
+    					  limit => 1
+	    				}
+                    }
+                  ]
+				}, 
+			  order_by	=> { mfr => { value => 'desc' } },
+			  limit		=> $before_limit,
+			  offset	=> abs($page) * $page_size - $before_offset,
+			}
+		)->gather(1);
+		push @list, map { $_->{record} } reverse(@$before);
+	}
+
+	if ($page >= 0) {
+		my $after = $_storage->request(
+			"open-ils.cstore.json_query.atomic",
+			{ select	=> { mfr => [qw/record value/] },
+			  from		=> 'mfr',
+			  where		=>
+				{ '+mfr'	=>
+					{ tag	=> $tag,
+					  subfield => $subfield,
+					  value => { '>=' => lc($value) }
+					},
+				  '-or' => [
+                    { '-exists'	=>
+    					{ select=> { acp => [ 'id' ] },
+	    				  from	=> { acn => { acp => { field => 'call_number', fkey => 'id' } } },
+		    			  where	=>
+			    			{ '+acn' => { record => { '=' => { '+mfr' => 'record' } } },
+			    			  '+acp' =>
+								{ deleted => 'f',
+								  ((@ou_ids)          ? ( circ_lib => \@ou_ids)        : ()),
+								  ((@$statuses)       ? ( status   => $statuses)       : ()),
+								  ((@$copy_locations) ? ( location => $copy_locations) : ())
+								}
+					    	},
+    					  limit => 1
+	    				}
+                    },
+                    { '-exists'	=>
+    					{ select=> { auri => [ 'id' ] },
+	    				  from	=> { acn => { auricnm => { field => 'call_number', fkey => 'id', join => { auri => { field => 'id', fkey => 'uri' } } } } },
+		    			  where	=>
+			    			{ '+acn' => { record => { '=' => { '+mfr' => 'record' } }, (@ou_ids) ? ( owning_lib => \@ou_ids) : () },
+				    		  '+auri' => { active => 't' }
+					    	},
+    					  limit => 1
+	    				},
+                    }
+                  ]
+				}, 
+			  order_by	=> { mfr => { value => 'asc' } },
+			  limit		=> $after_limit,
+			  offset	=> abs($page) * $page_size - $after_offset,
+			}
+		)->gather(1);
+		push @list, map { $_->{record} } @$after;
+	}
+
+	return \@list;
+}
+__PACKAGE__->register_method(
+	method    => 'tag_sf_browse',
+	api_name  => 'open-ils.supercat.tag.browse',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns a list of the requested org-scoped record IDs held
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'tag',
+				  desc => 'The target MARC tag',
+				  type => 'string' },
+				{ name => 'subfield',
+				  desc => 'The target MARC subfield',
+				  type => 'string' },
+				{ name => 'value',
+				  desc => 'The target string',
+				  type => 'string' },
+				{ name => 'org_unit',
+				  desc => 'The org unit shortname (or "-" or undef for global) to browse',
+				  type => 'string' },
+				{ name => 'page_size',
+				  desc => 'Count of call numbers to retrieve, default is 9',
+				  type => 'number' },
+				{ name => 'page',
+				  desc => 'The page of call numbers to retrieve, calculated based on page_size.  Can be positive, negative or 0.',
+				  type => 'number' },
+				{ name => 'statuses',
+				  desc => 'Array of statuses to filter copies by, optional and can be undef.',
+				  type => 'array' },
+				{ name => 'locations',
+				  desc => 'Array of copy locations to filter copies by, optional and can be undef.',
+				  type => 'array' },
+			],
+		  'return' =>
+		  	{ desc => 'Record IDs that have copies at the relevant org units',
+			  type => 'array' }
+		}
+);
+
+sub general_authority_browse {
+	my $self = shift;
+	my $client = shift;
+    return authority_tag_sf_browse($self, $client, $self->{tag}, $self->{subfield}, @_);
+}
+__PACKAGE__->register_method(
+	method    => 'general_authority_browse',
+	api_name  => 'open-ils.supercat.authority.title.browse',
+	tag       => ['130'], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target title', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_authority_browse',
+	api_name  => 'open-ils.supercat.authority.author.browse',
+	tag       => [qw/100 110 111/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target author', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_authority_browse',
+	api_name  => 'open-ils.supercat.authority.subject.browse',
+	tag       => [qw/148 150 151 155/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target subject', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_authority_browse',
+	api_name  => 'open-ils.supercat.authority.topic.browse',
+	tag       => ['150'], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target topical subject', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_authority_browse',
+	api_name  => 'open-ils.supercat.authority.title.refs.browse',
+	tag       => ['130'], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target title', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_authority_browse',
+	api_name  => 'open-ils.supercat.authority.author.refs.browse',
+	tag       => [qw/100 110 111/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target author', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_authority_browse',
+	api_name  => 'open-ils.supercat.authority.subject.refs.browse',
+	tag       => [qw/148 150 151 155/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target subject', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_authority_browse',
+	api_name  => 'open-ils.supercat.authority.topic.refs.browse',
+	tag       => ['150'], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target topical subject', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+
+sub authority_tag_sf_browse {
+    my $self = shift;
+    my $client = shift;
+
+    my $tag = shift;
+    my $subfield = shift;
+    my $value = shift;
+    my $page_size = shift || 9;
+    my $page = shift || 0;
+
+    # Match authority.full_rec normalization
+    $value = naco_normalize($value, $subfield);
+
+    my ($before_limit,$after_limit) = (0,0);
+    my ($before_offset,$after_offset) = (0,0);
+
+    if (!$page) {
+        $before_limit = $after_limit = int($page_size / 2);
+        $after_limit += 1 if ($page_size % 2);
+    } else {
+        $before_offset = $after_offset = int($page_size / 2);
+        $before_offset += 1 if ($page_size % 2);
+        $before_limit = $after_limit = $page_size;
+    }
+
+    my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+
+    # .refs variant includes 4xx and 5xx variants for see / see also
+    my @ref_tags = ();
+    foreach my $tagname (@$tag) {
+        push(@ref_tags, $tagname);
+        if ($self->api_name =~ /\.refs\./) {
+            push(@ref_tags, '4' . substr($tagname, 1, 2));
+            push(@ref_tags, '5' . substr($tagname, 1, 2));
+        }
+    }
+    my @list = ();
+
+    if ($page <= 0) {
+        my $before = $_storage->request(
+            "open-ils.cstore.json_query.atomic",
+            { select    => { afr => [qw/record value/] },
+              from      => { 'are', 'afr' },
+              where     => {
+                '+afr' => { tag => \@ref_tags, subfield => $subfield, value => { '<' => $value } },
+                '+are' => { 'deleted' => 'f' }
+              },
+              order_by  => { afr => { value => 'desc' } },
+              limit     => $before_limit,
+              offset    => abs($page) * $page_size - $before_offset,
+            }
+        )->gather(1);
+        push @list, map { $_->{record} } reverse(@$before);
+    }
+
+    if ($page >= 0) {
+        my $after = $_storage->request(
+            "open-ils.cstore.json_query.atomic",
+            { select    => { afr => [qw/record value/] },
+              from      => { 'are', 'afr' },
+              where     => {
+                '+afr' => { tag => \@ref_tags, subfield => $subfield, value => { '>=' => $value } },
+                '+are' => { 'deleted' => 'f' }
+              },
+              order_by  => { afr => { value => 'asc' } },
+              limit     => $after_limit,
+              offset    => abs($page) * $page_size - $after_offset,
+            }
+        )->gather(1);
+        push @list, map { $_->{record} } @$after;
+    }
+
+    # If we're not pulling in see/see also references, just return the raw list
+    if ($self->api_name !~ /\.refs\./) {
+        return \@list;
+    } 
+
+    # Remove dupe record IDs that turn up due to 4xx and 5xx matches
+    my @retlist = ();
+    my %seen;
+    foreach my $record (@list) {
+        next if exists $seen{$record};
+        push @retlist, int($record);
+        $seen{$record} = 1;
+    }
+
+    return \@retlist;
+}
+__PACKAGE__->register_method(
+	method    => 'authority_tag_sf_browse',
+	api_name  => 'open-ils.supercat.authority.tag.browse',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns a list of the requested authority record IDs held
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'tag',
+				  desc => 'The target Authority MARC tag',
+				  type => 'string' },
+				{ name => 'subfield',
+				  desc => 'The target Authority MARC subfield',
+				  type => 'string' },
+				{ name => 'value',
+				  desc => 'The target string',
+				  type => 'string' },
+				{ name => 'page_size',
+				  desc => 'Count of call numbers to retrieve, default is 9',
+				  type => 'number' },
+				{ name => 'page',
+				  desc => 'The page of call numbers to retrieve, calculated based on page_size.  Can be positive, negative or 0.',
+				  type => 'number' },
+			],
+		  'return' =>
+		  	{ desc => 'Authority Record IDs that are near the target string',
+			  type => 'array' }
+		}
+);
+
+sub general_startwith {
+	my $self = shift;
+	my $client = shift;
+    return tag_sf_startwith($self, $client, $self->{tag}, $self->{subfield}, @_);
+}
+__PACKAGE__->register_method(
+	method    => 'general_startwith',
+	api_name  => 'open-ils.supercat.title.startwith',
+	tag       => 'tnf', subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested org-scoped record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target title', type => 'string' },
+			  { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' },
+			  { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' },
+			  { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ],
+		  'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_startwith',
+	api_name  => 'open-ils.supercat.author.startwith',
+	tag       => [qw/100 110 111/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested org-scoped record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target author', type => 'string' },
+			  { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' },
+			  { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' },
+			  { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ],
+		  'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_startwith',
+	api_name  => 'open-ils.supercat.subject.startwith',
+	tag       => [qw/600 610 611 630 648 650 651 653 655 656 662 690 691 696 697 698 699/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested org-scoped record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target subject', type => 'string' },
+			  { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' },
+			  { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' },
+			  { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ],
+		  'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_startwith',
+	api_name  => 'open-ils.supercat.topic.startwith',
+	tag       => [qw/650 690/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested org-scoped record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target topical subject', type => 'string' },
+			  { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' },
+			  { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' },
+			  { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ],
+		  'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_startwith',
+	api_name  => 'open-ils.supercat.series.startwith',
+	tag       => [qw/440 490 800 810 811 830/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested org-scoped record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target series', type => 'string' },
+			  { name => 'org_unit', desc => 'The org unit shortname (or "-" or undef for global) to browse', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' },
+			  { name => 'statuses', desc => 'Array of statuses to filter copies by, optional and can be undef.', type => 'array' },
+			  { name => 'locations', desc => 'Array of copy locations to filter copies by, optional and can be undef.', type => 'array' }, ],
+		  'return' => { desc => 'Record IDs that have copies at the relevant org units', type => 'array' }
+		}
+);
+
+
+sub tag_sf_startwith {
+	my $self = shift;
+	my $client = shift;
+
+	my $tag = shift;
+	my $subfield = shift;
+	my $value = shift;
+	my $ou = shift;
+	my $limit = shift || 10;
+	my $page = shift || 0;
+	my $statuses = shift || [];
+	my $copy_locations = shift || [];
+
+	my $offset = $limit * abs($page);
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+
+	my @ou_ids;
+	if ($ou && $ou ne '-') {
+		my $orgs = $_storage->request(
+			"open-ils.cstore.direct.actor.org_unit.search",
+			{ shortname => $ou },
+			{ flesh		=> 100,
+			  flesh_fields	=> { aou	=> [qw/children/] }
+			}
+		)->gather(1);
+		@ou_ids = tree_walker($orgs, 'children', sub {shift->id}) if $orgs;
+	}
+
+	$logger->debug("Searching for records at orgs [".join(',',@ou_ids)."], based on $ou");
+
+	my @list = ();
+
+	if ($page < 0) {
+		my $before = $_storage->request(
+			"open-ils.cstore.json_query.atomic",
+			{ select	=> { mfr => [qw/record value/] },
+			  from		=> 'mfr',
+			  where		=>
+				{ '+mfr'	=>
+					{ tag	=> $tag,
+					  subfield => $subfield,
+					  value => { '<' => lc($value) }
+					},
+                  '-or' => [
+		    		{ '-exists'	=>
+	    				{ select=> { acp => [ 'id' ] },
+    					  from	=> { acn => { acp => { field => 'call_number', fkey => 'id' } } },
+					      where	=>
+				    		{ '+acn' => { record => { '=' => { '+mfr' => 'record' } } },
+			    			  '+acp' =>
+								{ deleted => 'f',
+								  ((@ou_ids)          ? ( circ_lib => \@ou_ids)        : ()),
+								  ((@$statuses)       ? ( status   => $statuses)       : ()),
+								  ((@$copy_locations) ? ( location => $copy_locations) : ())
+								}
+		    				},
+	    				  limit => 1
+    					}
+                    },
+                    { '-exists'	=>
+    					{ select=> { auri => [ 'id' ] },
+	    				  from	=> { acn => { auricnm => { field => 'call_number', fkey => 'id', join => { auri => { field => 'id', fkey => 'uri' } } } } },
+		    			  where	=>
+			    			{ '+acn' => { record => { '=' => { '+mfr' => 'record' } }, (@ou_ids) ? ( owning_lib => \@ou_ids) : () },
+				    		  '+auri' => { active => 't' }
+					    	},
+    					  limit => 1
+	    				}
+                    }
+                  ]
+				}, 
+			  order_by	=> { mfr => { value => 'desc' } },
+			  limit		=> $limit,
+			  offset	=> $offset
+			}
+		)->gather(1);
+		push @list, map { $_->{record} } reverse(@$before);
+	}
+
+	if ($page >= 0) {
+		my $after = $_storage->request(
+			"open-ils.cstore.json_query.atomic",
+			{ select	=> { mfr => [qw/record value/] },
+			  from		=> 'mfr',
+			  where		=>
+				{ '+mfr'	=>
+					{ tag	=> $tag,
+					  subfield => $subfield,
+					  value => { '>=' => lc($value) }
+					},
+				  '-or' => [
+                    { '-exists'	=>
+    					{ select=> { acp => [ 'id' ] },
+	    				  from	=> { acn => { acp => { field => 'call_number', fkey => 'id' } } },
+		    			  where	=>
+			    			{ '+acn' => { record => { '=' => { '+mfr' => 'record' } } },
+			    			  '+acp' =>
+								{ deleted => 'f',
+								  ((@ou_ids)          ? ( circ_lib => \@ou_ids)        : ()),
+								  ((@$statuses)       ? ( status   => $statuses)       : ()),
+								  ((@$copy_locations) ? ( location => $copy_locations) : ())
+								}
+					    	},
+    					  limit => 1
+	    				}
+                    },
+                    { '-exists'	=>
+    					{ select=> { auri => [ 'id' ] },
+	    				  from	=> { acn => { auricnm => { field => 'call_number', fkey => 'id', join => { auri => { field => 'id', fkey => 'uri' } } } } },
+		    			  where	=>
+			    			{ '+acn' => { record => { '=' => { '+mfr' => 'record' } }, (@ou_ids) ? ( owning_lib => \@ou_ids) : () },
+				    		  '+auri' => { active => 't' }
+					    	},
+    					  limit => 1
+	    				},
+                    }
+                  ]
+				}, 
+			  order_by	=> { mfr => { value => 'asc' } },
+			  limit		=> $limit,
+			  offset	=> $offset
+			}
+		)->gather(1);
+		push @list, map { $_->{record} } @$after;
+	}
+
+	return \@list;
+}
+__PACKAGE__->register_method(
+	method    => 'tag_sf_startwith',
+	api_name  => 'open-ils.supercat.tag.startwith',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns a list of the requested org-scoped record IDs held
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'tag',
+				  desc => 'The target MARC tag',
+				  type => 'string' },
+				{ name => 'subfield',
+				  desc => 'The target MARC subfield',
+				  type => 'string' },
+				{ name => 'value',
+				  desc => 'The target string',
+				  type => 'string' },
+				{ name => 'org_unit',
+				  desc => 'The org unit shortname (or "-" or undef for global) to browse',
+				  type => 'string' },
+				{ name => 'page_size',
+				  desc => 'Count of call numbers to retrieve, default is 9',
+				  type => 'number' },
+				{ name => 'page',
+				  desc => 'The page of call numbers to retrieve, calculated based on page_size.  Can be positive, negative or 0.',
+				  type => 'number' },
+				{ name => 'statuses',
+				  desc => 'Array of statuses to filter copies by, optional and can be undef.',
+				  type => 'array' },
+				{ name => 'locations',
+				  desc => 'Array of copy locations to filter copies by, optional and can be undef.',
+				  type => 'array' },
+			],
+		  'return' =>
+		  	{ desc => 'Record IDs that have copies at the relevant org units',
+			  type => 'array' }
+		}
+);
+
+sub general_authority_startwith {
+	my $self = shift;
+	my $client = shift;
+    return authority_tag_sf_startwith($self, $client, $self->{tag}, $self->{subfield}, @_);
+}
+__PACKAGE__->register_method(
+	method    => 'general_authority_startwith',
+	api_name  => 'open-ils.supercat.authority.title.startwith',
+	tag       => ['130'], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target title', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_authority_startwith',
+	api_name  => 'open-ils.supercat.authority.author.startwith',
+	tag       => [qw/100 110 111/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target author', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_authority_startwith',
+	api_name  => 'open-ils.supercat.authority.subject.startwith',
+	tag       => [qw/148 150 151 155/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target subject', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_authority_startwith',
+	api_name  => 'open-ils.supercat.authority.topic.startwith',
+	tag       => ['150'], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target topical subject', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_authority_startwith',
+	api_name  => 'open-ils.supercat.authority.title.refs.startwith',
+	tag       => ['130'], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target title', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_authority_startwith',
+	api_name  => 'open-ils.supercat.authority.author.refs.startwith',
+	tag       => [qw/100 110 111/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target author', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_authority_startwith',
+	api_name  => 'open-ils.supercat.authority.subject.refs.startwith',
+	tag       => [qw/148 150 151 155/], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target subject', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'general_authority_startwith',
+	api_name  => 'open-ils.supercat.authority.topic.refs.startwith',
+	tag       => ['150'], subfield => 'a',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => "Returns a list of the requested authority record IDs held, including see (4xx) and see also (5xx) references",
+		  params   =>
+		  	[ { name => 'value', desc => 'The target topical subject', type => 'string' },
+			  { name => 'page_size', desc => 'Count of records to retrieve, default is 9', type => 'number' },
+			  { name => 'page', desc => 'The page of records retrieved, calculated based on page_size.  Can be positive, negative or 0.', type => 'number' }, ],
+		  'return' => { desc => 'Authority Record IDs that are near the target string', type => 'array' }
+		}
+);
+
+sub authority_tag_sf_startwith {
+    my $self = shift;
+    my $client = shift;
+
+    my $tag = shift;
+    my $subfield = shift;
+
+    my $value = shift;
+    my $limit = shift || 10;
+    my $page = shift || 0;
+
+    # Match authority.full_rec normalization
+    $value = naco_normalize($value, $subfield);
+
+    my $ref_limit = $limit;
+    my $offset = $limit * abs($page);
+    my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+
+    my @ref_tags = ();
+    # .refs variant includes 4xx and 5xx variants for see / see also
+    foreach my $tagname (@$tag) {
+        push(@ref_tags, $tagname);
+        if ($self->api_name =~ /\.refs\./) {
+            push(@ref_tags, '4' . substr($tagname, 1, 2));
+            push(@ref_tags, '5' . substr($tagname, 1, 2));
+        }
+    }
+
+    my @list = ();
+
+    if ($page < 0) {
+        # Don't skip the first actual page of results in descending order
+        $offset = $offset - $limit;
+
+        my $before = $_storage->request(
+            "open-ils.cstore.json_query.atomic",
+            { select    => { afr => [qw/record value/] },
+              from      => { 'afr', 'are' },
+              where     => {
+                '+afr' => { tag => \@ref_tags, subfield => $subfield, value => { '<' => $value } },
+                '+are' => { deleted => 'f' }
+              },
+              order_by  => { afr => { value => 'desc' } },
+              limit     => $ref_limit,
+              offset    => $offset,
+            }
+        )->gather(1);
+        push @list, map { $_->{record} } reverse(@$before);
+    }
+
+    if ($page >= 0) {
+        my $after = $_storage->request(
+            "open-ils.cstore.json_query.atomic",
+            { select    => { afr => [qw/record value/] },
+              from      => { 'afr', 'are' },
+              where     => {
+                '+afr' => { tag => \@ref_tags, subfield => $subfield, value => { '>=' => $value } },
+                '+are' => { deleted => 'f' }
+              },
+              order_by  => { afr => { value => 'asc' } },
+              limit     => $ref_limit,
+              offset    => $offset,
+            }
+        )->gather(1);
+        push @list, map { $_->{record} } @$after;
+    }
+
+    # If we're not pulling in see/see also references, just return the raw list
+    if ($self->api_name !~ /\.refs\./) {
+        return \@list;
+    }
+
+    # Remove dupe record IDs that turn up due to 4xx and 5xx matches
+    my @retlist = ();
+    my %seen;
+    foreach my $record (@list) {
+        next if exists $seen{$record};
+        push @retlist, int($record);
+        $seen{$record} = 1;
+    }
+
+    return \@retlist;
+}
+__PACKAGE__->register_method(
+	method    => 'authority_tag_sf_startwith',
+	api_name  => 'open-ils.supercat.authority.tag.startwith',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns a list of the requested authority record IDs held
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'tag',
+				  desc => 'The target Authority MARC tag',
+				  type => 'string' },
+				{ name => 'subfield',
+				  desc => 'The target Authority MARC subfield',
+				  type => 'string' },
+				{ name => 'value',
+				  desc => 'The target string',
+				  type => 'string' },
+				{ name => 'page_size',
+				  desc => 'Count of call numbers to retrieve, default is 9',
+				  type => 'number' },
+				{ name => 'page',
+				  desc => 'The page of call numbers to retrieve, calculated based on page_size.  Can be positive, negative or 0.',
+				  type => 'number' },
+			],
+		  'return' =>
+		  	{ desc => 'Authority Record IDs that are near the target string',
+			  type => 'array' }
+		}
+);
+
+
+sub holding_data_formats {
+    return [{
+        marcxml => {
+            namespace_uri	  => 'http://www.loc.gov/MARC21/slim',
+			docs		  => 'http://www.loc.gov/marcxml/',
+			schema_location => 'http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd',
+		}
+	}];
+}
+__PACKAGE__->register_method( method => 'holding_data_formats', api_name => 'open-ils.supercat.acn.formats', api_level => 1 );
+__PACKAGE__->register_method( method => 'holding_data_formats', api_name => 'open-ils.supercat.acp.formats', api_level => 1 );
+__PACKAGE__->register_method( method => 'holding_data_formats', api_name => 'open-ils.supercat.auri.formats', api_level => 1 );
+
+
+__PACKAGE__->register_method(
+	method    => 'retrieve_uri',
+	api_name  => 'open-ils.supercat.auri.marcxml.retrieve',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns a fleshed call number object
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'uri_id',
+				  desc => 'An OpenILS asset::uri id',
+				  type => 'number' },
+			],
+		  'return' =>
+		  	{ desc => 'fleshed uri',
+			  type => 'object' }
+		}
+);
+sub retrieve_uri {
+	my $self = shift;
+	my $client = shift;
+	my $cpid = shift;
+	my $args = shift || {};
+
+    return OpenILS::Application::SuperCat::unAPI
+        ->new(OpenSRF::AppSession
+            ->create( 'open-ils.cstore' )
+            ->request(
+    	    	"open-ils.cstore.direct.asset.uri.retrieve",
+	    	    $cpid,
+    		    { flesh		=> 10,
+        		  flesh_fields	=> {
+	        	  			auri    => [qw/call_number_maps/],
+	        	  			auricnm	=> [qw/call_number/],
+	        	  			acn	    => [qw/owning_lib record/],
+    				}
+	    	    })
+            ->gather(1))
+        ->as_xml($args);
+}
+
+__PACKAGE__->register_method(
+	method    => 'retrieve_copy',
+	api_name  => 'open-ils.supercat.acp.marcxml.retrieve',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns a fleshed call number object
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'cn_id',
+				  desc => 'An OpenILS asset::copy id',
+				  type => 'number' },
+			],
+		  'return' =>
+		  	{ desc => 'fleshed copy',
+			  type => 'object' }
+		}
+);
+sub retrieve_copy {
+	my $self = shift;
+	my $client = shift;
+	my $cpid = shift;
+	my $args = shift || {};
+
+    return OpenILS::Application::SuperCat::unAPI
+        ->new(OpenSRF::AppSession
+            ->create( 'open-ils.cstore' )
+            ->request(
+    	    	"open-ils.cstore.direct.asset.copy.retrieve",
+	    	    $cpid,
+    		    { flesh		=> 2,
+        		  flesh_fields	=> {
+	        	  			acn	=> [qw/owning_lib record/],
+		        			acp	=> [qw/call_number location status circ_lib stat_cat_entries notes/],
+    				}
+	    	    })
+            ->gather(1))
+        ->as_xml($args);
+}
+
+__PACKAGE__->register_method(
+	method    => 'retrieve_callnumber',
+	api_name  => 'open-ils.supercat.acn.marcxml.retrieve',
+	api_level => 1,
+	argc      => 1,
+	stream    => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns a fleshed call number object
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'cn_id',
+				  desc => 'An OpenILS asset::call_number id',
+				  type => 'number' },
+			],
+		  'return' =>
+		  	{ desc => 'call number with copies',
+			  type => 'object' }
+		}
+);
+sub retrieve_callnumber {
+	my $self = shift;
+	my $client = shift;
+	my $cnid = shift;
+	my $args = shift || {};
+
+    return OpenILS::Application::SuperCat::unAPI
+        ->new(OpenSRF::AppSession
+            ->create( 'open-ils.cstore' )
+            ->request(
+    	    	"open-ils.cstore.direct.asset.call_number.retrieve",
+	    	    $cnid,
+    		    { flesh		=> 5,
+        		  flesh_fields	=> {
+	        	  			acn	=> [qw/owning_lib record copies uri_maps/],
+	        	  			auricnm	=> [qw/uri/],
+		        			acp	=> [qw/location status circ_lib stat_cat_entries notes/],
+    				}
+	    	    })
+            ->gather(1))
+        ->as_xml($args);
+
+}
+
+__PACKAGE__->register_method(
+	method    => 'basic_record_holdings',
+	api_name  => 'open-ils.supercat.record.basic_holdings.retrieve',
+	api_level => 1,
+	argc      => 1,
+	stream    => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns a basic hash representation of the requested bibliographic record's holdings
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'bibId',
+				  desc => 'An OpenILS biblio::record_entry id',
+				  type => 'number' },
+			],
+		  'return' =>
+		  	{ desc => 'Hash of bib record holdings hierarchy (call numbers and copies)',
+			  type => 'string' }
+		}
+);
+sub basic_record_holdings {
+	my $self = shift;
+	my $client = shift;
+	my $bib = shift;
+	my $ou = shift;
+
+	#  holdings hold an array of call numbers, which hold an array of copies
+	#  holdings => [ label: { library, [ copies: { barcode, location, status, circ_lib } ] } ]
+	my %holdings;
+
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+
+	my $tree = $_storage->request(
+		"open-ils.cstore.direct.biblio.record_entry.retrieve",
+		$bib,
+		{ flesh		=> 5,
+		  flesh_fields	=> {
+					bre	=> [qw/call_numbers/],
+		  			acn	=> [qw/copies owning_lib/],
+					acp	=> [qw/location status circ_lib/],
+				}
+		}
+	)->gather(1);
+
+	my $o_search = { shortname => uc($ou) };
+	if (!$ou || $ou eq '-') {
+		$o_search = { parent_ou => undef };
+	}
+
+	my $orgs = $_storage->request(
+		"open-ils.cstore.direct.actor.org_unit.search",
+		$o_search,
+		{ flesh		=> 100,
+		  flesh_fields	=> { aou	=> [qw/children/] }
+		}
+	)->gather(1);
+
+	my @ou_ids = tree_walker($orgs, 'children', sub {shift->id}) if $orgs;
+
+	$logger->debug("Searching for holdings at orgs [".join(',',@ou_ids)."], based on $ou");
+
+	for my $cn (@{$tree->call_numbers}) {
+        next unless ( $cn->deleted eq 'f' || $cn->deleted == 0 );
+
+		my $found = 0;
+		for my $c (@{$cn->copies}) {
+			next unless grep {$c->circ_lib->id == $_} @ou_ids;
+			next unless ( $c->deleted eq 'f' || $c->deleted == 0 );
+			$found = 1;
+			last;
+		}
+		next unless $found;
+
+		$holdings{$cn->label}{'owning_lib'} = $cn->owning_lib->shortname;
+
+		for my $cp (@{$cn->copies}) {
+
+			next unless grep { $cp->circ_lib->id == $_ } @ou_ids;
+			next unless ( $cp->deleted eq 'f' || $cp->deleted == 0 );
+
+			push @{$holdings{$cn->label}{'copies'}}, {
+                barcode => $cp->barcode,
+                status => $cp->status->name,
+                location => $cp->location->name,
+                circlib => $cp->circ_lib->shortname
+            };
+
+		}
+	}
+
+	return \%holdings;
+}
+
+#__PACKAGE__->register_method(
+#	method    => 'new_record_holdings',
+#	api_name  => 'open-ils.supercat.record.holdings_xml.retrieve',
+#	api_level => 1,
+#	argc      => 1,
+#	stream    => 1,
+#	signature =>
+#		{ desc     => <<"		  DESC",
+#Returns the XML representation of the requested bibliographic record's holdings
+#		  DESC
+#		  params   =>
+#		  	[
+#				{ name => 'bibId',
+#				  desc => 'An OpenILS biblio::record_entry id',
+#				  type => 'number' },
+#			],
+#		  'return' =>
+#		  	{ desc => 'Stream of bib record holdings hierarchy in XML',
+#			  type => 'string' }
+#		}
+#);
+#
+
+sub new_record_holdings {
+	my $self = shift;
+	my $client = shift;
+	my $bib = shift;
+	my $ou = shift;
+	my $depth = shift;
+	my $flesh = shift;
+	my $paging = shift;
+
+    $paging = [-1,0] if (!$paging or !ref($paging) or @$paging == 0);
+    my $limit = $$paging[0];
+    my $offset = $$paging[1] || 0;
+
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+	my $_search = OpenSRF::AppSession->create( 'open-ils.search' );
+
+	my $o_search = { shortname => uc($ou) };
+	if (!$ou || $ou eq '-') {
+		$o_search = { parent_ou => undef };
+	}
+
+    my $one_org = $_storage->request(
+        "open-ils.cstore.direct.actor.org_unit.search",
+        $o_search
+    )->gather(1);
+
+    my $count_req = $_search->request('open-ils.search.biblio.record.copy_count' => $one_org->id => $bib);
+    my $staff_count_req = $_search->request('open-ils.search.biblio.record.copy_count.staff' => $one_org->id => $bib);
+
+    my $orgs = $_storage->request(
+        'open-ils.cstore.json_query.atomic',
+        { from => [ 'actor.org_unit_descendants', defined($depth) ? ( $one_org->id, $depth ) :  ( $one_org->id ) ] }
+    )->gather(1);
+
+
+	my @ou_ids = map { $_->{id} } @$orgs;
+
+	$logger->info("Searching for holdings at orgs [".join(',',@ou_ids)."], based on $ou");
+
+    my %subselect = ( '-or' => [
+        { owning_lib => \@ou_ids },
+        { '-exists'  =>
+            { from  => 'acp',
+              where => {
+                call_number => { '=' => {'+acn'=>'id'} },
+                deleted => 'f',
+                circ_lib => \@ou_ids
+              }
+            }
+        }
+    ]);
+
+    if ($flesh and $flesh eq 'uris') {
+        %subselect = (
+            owning_lib => \@ou_ids,
+            '-exists'  => {
+                from  => { auricnm => 'auri' },
+                where => {
+                    call_number => { '=' => {'+acn'=>'id'} },
+                    '+auri' => { active => 't' }
+                }
+            }
+        );
+    }
+
+
+	my $cns = $_storage->request(
+		"open-ils.cstore.direct.asset.call_number.search.atomic",
+		{ record  => $bib,
+          deleted => 'f',
+          %subselect
+        },
+		{ flesh		=> 5,
+		  flesh_fields	=> {
+		  			acn	=> [qw/copies owning_lib uri_maps/],
+		  			auricnm	=> [qw/uri/],
+					acp	=> [qw/circ_lib location status stat_cat_entries notes/],
+					asce	=> [qw/stat_cat/],
+				},
+          ( $limit > -1 ? ( limit  => $limit  ) : () ),
+          ( $offset     ? ( offset => $offset ) : () ),
+          order_by  => { acn => { label_sortkey => {} } }
+		}
+	)->gather(1);
+
+	my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
+	$year += 1900;
+	$month += 1;
+
+	$client->respond("\n");
+
+	my $copy_counts = $count_req->gather(1);
+	my $staff_copy_counts = $staff_count_req->gather(1);
+
+	for my $c (@$copy_counts) {
+		$$c{transcendant} ||= 0;
+		my $out = "respond("$out/>\n")
+	}
+
+	for my $c (@$staff_copy_counts) {
+		$$c{transcendant} ||= 0;
+		my $out = "respond("$out/>\n")
+	}
+
+    $client->respond("\n");
+    
+	for my $cn (@$cns) {
+		next unless (@{$cn->copies} > 0 or (ref($cn->uri_maps) and @{$cn->uri_maps}));
+
+		# We don't want O:A:S:unAPI::acn to return the record, we've got that already
+		# In the context of BibTemplate, copies aren't necessary because we pull those
+		# in a separate call
+        $client->respond(
+            OpenILS::Application::SuperCat::unAPI::acn
+                ->new( $cn )
+                ->as_xml( {no_record => 1, no_copies => ($flesh ? 0 : 1)} )
+        );
+	}
+
+	$client->respond("\n");
+
+	$logger->info("Searching for serial holdings at orgs [".join(',',@ou_ids)."], based on $ou");
+
+    %subselect = ( '-or' => [
+        { owning_lib => \@ou_ids },
+        { '-exists'  =>
+            { from  => 'sdist',
+              where => { holding_lib => \@ou_ids }
+            }
+        }
+    ]);
+
+	my $ssubs = $_storage->request(
+		"open-ils.cstore.direct.serial.subscription.search.atomic",
+		{ record_entry  => $bib,
+          %subselect
+        },
+		{ flesh		=> 7,
+		  flesh_fields	=> {
+		  			ssub	=> [qw/distributions issuances scaps owning_lib/],
+		  			sdist	=> [qw/basic_summary supplement_summary index_summary streams holding_lib/],
+					sstr	=> [qw/items/],
+					sitem	=> [qw/notes unit/],
+					sunit	=> [qw/notes location status circ_lib stat_cat_entries call_number/],
+					acn	=> [qw/owning_lib/],
+				},
+          ( $limit > -1 ? ( limit  => $limit  ) : () ),
+          ( $offset     ? ( offset => $offset ) : () ),
+          order_by  => {
+			ssub => {
+				start_date => {},
+				owning_lib => {},
+				id => {}
+			},
+			sdist => {
+				label => {},
+				owning_lib => {},
+			},
+			sunit => {
+				date_expected => {},
+			}
+		  }
+		}
+	)->gather(1);
+
+
+	for my $ssub (@$ssubs) {
+		next unless (@{$ssub->distributions} or @{$ssub->issuances} or @{$ssub->scaps});
+
+		# We don't want O:A:S:unAPI::ssub to return the record, we've got that already
+		# In the context of BibTemplate, copies aren't necessary because we pull those
+		# in a separate call
+        $client->respond(
+            OpenILS::Application::SuperCat::unAPI::ssub
+                ->new( $ssub )
+                ->as_xml( {no_record => 1, no_items => ($flesh ? 0 : 1)} )
+        );
+	}
+
+
+	return "\n";
+}
+__PACKAGE__->register_method(
+	method    => 'new_record_holdings',
+	api_name  => 'open-ils.supercat.record.holdings_xml.retrieve',
+	api_level => 1,
+	argc      => 1,
+	stream    => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the XML representation of the requested bibliographic record's holdings
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'bibId',
+				  desc => 'An OpenILS biblio::record_entry ID',
+				  type => 'number' },
+				{ name => 'orgUnit',
+				  desc => 'An OpenILS actor::org_unit short name that limits the scope of returned holdings',
+				  type => 'text' },
+				{ name => 'depth',
+				  desc => 'An OpenILS actor::org_unit_type depththat limits the scope of returned holdings',
+				  type => 'number' },
+				{ name => 'hideCopies',
+				  desc => 'Flag that prevents the inclusion of copies in the returned holdings',
+				  type => 'boolean' },
+				{ name => 'paging',
+				  desc => 'Arry of limit and offset for holdings paging',
+				  type => 'array' },
+			],
+		  'return' =>
+		  	{ desc => 'Stream of bib record holdings hierarchy in XML',
+			  type => 'string' }
+		}
+);
+
+sub isbn_holdings {
+	my $self = shift;
+	my $client = shift;
+	my $isbn = shift;
+
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+
+	my $recs = $_storage->request(
+			'open-ils.cstore.direct.metabib.full_rec.search.atomic',
+			{ tag => { like => '02%'}, value => {like => "$isbn\%"}}
+	)->gather(1);
+
+	return undef unless (@$recs);
+
+	return ($self->method_lookup( 'open-ils.supercat.record.holdings_xml.retrieve')->run( $recs->[0]->record ))[0];
+}
+__PACKAGE__->register_method(
+	method    => 'isbn_holdings',
+	api_name  => 'open-ils.supercat.isbn.holdings_xml.retrieve',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the XML representation of the requested bibliographic record's holdings
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'isbn',
+				  desc => 'An isbn',
+				  type => 'string' },
+			],
+		  'return' =>
+		  	{ desc => 'The bib record holdings hierarchy in XML',
+			  type => 'string' }
+		}
+);
+
+sub escape {
+	my $self = shift;
+	my $text = shift;
+    return '' unless $text;
+	$text =~ s/&/&/gsom;
+	$text =~ s//>/gsom;
+	$text =~ s/"/"/gsom;
+	$text =~ s/'/'/gsom;
+	return $text;
+}
+
+sub recent_changes {
+	my $self = shift;
+	my $client = shift;
+	my $when = shift || '1-01-01';
+	my $limit = shift;
+
+	my $type = 'biblio';
+	my $hint = 'bre';
+
+	if ($self->api_name =~ /authority/o) {
+		$type = 'authority';
+		$hint = 'are';
+	}
+
+	my $axis = 'create_date';
+	$axis = 'edit_date' if ($self->api_name =~ /edit/o);
+
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+
+	return $_storage->request(
+		"open-ils.cstore.direct.$type.record_entry.id_list.atomic",
+		{ $axis => { ">" => $when }, id => { '>' => 0 }, deleted => 'f', active => 't' },
+		{ order_by => { $hint => "$axis desc" }, limit => $limit }
+	)->gather(1);
+}
+
+for my $t ( qw/biblio authority/ ) {
+	for my $a ( qw/import edit/ ) {
+
+		__PACKAGE__->register_method(
+			method    => 'recent_changes',
+			api_name  => "open-ils.supercat.$t.record.$a.recent",
+			api_level => 1,
+			argc      => 0,
+			signature =>
+				{ desc     => "Returns a list of recently ${a}ed $t records",
+		  		  params   =>
+		  			[
+						{ name => 'when',
+				  		  desc => "Date to start looking for ${a}ed records",
+				  		  default => '1-01-01',
+				  		  type => 'string' },
+
+						{ name => 'limit',
+				  		  desc => "Maximum count to retrieve",
+				  		  type => 'number' },
+					],
+		  		  'return' =>
+		  			{ desc => "An id list of $t records",
+			  		  type => 'array' }
+				},
+		);
+	}
+}
+
+
+sub retrieve_authority_marcxml {
+	my $self = shift;
+	my $client = shift;
+	my $rid = shift;
+
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+
+	my $record = $_storage->request( 'open-ils.cstore.direct.authority.record_entry.retrieve' => $rid )->gather(1);
+	return $U->entityize( $record->marc ) if ($record);
+	return undef;
+}
+
+__PACKAGE__->register_method(
+	method    => 'retrieve_authority_marcxml',
+	api_name  => 'open-ils.supercat.authority.marcxml.retrieve',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the MARCXML representation of the requested authority record
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'authorityId',
+				  desc => 'An OpenILS authority::record_entry id',
+				  type => 'number' },
+			],
+		  'return' =>
+		  	{ desc => 'The authority record in MARCXML',
+			  type => 'string' }
+		}
+);
+
+sub retrieve_record_marcxml {
+	my $self = shift;
+	my $client = shift;
+	my $rid = shift;
+
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+
+	my $record = $_storage->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve' => $rid )->gather(1);
+	return $U->entityize( $record->marc ) if ($record);
+	return undef;
+}
+
+__PACKAGE__->register_method(
+	method    => 'retrieve_record_marcxml',
+	api_name  => 'open-ils.supercat.record.marcxml.retrieve',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the MARCXML representation of the requested bibliographic record
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'bibId',
+				  desc => 'An OpenILS biblio::record_entry id',
+				  type => 'number' },
+			],
+		  'return' =>
+		  	{ desc => 'The bib record in MARCXML',
+			  type => 'string' }
+		}
+);
+
+sub retrieve_isbn_marcxml {
+	my $self = shift;
+	my $client = shift;
+	my $isbn = shift;
+
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+
+	my $recs = $_storage->request(
+			'open-ils.cstore.direct.metabib.full_rec.search.atomic',
+			{ tag => { like => '02%'}, value => {like => "$isbn\%"}}
+	)->gather(1);
+
+	return undef unless (@$recs);
+
+	my $record = $_storage->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve' => $recs->[0]->record )->gather(1);
+	return $U->entityize( $record->marc ) if ($record);
+	return undef;
+}
+
+__PACKAGE__->register_method(
+	method    => 'retrieve_isbn_marcxml',
+	api_name  => 'open-ils.supercat.isbn.marcxml.retrieve',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the MARCXML representation of the requested ISBN
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'ISBN',
+				  desc => 'An ... um ... ISBN',
+				  type => 'string' },
+			],
+		  'return' =>
+		  	{ desc => 'The bib record in MARCXML',
+			  type => 'string' }
+		}
+);
+
+sub retrieve_record_transform {
+	my $self = shift;
+	my $client = shift;
+	my $rid = shift;
+
+	(my $transform = $self->api_name) =~ s/^.+record\.([^\.]+)\.retrieve$/$1/o;
+
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+	#$_storage->connect;
+
+	my $record = $_storage->request(
+		'open-ils.cstore.direct.biblio.record_entry.retrieve',
+		$rid
+	)->gather(1);
+
+	return undef unless ($record);
+
+	return $U->entityize($record_xslt{$transform}{xslt}->transform( $_parser->parse_string( $record->marc ) )->toString);
+}
+
+sub retrieve_isbn_transform {
+	my $self = shift;
+	my $client = shift;
+	my $isbn = shift;
+
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+
+	my $recs = $_storage->request(
+			'open-ils.cstore.direct.metabib.full_rec.search.atomic',
+			{ tag => { like => '02%'}, value => {like => "$isbn\%"}}
+	)->gather(1);
+
+	return undef unless (@$recs);
+
+	(my $transform = $self->api_name) =~ s/^.+isbn\.([^\.]+)\.retrieve$/$1/o;
+
+	my $record = $_storage->request( 'open-ils.cstore.direct.biblio.record_entry.retrieve' => $recs->[0]->record )->gather(1);
+
+	return undef unless ($record);
+
+	return $U->entityize($record_xslt{$transform}{xslt}->transform( $_parser->parse_string( $record->marc ) )->toString);
+}
+
+sub retrieve_record_objects {
+	my $self = shift;
+	my $client = shift;
+	my $ids = shift;
+
+	$ids = [$ids] unless (ref $ids);
+	$ids = [grep {$_} @$ids];
+
+	return [] unless (@$ids);
+
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+	return $_storage->request('open-ils.cstore.direct.biblio.record_entry.search.atomic' => { id => [grep {$_} @$ids] })->gather(1);
+}
+__PACKAGE__->register_method(
+	method    => 'retrieve_record_objects',
+	api_name  => 'open-ils.supercat.record.object.retrieve',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the Fieldmapper object representation of the requested bibliographic records
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'bibIds',
+				  desc => 'OpenILS biblio::record_entry ids',
+				  type => 'array' },
+			],
+		  'return' =>
+		  	{ desc => 'The bib records',
+			  type => 'array' }
+		}
+);
+
+
+sub retrieve_isbn_object {
+	my $self = shift;
+	my $client = shift;
+	my $isbn = shift;
+
+	return undef unless ($isbn);
+
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+	my $recs = $_storage->request(
+			'open-ils.cstore.direct.metabib.full_rec.search.atomic',
+			{ tag => { like => '02%'}, value => {like => "$isbn\%"}}
+	)->gather(1);
+
+	return undef unless (@$recs);
+
+	return $_storage->request(
+		'open-ils.cstore.direct.biblio.record_entry.search.atomic',
+		{ id => $recs->[0]->record }
+	)->gather(1);
+}
+__PACKAGE__->register_method(
+	method    => 'retrieve_isbn_object',
+	api_name  => 'open-ils.supercat.isbn.object.retrieve',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the Fieldmapper object representation of the requested bibliographic record
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'isbn',
+				  desc => 'an ISBN',
+				  type => 'string' },
+			],
+		  'return' =>
+		  	{ desc => 'The bib record',
+			  type => 'object' }
+		}
+);
+
+
+
+sub retrieve_metarecord_mods {
+	my $self = shift;
+	my $client = shift;
+	my $rid = shift;
+
+	my $_storage = OpenSRF::AppSession->connect( 'open-ils.cstore' );
+
+	# Get the metarecord in question
+	my $mr =
+	$_storage->request(
+		'open-ils.cstore.direct.metabib.metarecord.retrieve' => $rid
+	)->gather(1);
+
+	# Now get the map of all bib records for the metarecord
+	my $recs =
+	$_storage->request(
+		'open-ils.cstore.direct.metabib.metarecord_source_map.search.atomic',
+		{metarecord => $rid}
+	)->gather(1);
+
+	$logger->debug("Adding ".scalar(@$recs)." bib record to the MODS of the metarecord");
+
+	# and retrieve the lead (master) record as MODS
+	my ($master) =
+		$self	->method_lookup('open-ils.supercat.record.mods.retrieve')
+			->run($mr->master_record);
+	my $master_mods = $_parser->parse_string($master)->documentElement;
+	$master_mods->setNamespace( "http://www.loc.gov/mods/", "mods" );
+	$master_mods->setNamespace( "http://www.loc.gov/mods/", undef, 1 );
+
+	# ... and a MODS clone to populate, with guts removed.
+	my $mods = $_parser->parse_string($master)->documentElement;
+	$mods->setNamespace( "http://www.loc.gov/mods/", "mods" ); # modsCollection element
+	$mods->setNamespace('http://www.loc.gov/mods/', undef, 1);
+	($mods) = $mods->findnodes('//mods:mods');
+	#$mods->setNamespace( "http://www.loc.gov/mods/", "mods" ); # mods element
+	$mods->removeChildNodes;
+	$mods->setNamespace('http://www.loc.gov/mods/', undef, 1);
+
+	# Add the metarecord ID as a (locally defined) info URI
+	my $recordInfo = $mods
+		->ownerDocument
+		->createElement("recordInfo");
+
+	my $recordIdentifier = $mods
+		->ownerDocument
+		->createElement("recordIdentifier");
+
+	my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
+	$year += 1900;
+	$month += 1;
+
+	my $id = $mr->id;
+	$recordIdentifier->appendTextNode(
+		sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d:metabib-metarecord/$id", $month, $day)
+	);
+
+	$recordInfo->appendChild($recordIdentifier);
+	$mods->appendChild($recordInfo);
+
+	# Grab the title, author and ISBN for the master record and populate the metarecord
+	my ($title) = $master_mods->findnodes( './mods:titleInfo[not(@type)]' );
+	
+	if ($title) {
+		$title->setNamespace( "http://www.loc.gov/mods/", "mods" );
+		$title->setNamespace( "http://www.loc.gov/mods/", undef, 1 );
+		$title = $mods->ownerDocument->importNode($title);
+		$mods->appendChild($title);
+	}
+
+	my ($author) = $master_mods->findnodes( './mods:name[mods:role/mods:text[text()="creator"]]' );
+	if ($author) {
+		$author->setNamespace( "http://www.loc.gov/mods/", "mods" );
+		$author->setNamespace( "http://www.loc.gov/mods/", undef, 1 );
+		$author = $mods->ownerDocument->importNode($author);
+		$mods->appendChild($author);
+	}
+
+	my ($isbn) = $master_mods->findnodes( './mods:identifier[@type="isbn"]' );
+	if ($isbn) {
+		$isbn->setNamespace( "http://www.loc.gov/mods/", "mods" );
+		$isbn->setNamespace( "http://www.loc.gov/mods/", undef, 1 );
+		$isbn = $mods->ownerDocument->importNode($isbn);
+		$mods->appendChild($isbn);
+	}
+
+	# ... and loop over the constituent records
+	for my $map ( @$recs ) {
+
+		# get the MODS
+		my ($rec) =
+			$self	->method_lookup('open-ils.supercat.record.mods.retrieve')
+				->run($map->source);
+
+		my $part_mods = $_parser->parse_string($rec);
+		$part_mods->documentElement->setNamespace( "http://www.loc.gov/mods/", "mods" );
+		$part_mods->documentElement->setNamespace( "http://www.loc.gov/mods/", undef, 1 );
+		($part_mods) = $part_mods->findnodes('//mods:mods');
+
+		for my $node ( ($part_mods->findnodes( './mods:subject' )) ) {
+			$node->setNamespace( "http://www.loc.gov/mods/", "mods" );
+			$node->setNamespace( "http://www.loc.gov/mods/", undef, 1 );
+			$node = $mods->ownerDocument->importNode($node);
+			$mods->appendChild( $node );
+		}
+
+		my $relatedItem = $mods
+			->ownerDocument
+			->createElement("relatedItem");
+
+		$relatedItem->setAttribute( type => 'constituent' );
+
+		my $identifier = $mods
+			->ownerDocument
+			->createElement("identifier");
+
+		$identifier->setAttribute( type => 'uri' );
+
+		my $subRecordInfo = $mods
+			->ownerDocument
+			->createElement("recordInfo");
+
+		my $subRecordIdentifier = $mods
+			->ownerDocument
+			->createElement("recordIdentifier");
+
+		my $subid = $map->source;
+		$subRecordIdentifier->appendTextNode(
+			sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d:biblio-record_entry/$subid",
+				$month,
+				$day
+			)
+		);
+		$subRecordInfo->appendChild($subRecordIdentifier);
+
+		$relatedItem->appendChild( $subRecordInfo );
+
+		my ($tor) = $part_mods->findnodes( './mods:typeOfResource' );
+		$tor->setNamespace( "http://www.loc.gov/mods/", "mods" );
+		$tor->setNamespace( "http://www.loc.gov/mods/", undef, 1 ) if ($tor);
+		$tor = $mods->ownerDocument->importNode($tor) if ($tor);
+		$relatedItem->appendChild($tor) if ($tor);
+
+		if ( my ($part_isbn) = $part_mods->findnodes( './mods:identifier[@type="isbn"]' ) ) {
+			$part_isbn->setNamespace( "http://www.loc.gov/mods/", "mods" );
+			$part_isbn->setNamespace( "http://www.loc.gov/mods/", undef, 1 );
+			$part_isbn = $mods->ownerDocument->importNode($part_isbn);
+			$relatedItem->appendChild( $part_isbn );
+
+			if (!$isbn) {
+				$isbn = $mods->appendChild( $part_isbn->cloneNode(1) );
+			}
+		}
+
+		$mods->appendChild( $relatedItem );
+
+	}
+
+	$_storage->disconnect;
+
+	return $U->entityize($mods->toString);
+
+}
+__PACKAGE__->register_method(
+	method    => 'retrieve_metarecord_mods',
+	api_name  => 'open-ils.supercat.metarecord.mods.retrieve',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the MODS representation of the requested metarecord
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'metarecordId',
+				  desc => 'An OpenILS metabib::metarecord id',
+				  type => 'number' },
+			],
+		  'return' =>
+		  	{ desc => 'The metarecord in MODS',
+			  type => 'string' }
+		}
+);
+
+sub list_metarecord_formats {
+	my @list = (
+		{ mods =>
+			{ namespace_uri	  => 'http://www.loc.gov/mods/',
+			  docs		  => 'http://www.loc.gov/mods/',
+			  schema_location => 'http://www.loc.gov/standards/mods/mods.xsd',
+			}
+		}
+	);
+
+	for my $type ( keys %metarecord_xslt ) {
+		push @list,
+			{ $type => 
+				{ namespace_uri	  => $metarecord_xslt{$type}{namespace_uri},
+				  docs		  => $metarecord_xslt{$type}{docs},
+				  schema_location => $metarecord_xslt{$type}{schema_location},
+				}
+			};
+	}
+
+	return \@list;
+}
+__PACKAGE__->register_method(
+	method    => 'list_metarecord_formats',
+	api_name  => 'open-ils.supercat.metarecord.formats',
+	api_level => 1,
+	argc      => 0,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the list of valid metarecord formats that supercat understands.
+		  DESC
+		  'return' =>
+		  	{ desc => 'The format list',
+			  type => 'array' }
+		}
+);
+
+
+sub list_authority_formats {
+	my @list = (
+		{ marcxml =>
+			{ namespace_uri	  => 'http://www.loc.gov/MARC21/slim',
+			  docs		  => 'http://www.loc.gov/marcxml/',
+			  schema_location => 'http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd',
+			}
+		}
+	);
+
+#	for my $type ( keys %record_xslt ) {
+#		push @list,
+#			{ $type => 
+#				{ namespace_uri	  => $record_xslt{$type}{namespace_uri},
+#				  docs		  => $record_xslt{$type}{docs},
+#				  schema_location => $record_xslt{$type}{schema_location},
+#				}
+#			};
+#	}
+#
+	return \@list;
+}
+__PACKAGE__->register_method(
+	method    => 'list_authority_formats',
+	api_name  => 'open-ils.supercat.authority.formats',
+	api_level => 1,
+	argc      => 0,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the list of valid authority formats that supercat understands.
+		  DESC
+		  'return' =>
+		  	{ desc => 'The format list',
+			  type => 'array' }
+		}
+);
+
+sub list_record_formats {
+	my @list = (
+		{ marcxml =>
+			{ namespace_uri	  => 'http://www.loc.gov/MARC21/slim',
+			  docs		  => 'http://www.loc.gov/marcxml/',
+			  schema_location => 'http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd',
+			}
+		}
+	);
+
+	for my $type ( keys %record_xslt ) {
+		push @list,
+			{ $type => 
+				{ namespace_uri	  => $record_xslt{$type}{namespace_uri},
+				  docs		  => $record_xslt{$type}{docs},
+				  schema_location => $record_xslt{$type}{schema_location},
+				}
+			};
+	}
+
+	return \@list;
+}
+__PACKAGE__->register_method(
+	method    => 'list_record_formats',
+	api_name  => 'open-ils.supercat.record.formats',
+	api_level => 1,
+	argc      => 0,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the list of valid record formats that supercat understands.
+		  DESC
+		  'return' =>
+		  	{ desc => 'The format list',
+			  type => 'array' }
+		}
+);
+__PACKAGE__->register_method(
+	method    => 'list_record_formats',
+	api_name  => 'open-ils.supercat.isbn.formats',
+	api_level => 1,
+	argc      => 0,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the list of valid record formats that supercat understands.
+		  DESC
+		  'return' =>
+		  	{ desc => 'The format list',
+			  type => 'array' }
+		}
+);
+
+
+sub oISBN {
+	my $self = shift;
+	my $client = shift;
+	my $isbn = shift;
+
+	$isbn =~ s/-//gso;
+
+	throw OpenSRF::EX::InvalidArg ('I need an ISBN please')
+		unless (length($isbn) >= 10);
+
+	my $_storage = OpenSRF::AppSession->create( 'open-ils.cstore' );
+
+	# Create a storage session, since we'll be making muliple requests.
+	$_storage->connect;
+
+	# Find the record that has that ISBN.
+	my $bibrec = $_storage->request(
+		'open-ils.cstore.direct.metabib.full_rec.search.atomic',
+		{ tag => '020', subfield => 'a', value => { like => lc($isbn).'%'} }
+	)->gather(1);
+
+	# Go away if we don't have one.
+	return {} unless (@$bibrec);
+
+	# Find the metarecord for that bib record.
+	my $mr = $_storage->request(
+		'open-ils.cstore.direct.metabib.metarecord_source_map.search.atomic',
+		{source => $bibrec->[0]->record}
+	)->gather(1);
+
+	# Find the other records for that metarecord.
+	my $records = $_storage->request(
+		'open-ils.cstore.direct.metabib.metarecord_source_map.search.atomic',
+		{metarecord => $mr->[0]->metarecord}
+	)->gather(1);
+
+	# Just to be safe.  There's currently no unique constraint on sources...
+	my %unique_recs = map { ($_->source, 1) } @$records;
+	my @rec_list = sort keys %unique_recs;
+
+	# And now fetch the ISBNs for thos records.
+	my $recs = [];
+	push @$recs,
+		$_storage->request(
+			'open-ils.cstore.direct.metabib.full_rec.search',
+			{ tag => '020', subfield => 'a', record => $_ }
+		)->gather(1) for (@rec_list);
+
+	# We're done with the storage server session.
+	$_storage->disconnect;
+
+	# Return the oISBN data structure.  This will be XMLized at a higher layer.
+	return
+		{ metarecord => $mr->[0]->metarecord,
+		  record_list => { map { $_ ? ($_->record, $_->value) : () } @$recs } };
+
+}
+__PACKAGE__->register_method(
+	method    => 'oISBN',
+	api_name  => 'open-ils.supercat.oisbn',
+	api_level => 1,
+	argc      => 1,
+	signature =>
+		{ desc     => <<"		  DESC",
+Returns the ISBN list for the metarecord of the requested isbn
+		  DESC
+		  params   =>
+		  	[
+				{ name => 'isbn',
+				  desc => 'An ISBN.  Duh.',
+				  type => 'string' },
+			],
+		  'return' =>
+		  	{ desc => 'record to isbn map',
+			  type => 'object' }
+		}
+);
+
+package OpenILS::Application::SuperCat::unAPI;
+use base qw/OpenILS::Application::SuperCat/;
+
+sub as_xml {
+    die "dummy superclass, use a real class";
+}
+
+sub new {
+    my $class = shift;
+    my $obj = shift;
+    return unless ($obj);
+
+    $class = ref($class) || $class;
+
+    if ($class eq __PACKAGE__) {
+        return unless (ref($obj));
+        $class .= '::' . $obj->json_hint;
+    }
+
+    return bless { obj => $obj } => $class;
+}
+
+sub obj {
+    my $self = shift;
+    return $self->{obj};
+}
+
+package OpenILS::Application::SuperCat::unAPI::auri;
+use base qw/OpenILS::Application::SuperCat::unAPI/;
+
+sub as_xml {
+    my $self = shift;
+    my $args = shift;
+
+    my $xml = '      obj->id . '" ';
+    $xml .= 'use_restriction="' . $self->escape( $self->obj->use_restriction ) . '" ';
+    $xml .= 'label="' . $self->escape( $self->obj->label ) . '" ';
+    $xml .= 'href="' . $self->escape( $self->obj->href ) . '">';
+
+    if (!$args->{no_volumes}) {
+        if (ref($self->obj->call_number_maps) && @{ $self->obj->call_number_maps }) {
+            $xml .= "      \n" . join(
+                '',
+                map {
+                    OpenILS::Application::SuperCat::unAPI
+                        ->new( $_->call_number )
+                        ->as_xml({ %$args, no_uris=>1, no_copies=>1 })
+                } @{ $self->obj->call_number_maps }
+            ) . "      \n";
+
+        } else {
+            $xml .= "      \n";
+        }
+    }
+
+    $xml .= "      \n";
+
+    return $xml;
+}
+
+package OpenILS::Application::SuperCat::unAPI::acn;
+use base qw/OpenILS::Application::SuperCat::unAPI/;
+
+sub as_xml {
+    my $self = shift;
+    my $args = shift;
+
+    my $xml = '    obj->id . '" ';
+    $xml .= 'lib="' . $self->escape( $self->obj->owning_lib->shortname ) . '" ';
+    $xml .= 'opac_visible="' . $self->obj->owning_lib->opac_visible . '" ';
+    $xml .= 'deleted="' . $self->obj->deleted . '" ';
+    $xml .= 'label="' . $self->escape( $self->obj->label ) . '">';
+    $xml .= "\n";
+
+    if (!$args->{no_copies}) {
+        if (ref($self->obj->copies) && @{ $self->obj->copies }) {
+            $xml .= "      \n" . join(
+                '',
+                map {
+                    OpenILS::Application::SuperCat::unAPI
+                        ->new( $_ )
+                        ->as_xml({ %$args, no_volume=>1 })
+                } @{ $self->obj->copies }
+            ) . "      \n";
+
+        } else {
+            $xml .= "      \n";
+        }
+    }
+
+    if (!$args->{no_uris}) {
+        if (ref($self->obj->uri_maps) && @{ $self->obj->uri_maps }) {
+            $xml .= "      \n" . join(
+                '',
+                map {
+                    OpenILS::Application::SuperCat::unAPI
+                        ->new( $_->uri )
+                        ->as_xml({ %$args, no_volumes=>1 })
+                } @{ $self->obj->uri_maps }
+            ) . "      \n";
+
+        } else {
+            $xml .= "      \n";
+        }
+    }
+
+
+    $xml .= '      obj->owning_lib->id . '" ';
+    $xml .= 'shortname="'.$self->escape( $self->obj->owning_lib->shortname ) .'" ';
+    $xml .= 'name="'.$self->escape( $self->obj->owning_lib->name ) .'"/>';
+    $xml .= "\n";
+
+    unless ($args->{no_record}) {
+        my $rec_tag = "tag:open-ils.org:biblio-record_entry/".$self->obj->record->id.'/'.$self->escape( $self->obj->owning_lib->shortname ) ;
+
+        my $r_doc = $parser->parse_string($self->obj->record->marc);
+        $r_doc->documentElement->setAttribute( id => $rec_tag );
+        $xml .= $U->entityize($r_doc->documentElement->toString);
+    }
+
+    $xml .= "    \n";
+
+    return $xml;
+}
+
+package OpenILS::Application::SuperCat::unAPI::ssub;
+use base qw/OpenILS::Application::SuperCat::unAPI/;
+
+sub as_xml {
+    my $self = shift;
+    my $args = shift;
+
+    my $xml = '    obj->id . '" ';
+    $xml .= 'start="' . $self->escape( $self->obj->start_date ) . '" ';
+    $xml .= 'end="' . $self->escape( $self->obj->end_date ) . '" ';
+    $xml .= 'expected_date_offset="' . $self->escape( $self->obj->expected_date_offset ) . '">';
+    $xml .= "\n";
+
+    if (!$args->{no_distributions}) {
+        if (ref($self->obj->distributions) && @{ $self->obj->distributions }) {
+            $xml .= "      \n" . join(
+                '',
+                map {
+                    OpenILS::Application::SuperCat::unAPI
+                        ->new( $_ )
+                        ->as_xml({ %$args, no_subscription=>1, no_issuance=>1 })
+                } @{ $self->obj->distributions }
+            ) . "      \n";
+
+        } else {
+            $xml .= "      \n";
+        }
+    }
+
+    if (!$args->{no_captions_and_patterns}) {
+        if (ref($self->obj->scaps) && @{ $self->obj->scaps }) {
+            $xml .= "      \n" . join(
+                '',
+                map {
+                    OpenILS::Application::SuperCat::unAPI
+                        ->new( $_ )
+                        ->as_xml({ %$args, no_subscription=>1 })
+                } @{ $self->obj->scaps }
+            ) . "      \n";
+
+        } else {
+            $xml .= "      \n";
+        }
+    }
+
+    if (!$args->{no_issuances}) {
+        if (ref($self->obj->issuances) && @{ $self->obj->issuances }) {
+            $xml .= "      \n" . join(
+                '',
+                map {
+                    OpenILS::Application::SuperCat::unAPI
+                        ->new( $_ )
+                        ->as_xml({ %$args, no_subscription=>1, no_items=>1 })
+                } @{ $self->obj->issuances }
+            ) . "      \n";
+
+        } else {
+            $xml .= "      \n";
+        }
+    }
+
+
+    $xml .= '      obj->owning_lib->id . '" ';
+    $xml .= 'shortname="'.$self->escape( $self->obj->owning_lib->shortname ) .'" ';
+    $xml .= 'name="'.$self->escape( $self->obj->owning_lib->name ) .'"/>';
+    $xml .= "\n";
+
+    unless ($args->{no_record}) {
+        my $rec_tag = "tag:open-ils.org:biblio-record_entry/".$self->obj->record->id.'/'.$self->escape( $self->obj->owning_lib->shortname ) ;
+
+        my $r_doc = $parser->parse_string($self->obj->record_entry->marc);
+        $r_doc->documentElement->setAttribute( id => $rec_tag );
+        $xml .= $U->entityize($r_doc->documentElement->toString);
+    }
+
+    $xml .= "    \n";
+
+    return $xml;
+}
+
+package OpenILS::Application::SuperCat::unAPI::ssum_base;
+use base qw/OpenILS::Application::SuperCat::unAPI/;
+
+sub as_xml {
+    my $self = shift;
+    my $args = shift;
+
+    (my $type = ref($self)) =~ s/^.+([^:]+)$/$1/;
+
+    my $xml = "    obj->id . '" ';
+    $xml .= 'generated_coverage="' . $self->escape( $self->obj->generated_coverage ) . '" ';
+    $xml .= 'show_generated="' . $self->escape( $self->obj->show_generated ) . '" ';
+    $xml .= 'textual_holdings="' . $self->escape( $self->obj->textual_holdings ) . '">';
+    $xml .= "\n";
+
+	$xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->distribution )->as_xml({ %$args, no_summaries=>1 }) if (!$args->{no_distribution});
+
+    $xml .= "    \n";
+
+    return $xml;
+}
+
+
+package OpenILS::Application::SuperCat::unAPI::sssum;
+use base qw/OpenILS::Application::SuperCat::unAPI::ssum_base/;
+
+package OpenILS::Application::SuperCat::unAPI::sbsum;
+use base qw/OpenILS::Application::SuperCat::unAPI::ssum_base/;
+
+package OpenILS::Application::SuperCat::unAPI::sisum;
+use base qw/OpenILS::Application::SuperCat::unAPI::ssum_base/;
+
+package OpenILS::Application::SuperCat::unAPI::sdist;
+use base qw/OpenILS::Application::SuperCat::unAPI/;
+
+sub as_xml {
+    my $self = shift;
+    my $args = shift;
+
+    my $xml = '    obj->id . '" ';
+    $xml .= 'label="' . $self->escape( $self->obj->label ) . '" ';
+    $xml .= 'unit_label_prefix="' . $self->escape( $self->obj->unit_label_prefix ) . '" ';
+    $xml .= 'unit_label_suffix="' . $self->escape( $self->obj->unit_label_suffix ) . '">';
+    $xml .= "\n";
+
+    if (!$args->{no_distributions}) {
+        if (ref($self->obj->streams) && @{ $self->obj->streams }) {
+            $xml .= "      \n" . join(
+                '',
+                map {
+                    OpenILS::Application::SuperCat::unAPI
+                        ->new( $_ )
+                        ->as_xml({ %$args, no_distribution=>1 })
+                } @{ $self->obj->streams }
+            ) . "      \n";
+
+        } else {
+            $xml .= "      \n";
+        }
+    }
+
+    if (!$args->{no_summaries}) {
+        $xml .= "      \n";
+        $xml .= join ('',
+        map {
+            defined $_ ?
+                OpenILS::Application::SuperCat::unAPI
+                ->new( $_ )
+                ->as_xml({ %$args, no_distribution=>1 }) : ""
+        } ($self->obj->basic_summary, $self->obj->supplement_summary, $self->obj->index_summary)
+        );
+
+        $xml .= "      \n";
+    }
+
+
+    $xml .= '      obj->holding_lib->id . '" ';
+    $xml .= 'shortname="'.$self->escape( $self->obj->holding_lib->shortname ) .'" ';
+    $xml .= 'name="'.$self->escape( $self->obj->holding_lib->name ) .'"/>';
+    $xml .= "\n";
+
+	$xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->subscription )->as_xml({ %$args, no_distributions=>1 }) if (!$args->{no_subscription});
+
+    if (!$args->{no_record} && $self->obj->record_entry) {
+        my $rec_tag = "tag:open-ils.org:serial-record_entry/".$self->obj->record_entry->id ;
+
+        my $r_doc = $parser->parse_string($self->obj->record_entry->marc);
+        $r_doc->documentElement->setAttribute( id => $rec_tag );
+        $xml .= $U->entityize($r_doc->documentElement->toString);
+    }
+
+    $xml .= "    \n";
+
+    return $xml;
+}
+
+package OpenILS::Application::SuperCat::unAPI::sstr;
+use base qw/OpenILS::Application::SuperCat::unAPI/;
+
+sub as_xml {
+    my $self = shift;
+    my $args = shift;
+
+    my $xml = '    obj->id . '" ';
+    $xml .= 'routing_label="' . $self->escape( $self->obj->routing_label ) . '">';
+    $xml .= "\n";
+
+    if (!$args->{no_items}) {
+        if (ref($self->obj->items) && @{ $self->obj->items }) {
+            $xml .= "      \n" . join(
+                '',
+                map {
+                    OpenILS::Application::SuperCat::unAPI
+                        ->new( $_ )
+                        ->as_xml({ %$args, no_stream=>1 })
+                } @{ $self->obj->items }
+            ) . "      \n";
+
+        } else {
+            $xml .= "      \n";
+        }
+    }
+
+	#XXX routing_list_user's?
+
+	$xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->distribution )->as_xml({ %$args, no_streams=>1 }) if (!$args->{no_distribution});
+
+    $xml .= "    \n";
+
+    return $xml;
+}
+
+package OpenILS::Application::SuperCat::unAPI::sitem;
+use base qw/OpenILS::Application::SuperCat::unAPI/;
+
+sub as_xml {
+    my $self = shift;
+    my $args = shift;
+
+    my $xml = '    obj->id . '" ';
+    $xml .= 'date_expected="' . $self->escape( $self->obj->date_expected ) . '"';
+    $xml .= ' date_received="' . $self->escape( $self->obj->date_received ) .'"'if ($self->obj->date_received);
+
+	if ($args->{no_issuance}) {
+		my $siss = ref($self->obj->issuance) ? $self->obj->issuance->id : $self->obj->issuance;
+	    $xml .= ' issuance="tag:open-ils.org:serial-issuance/' . $siss . '"';
+	}
+
+    $xml .= ">\n";
+
+	if (ref($self->obj->notes) && $self->obj->notes) {
+		$xml .= "        \n";
+		for my $note ( @{$self->obj->notes} ) {
+			next unless ( $note->pub eq 't' );
+			$xml .= sprintf('        %s',$note->create_date, $self->escape($note->title), $self->escape($note->value));
+			$xml .= "\n";
+		}
+		$xml .= "        \n";
+    } else {
+        $xml .= "      \n";
+	}
+
+	$xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->issuance )->as_xml({ %$args, no_items=>1 }) if (!$args->{no_issuance});
+	$xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->stream )->as_xml({ %$args, no_items=>1 }) if (!$args->{no_stream});
+	$xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->unit )->as_xml({ %$args, no_items=>1, no_volumes=>1 }) if ($self->obj->unit && !$args->{no_unit});
+	$xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->uri )->as_xml({ %$args, no_items=>1, no_volumes=>1 }) if ($self->obj->uri && !$args->{no_uri});
+
+    $xml .= "    \n";
+
+    return $xml;
+}
+
+package OpenILS::Application::SuperCat::unAPI::sunit;
+use base qw/OpenILS::Application::SuperCat::unAPI/;
+
+sub as_xml {
+    my $self = shift;
+    my $args = shift;
+
+    my $xml = '      obj->status->id . '">' . $self->escape( $self->obj->status->name  ) . "\n";
+    $xml .= '        ' . $self->escape( $self->obj->location->name  ) . "\n";
+    $xml .= '        ' . $self->escape( $self->obj->circ_lib->name  ) . "\n";
+
+    $xml .= '        obj->circ_lib->id . '" ';
+    $xml .= 'shortname="'.$self->escape( $self->obj->circ_lib->shortname ) .'" ';
+    $xml .= 'name="'.$self->escape( $self->obj->circ_lib->name ) .'"/>';
+    $xml .= "\n";
+
+	$xml .= "        \n";
+	if (ref($self->obj->notes) && $self->obj->notes) {
+		for my $note ( @{$self->obj->notes} ) {
+			next unless ( $note->pub eq 't' );
+			$xml .= sprintf('        %s',$note->create_date, $self->escape($note->title), $self->escape($note->value));
+			$xml .= "\n";
+		}
+	}
+
+	$xml .= "        \n";
+    $xml .= "        \n";
+
+	if (ref($self->obj->stat_cat_entries) && $self->obj->stat_cat_entries) {
+		for my $sce ( @{$self->obj->stat_cat_entries} ) {
+			next unless ( $sce->stat_cat->opac_visible eq 't' );
+			$xml .= sprintf('          %s',$self->escape($sce->stat_cat->name) ,$self->escape($sce->value));
+			$xml .= "\n";
+		}
+	}
+	$xml .= "        \n";
+
+    unless ($args->{no_volume}) {
+        if (ref($self->obj->call_number)) {
+            $xml .= OpenILS::Application::SuperCat::unAPI
+                        ->new( $self->obj->call_number )
+                        ->as_xml({ %$args, no_copies=>1 });
+        } else {
+            $xml .= "    \n";
+        }
+    }
+
+    $xml .= "      \n";
+
+    return $xml;
+}
+
+package OpenILS::Application::SuperCat::unAPI::scap;
+use base qw/OpenILS::Application::SuperCat::unAPI/;
+
+sub as_xml {
+    my $self = shift;
+    my $args = shift;
+
+    my $xml = '      new( $self->obj->subscription )->as_xml({ %$args, no_captions_and_patterns=>1 }) if (!$args->{no_subscription});
+    $xml .= "      \n";
+
+    return $xml;
+}
+
+package OpenILS::Application::SuperCat::unAPI::siss;
+use base qw/OpenILS::Application::SuperCat::unAPI/;
+
+sub as_xml {
+    my $self = shift;
+    my $args = shift;
+
+    my $xml = '      {no_items}) {
+        if (ref($self->obj->items) && @{ $self->obj->items }) {
+            $xml .= "      \n" . join(
+                '',
+                map {
+                    OpenILS::Application::SuperCat::unAPI
+                        ->new( $_ )
+                        ->as_xml({ %$args, no_stream=>1 })
+                } @{ $self->obj->items }
+            ) . "      \n";
+
+        } else {
+            $xml .= "      \n";
+        }
+    }
+
+	$xml .= OpenILS::Application::SuperCat::unAPI->new( $self->obj->subscription )->as_xml({ %$args, no_issuances=>1 }) if (!$args->{no_subscription});
+    $xml .= "      \n";
+
+    return $xml;
+}
+
+package OpenILS::Application::SuperCat::unAPI::acp;
+use base qw/OpenILS::Application::SuperCat::unAPI/;
+
+sub as_xml {
+    my $self = shift;
+    my $args = shift;
+
+    my $xml = '      obj->status->id . '">' . $self->escape( $self->obj->status->name  ) . "\n";
+    $xml .= '        ' . $self->escape( $self->obj->location->name  ) . "\n";
+    $xml .= '        ' . $self->escape( $self->obj->circ_lib->name  ) . "\n";
+
+    $xml .= '        obj->circ_lib->id . '" ';
+    $xml .= 'shortname="'.$self->escape( $self->obj->circ_lib->shortname ) .'" ';
+    $xml .= 'name="'.$self->escape( $self->obj->circ_lib->name ) .'" opac_visible="'.$self->obj->circ_lib->opac_visible.'"/>';
+    $xml .= "\n";
+
+	$xml .= "        \n";
+	if (ref($self->obj->notes) && $self->obj->notes) {
+		for my $note ( @{$self->obj->notes} ) {
+			next unless ( $note->pub eq 't' );
+			$xml .= sprintf('        %s',$note->create_date, $self->escape($note->title), $self->escape($note->value));
+			$xml .= "\n";
+		}
+	}
+
+	$xml .= "        \n";
+    $xml .= "        \n";
+
+	if (ref($self->obj->stat_cat_entries) && $self->obj->stat_cat_entries) {
+		for my $sce ( @{$self->obj->stat_cat_entries} ) {
+			next unless ( $sce->stat_cat->opac_visible eq 't' );
+			$xml .= sprintf('          %s',$self->escape($sce->stat_cat->name) ,$self->escape($sce->value));
+			$xml .= "\n";
+		}
+	}
+	$xml .= "        \n";
+
+    unless ($args->{no_volume}) {
+        if (ref($self->obj->call_number)) {
+            $xml .= OpenILS::Application::SuperCat::unAPI
+                        ->new( $self->obj->call_number )
+                        ->as_xml({ %$args, no_copies=>1 });
+        } else {
+            $xml .= "    \n";
+        }
+    }
+
+    $xml .= "      \n";
+
+    return $xml;
+}
+
+
+1;
+# vim: et:ts=4:sw=4
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger.pm
new file mode 100644
index 0000000000..ae83a7755a
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger.pm
@@ -0,0 +1,842 @@
+package OpenILS::Application::Trigger;
+use strict; use warnings;
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+
+use OpenSRF::EX qw/:try/;
+use OpenSRF::Utils::JSON;
+
+use OpenSRF::AppSession;
+use OpenSRF::MultiSession;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenSRF::Utils qw/:datetime/;
+
+use DateTime;
+use DateTime::Format::ISO8601;
+
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Application::Trigger::Event;
+use OpenILS::Application::Trigger::EventGroup;
+
+
+my $log = 'OpenSRF::Utils::Logger';
+my $parallel_collect;
+my $parallel_react;
+
+sub initialize {
+
+    my $conf = OpenSRF::Utils::SettingsClient->new;
+    $parallel_collect = $conf->config_value( apps => 'open-ils.trigger' => app_settings => parallel => 'collect') || 1;
+    $parallel_react = $conf->config_value( apps => 'open-ils.trigger' => app_settings => parallel => 'react') || 1;
+
+}
+sub child_init {}
+
+sub create_active_events_for_object {
+    my $self = shift;
+    my $client = shift;
+    my $key = shift;
+    my $target = shift;
+    my $location = shift;
+    my $granularity = shift;
+    my $user_data = shift;
+
+    my $ident = $target->Identity;
+    my $ident_value = $target->$ident();
+
+    my $editor = new_editor(xact=>1);
+
+    my $hooks = $editor->search_action_trigger_hook(
+        { key       => $key,
+          core_type => $target->json_hint
+        }
+    );
+
+    unless(@$hooks) {
+        $editor->rollback;
+        return undef;
+    }
+
+    my %hook_hash = map { ($_->key, $_) } @$hooks;
+
+    my $orgs = $editor->json_query({ from => [ 'actor.org_unit_ancestors' => $location ] });
+    my $defs = $editor->search_action_trigger_event_definition(
+        { hook   => [ keys %hook_hash ],
+          owner  => [ map { $_->{id} } @$orgs  ],
+          active => 't'
+        }
+    );
+
+    for my $def ( @$defs ) {
+        next if ($granularity && $def->granularity ne $granularity );
+
+        if ($def->usr_field && $def->opt_in_setting) {
+            my $ufield = $def->usr_field;
+            my $uid = $target->$ufield;
+            $uid = $uid->id if (ref $uid); # fleshed user object, unflesh it
+
+            my $opt_in_setting = $editor->search_actor_user_setting(
+                { usr   => $uid,
+                  name  => $def->opt_in_setting,
+                  value => 'true'
+                }
+            );
+
+            next unless (@$opt_in_setting);
+        }
+
+        my $date = DateTime->now;
+
+        if ($hook_hash{$def->hook}->passive eq 'f') {
+
+            if (my $dfield = $def->delay_field) {
+                if ($target->$dfield()) {
+                    $date = DateTime::Format::ISO8601->new->parse_datetime( cleanse_ISO8601($target->$dfield) );
+                } else {
+                    next;
+                }
+            }
+
+            $date->add( seconds => interval_to_seconds($def->delay) );
+        }
+
+        my $event = Fieldmapper::action_trigger::event->new();
+        $event->target( $ident_value );
+        $event->event_def( $def->id );
+        $event->run_time( $date->strftime( '%F %T%z' ) );
+        $event->user_data( OpenSRF::Utils::JSON->perl2JSON($user_data) ) if (defined($user_data));
+
+        $editor->create_action_trigger_event( $event );
+
+        $client->respond( $event->id );
+    }
+
+    $editor->commit;
+
+    return undef;
+}
+__PACKAGE__->register_method(
+    api_name => 'open-ils.trigger.event.autocreate',
+    method   => 'create_active_events_for_object',
+    api_level=> 1,
+    stream   => 1,
+    argc     => 3
+);
+
+sub create_event_for_object_and_def {
+    my $self = shift;
+    my $client = shift;
+    my $definitions = shift;
+    my $target = shift;
+    my $location = shift;
+    my $user_data = shift;
+
+    my $ident = $target->Identity;
+    my $ident_value = $target->$ident();
+
+    my @active = ($self->api_name =~ /inactive/o) ? () : ( active => 't' );
+
+    my $editor = new_editor(xact=>1);
+
+    my $orgs = $editor->json_query({ from => [ 'actor.org_unit_ancestors' => $location ] });
+    my $defs = $editor->search_action_trigger_event_definition(
+        { id => $definitions,
+          owner  => [ map { $_->{id} } @$orgs  ],
+          @active
+        }
+    );
+
+    my $hooks = $editor->search_action_trigger_hook(
+        { key       => [ map { $_->hook } @$defs ],
+          core_type => $target->json_hint
+        }
+    );
+
+    my %hook_hash = map { ($_->key, $_) } @$hooks;
+
+    for my $def ( @$defs ) {
+
+        if ($def->usr_field && $def->opt_in_setting) {
+            my $ufield = $def->usr_field;
+            my $uid = $target->$ufield;
+            $uid = $uid->id if (ref $uid); # fleshed user object, unflesh it
+
+            my $opt_in_setting = $editor->search_actor_user_setting(
+                { usr   => $uid,
+                  name  => $def->opt_in_setting,
+                  value => 'true'
+                }
+            );
+
+            next unless (@$opt_in_setting);
+        }
+
+        my $date = DateTime->now;
+
+        if ($hook_hash{$def->hook}->passive eq 'f') {
+
+            if (my $dfield = $def->delay_field) {
+                if ($target->$dfield()) {
+                    $date = DateTime::Format::ISO8601->new->parse_datetime( cleanse_ISO8601($target->$dfield) );
+                } else {
+                    next;
+                }
+            }
+
+            $date->add( seconds => interval_to_seconds($def->delay) );
+        }
+
+        my $event = Fieldmapper::action_trigger::event->new();
+        $event->target( $ident_value );
+        $event->event_def( $def->id );
+        $event->run_time( $date->strftime( '%F %T%z' ) );
+        $event->user_data( OpenSRF::Utils::JSON->perl2JSON($user_data) ) if (defined($user_data));
+
+        $editor->create_action_trigger_event( $event );
+
+        $client->respond( $event->id );
+    }
+
+    $editor->commit;
+
+    return undef;
+}
+__PACKAGE__->register_method(
+    api_name => 'open-ils.trigger.event.autocreate.by_definition',
+    method   => 'create_event_for_object_and_def',
+    api_level=> 1,
+    stream   => 1,
+    argc     => 3
+);
+__PACKAGE__->register_method(
+    api_name => 'open-ils.trigger.event.autocreate.by_definition.include_inactive',
+    method   => 'create_event_for_object_and_def',
+    api_level=> 1,
+    stream   => 1,
+    argc     => 3
+);
+
+
+# Retrieves events by object, or object type + filter
+#  $object : a target object or object type (class hint)
+#
+#  $filter : an optional hash of filters ... top level keys:
+#     event
+#        filters on the atev objects, such as states or null-ness of timing
+#        fields. contains the effective default of:
+#          { state => 'pending' }
+#        an example, which overrides the default, and will find
+#        stale 'found' events:
+#          { state => 'found', update_time => { '<' => 'yesterday' } }
+#
+#      event_def
+#        filters on the atevdef object. contains the effective default of:
+#          { active => 't' }
+#
+#      hook
+#        filters on the hook object. no defaults, but there is a pinned,
+#        unchangeable filter based on the passed hint or object type (see
+#        $object above). an example for finding passive events:
+#          { passive => 't' }
+#
+#     target
+#        filters against the target field on the event. this can contain
+#        either an array of target ids (if you passed an object type, and
+#        not an object) or can contain a json_query that will return exactly
+#        a list of target-type ids.  If you pass an object, the pkey value of
+#        that object will be used as a filter in addition to the filter passed
+#        in here.  example filter for circs of user 1234 that are open:
+#          { select => { circ => ['id'] },
+#            from => 'circ',
+#            where => {
+#              usr => 1234,
+#              checkin_time => undef, 
+#              '-or' => [
+#                { stop_fines => undef },
+#                { stop_fines => { 'not in' => ['LOST','LONGOVERDUE','CLAIMSRETURNED'] } }
+#              ]
+#            }
+
+sub events_by_target {
+    my $self = shift;
+    my $client = shift;
+    my $object = shift;
+    my $filter = shift || {};
+    my $flesh_fields = shift || {};
+    my $flesh_depth = shift || 1;
+
+    my $obj_class = ref($object) || _fm_class_by_hint($object);
+    my $obj_hint = ref($object) ? _fm_hint_by_class(ref($object)) : $object;
+
+    my $object_ident_field = $obj_class->Identity;
+
+    my $query = {
+        select => { atev => ["id"] },
+        from   => {
+            atev => {
+                atevdef => {
+                    field => "id",
+                    fkey => "event_def",
+                    join => {
+                        ath => { field => "key", fkey => "hook" }
+                    }
+                }
+            }
+        },
+        where  => {
+            "+ath"  => { core_type => $obj_hint },
+            "+atevdef" => { active => 't' },
+            "+atev" => { state => 'pending' }
+        },
+        order_by => { "atev" => [ 'run_time', 'add_time' ] }
+    };
+
+    $query->{limit} = $filter->{limit} if defined $filter->{limit};
+    $query->{offset} = $filter->{offset} if defined $filter->{offset};
+    $query->{order_by} = $filter->{order_by} if defined $filter->{order_by};
+
+
+    # allow multiple 'target' filters
+    $query->{where}->{'+atev'}->{'-and'} = [];
+
+    # if we got a real object, filter on its pkey value
+    if (ref($object)) { # pass an object, require that target
+        push @{ $query->{where}->{'+atev'}->{'-and'} },
+            { target => $object->$object_ident_field }
+    }
+
+    # we have a fancy complex target filter or a list of target ids
+    if ($$filter{target}) {
+        push @{ $query->{where}->{'+atev'}->{'-and'} },
+            { target => {in => $$filter{target} } };
+    }
+
+    # pass no target filter or object, you get no events
+    if (!@{ $query->{where}->{'+atev'}->{'-and'} }) {
+        return undef; 
+    }
+
+    # any hook filters, other than the required core_type filter
+    if ($$filter{hook}) {
+        $query->{where}->{'+ath'}->{$_} = $$filter{hook}{$_}
+            for (grep { $_ ne 'core_type' } keys %{$$filter{hook}});
+    }
+
+    # any event_def filters.  defaults to { active => 't' }
+    if ($$filter{event_def}) {
+        $query->{where}->{'+atevdef'}->{$_} = $$filter{event_def}{$_}
+            for (keys %{$$filter{event_def}});
+    }
+
+    # any event filters.  defaults to { state => 'pending' }.
+    # don't overwrite '-and' used for multiple target filters above
+    if ($$filter{event}) {
+        $query->{where}->{'+atev'}->{$_} = $$filter{event}{$_}
+            for (grep { $_ ne '-and' } keys %{$$filter{event}});
+    }
+
+    my $e = new_editor(xact=>1);
+
+    my $events = $e->json_query($query);
+
+    $flesh_fields->{atev} = ['event_def'] unless $flesh_fields->{atev};
+
+    for my $id (@$events) {
+        my $event = $e->retrieve_action_trigger_event([
+            $id->{id},
+            {flesh => $flesh_depth, flesh_fields => $flesh_fields}
+        ]);
+
+        (my $meth = $obj_class) =~ s/^Fieldmapper:://o;
+        $meth =~ s/::/_/go;
+        $meth = 'retrieve_'.$meth;
+
+        $event->target($e->$meth($event->target));
+        $client->respond($event);
+    }
+
+    return undef;
+}
+__PACKAGE__->register_method(
+    api_name => 'open-ils.trigger.events_by_target',
+    method   => 'events_by_target',
+    api_level=> 1,
+    stream   => 1,
+    argc     => 2
+);
+ 
+sub _fm_hint_by_class {
+    my $class = shift;
+    return Fieldmapper->publish_fieldmapper->{$class}->{hint};
+}
+
+sub _fm_class_by_hint {
+    my $hint = shift;
+
+    my ($class) = grep {
+        Fieldmapper->publish_fieldmapper->{$_}->{hint} eq $hint
+    } keys %{ Fieldmapper->publish_fieldmapper };
+
+    return $class;
+}
+
+sub create_batch_events {
+    my $self = shift;
+    my $client = shift;
+    my $key = shift;
+    my $location_field = shift; # where to look for event_def.owner filtering ... circ_lib, for instance, where hook.core_type = circ
+    my $filter = shift || {};
+    my $granularity = shift;
+    my $user_data = shift;
+
+    my $active = ($self->api_name =~ /active/o) ? 1 : 0;
+    if ($active && !keys(%$filter)) {
+        $log->info("Active batch event creation requires a target filter but none was supplied to create_batch_events");
+        return undef;
+    }
+
+    return undef unless ($key && $location_field);
+
+    my $editor = new_editor(xact=>1);
+    my $hooks = $editor->search_action_trigger_hook(
+        { passive => $active ? 'f' : 't', key => $key }
+    );
+
+    my %hook_hash = map { ($_->key, $_) } @$hooks;
+
+    my $defs = $editor->search_action_trigger_event_definition(
+        { hook   => [ keys %hook_hash ], active => 't' },
+    );
+
+    my $orig_filter_and = [];
+    if ($$filter{'-and'}) {
+        for my $f ( @{ $$filter{'-and'} } ) {
+            push @$orig_filter_and, $f;
+        }
+    }
+
+    for my $def ( @$defs ) {
+        next if ($granularity && $def->granularity ne $granularity );
+
+        my $date = DateTime->now->subtract( seconds => interval_to_seconds($def->delay) );
+
+        # we may need to do some work to backport this to 1.2
+        $filter->{ $location_field } = { 'in' =>
+            {
+                select  => { aou => [{ column => 'id', transform => 'actor.org_unit_descendants', result_field => 'id' }] },
+                from    => 'aou',
+                where   => { id => $def->owner }
+            }
+        };
+
+        my $run_time = 'now';
+        if ($active) {
+            $run_time = 
+                DateTime
+                    ->now
+                    ->add( seconds => interval_to_seconds($def->delay) )
+                    ->strftime( '%F %T%z' );
+        } else {
+            if ($def->max_delay) {
+                my @times = sort {$a <=> $b} interval_to_seconds($def->delay), interval_to_seconds($def->max_delay);
+                $filter->{ $def->delay_field } = {
+                    'between' => [
+                        DateTime->now->subtract( seconds => $times[1] )->strftime( '%F %T%z' ),
+                        DateTime->now->subtract( seconds => $times[0] )->strftime( '%F %T%z' )
+                    ]
+                };
+            } else {
+                $filter->{ $def->delay_field } = {
+                    '<=' => DateTime->now->subtract( seconds => interval_to_seconds($def->delay) )->strftime( '%F %T%z' )
+                };
+            }
+        }
+
+        my $class = _fm_class_by_hint($hook_hash{$def->hook}->core_type);
+
+        # filter where this target has an event (and it's pending, for active hooks)
+        $$filter{'-and'} = [];
+        for my $f ( @$orig_filter_and ) {
+            push @{ $$filter{'-and'} }, $f;
+        }
+
+        my $join = { 'join' => {
+            atev => {
+                field => 'target',
+                fkey => $class->Identity,
+                type => 'left',
+                filter => { event_def => $def->id }
+            }
+        }};
+
+        push @{ $filter->{'-and'} }, { '+atev' => { id => undef } };
+
+        if ($def->usr_field && $def->opt_in_setting) {
+            push @{ $filter->{'-and'} }, {
+                '-exists' => {
+                    from  => 'aus',
+                    where => {
+                        name => $def->opt_in_setting,
+                        usr  => { '=' => { '+' . $hook_hash{$def->hook}->core_type => $def->usr_field } },
+                        value=> 'true'
+                    }
+                }
+            };
+        }
+
+        $class =~ s/^Fieldmapper:://o;
+        $class =~ s/::/_/go;
+        my $method = 'search_'. $class;
+
+        # for cleaner logging
+        my $def_id = $def->id;
+        my $hook = $def->hook;
+
+        $logger->info("trigger: create_batch_events() collecting object IDs for def=$def_id / hook=$hook");
+
+        my $object_ids = $editor->$method( [$filter, $join], {idlist => 1, timeout => 10800} );
+
+        if($object_ids) {
+            $logger->info("trigger: create_batch_events() fetched ".scalar(@$object_ids)." object IDs for def=$def_id / hook=$hook");
+        } else {
+            $logger->warn("trigger: create_batch_events() timeout occurred collecting object IDs for def=$def_id / hook=$hook");
+        }
+
+        for my $o_id (@$object_ids) {
+
+            my $event = Fieldmapper::action_trigger::event->new();
+            $event->target( $o_id );
+            $event->event_def( $def->id );
+            $event->run_time( $run_time );
+            $event->user_data( OpenSRF::Utils::JSON->perl2JSON($user_data) ) if (defined($user_data));
+
+            $editor->create_action_trigger_event( $event );
+
+            $client->respond( $event->id );
+        }
+        
+        $logger->info("trigger: create_batch_events() successfully created events for def=$def_id / hook=$hook");
+    }
+
+    $logger->info("trigger: create_batch_events() done creating events");
+
+    $editor->commit;
+
+    return undef;
+}
+__PACKAGE__->register_method(
+    api_name => 'open-ils.trigger.passive.event.autocreate.batch',
+    method   => 'create_batch_events',
+    api_level=> 1,
+    stream   => 1,
+    argc     => 2
+);
+
+__PACKAGE__->register_method(
+    api_name => 'open-ils.trigger.active.event.autocreate.batch',
+    method   => 'create_batch_events',
+    api_level=> 1,
+    stream   => 1,
+    argc     => 2
+);
+
+sub fire_single_event {
+    my $self = shift;
+    my $client = shift;
+    my $event_id = shift;
+
+    my $e = OpenILS::Application::Trigger::Event->new($event_id);
+
+    if ($e->validate->valid) {
+        $logger->info("trigger: Event is valid, reacting...");
+        $e->react->cleanup;
+    }
+
+    $e->editor->disconnect;
+    OpenILS::Application::Trigger::Event->ClearObjectCache();
+
+    return {
+        valid     => $e->valid,
+        reacted   => $e->reacted,
+        cleanedup => $e->cleanedup,
+        event     => $e->event
+    };
+}
+__PACKAGE__->register_method(
+    api_name => 'open-ils.trigger.event.fire',
+    method   => 'fire_single_event',
+    api_level=> 1,
+    argc     => 1
+);
+
+sub fire_event_group {
+    my $self = shift;
+    my $client = shift;
+    my $events = shift;
+
+    my $e = OpenILS::Application::Trigger::EventGroup->new(@$events);
+
+    if ($e->validate->valid) {
+        $logger->info("trigger: Event group is valid, reacting...");
+        $e->react->cleanup;
+    }
+
+    $e->editor->disconnect;
+    OpenILS::Application::Trigger::Event->ClearObjectCache();
+
+    return {
+        valid     => $e->valid,
+        reacted   => $e->reacted,
+        cleanedup => $e->cleanedup,
+        events    => [map { $_->event } @{$e->events}]
+    };
+}
+__PACKAGE__->register_method(
+    api_name => 'open-ils.trigger.event_group.fire',
+    method   => 'fire_event_group',
+    api_level=> 1,
+    argc     => 1
+);
+
+sub pending_events {
+    my $self = shift;
+    my $client = shift;
+    my $granularity = shift;
+    my $granflag = shift;
+
+    my $query = [{ state => 'pending', run_time => {'<' => 'now'} }, { order_by => { atev => [ qw/run_time add_time/] }, 'join' => 'atevdef' }];
+
+    if (defined $granularity) {
+        if ($granflag) {
+            $query->[0]->{'+atevdef'} = {granularity => $granularity};
+        } else {
+            $query->[0]->{'+atevdef'} = {'-or' => [ {granularity => $granularity}, {granularity => undef} ] };
+        }
+    } else {
+        $query->[0]->{'+atevdef'} = {granularity => undef};
+    }
+
+    return new_editor(xact=>1)->search_action_trigger_event(
+        $query, { idlist=> 1, timeout => 7200, substream => 1 }
+    );
+}
+__PACKAGE__->register_method(
+    api_name => 'open-ils.trigger.event.find_pending',
+    method   => 'pending_events',
+    api_level=> 1
+);
+
+sub gather_events {
+    my $self = shift;
+    my $client = shift;
+    my $e_ids = shift;
+
+    $e_ids = [$e_ids] if (!ref($e_ids));
+
+    my @events;
+    for my $e_id (@$e_ids) {
+        my $e;
+        try {
+           $e = OpenILS::Application::Trigger::Event->new($e_id);
+        } catch Error with {
+            $logger->error("trigger: Event creation failed with ".shift());
+        };
+
+        next if !$e or $e->event->state eq 'invalid'; 
+
+        try {
+            $e->build_environment;
+        } catch Error with {
+            $logger->error("trigger: Event environment building failed with ".shift());
+        };
+
+        $e->editor->disconnect;
+        $e->environment->{EventProcessor} = undef; # remove circular ref for json encoding
+        $client->respond($e);
+    }
+
+    OpenILS::Application::Trigger::Event->ClearObjectCache();
+
+    return undef;
+}
+__PACKAGE__->register_method(
+    api_name => 'open-ils.trigger.event.gather',
+    method   => 'gather_events',
+    api_level=> 1
+);
+
+sub grouped_events {
+    my $self = shift;
+    my $client = shift;
+    my $granularity = shift;
+    my $granflag = shift;
+
+    my ($events) = $self->method_lookup('open-ils.trigger.event.find_pending')->run($granularity, $granflag);
+
+    my %groups = ( '*' => [] );
+
+    if($events) {
+        $logger->info("trigger: grouped_events found ".scalar(@$events)." pending events to process");
+    } else {
+        $logger->warn("trigger: grouped_events timed out loading pending events");
+        return \%groups;
+    }
+
+    my @fleshed_events;
+
+    if ($parallel_collect == 1 or @$events == 1) { # use method lookup
+        @fleshed_events = $self->method_lookup('open-ils.trigger.event.gather')->run($events);
+    } else {
+        my $self_multi = OpenSRF::MultiSession->new(
+            app                 => 'open-ils.trigger',
+            cap                 => $parallel_collect,
+            success_handler     => sub {
+                my $self = shift;
+                my $req = shift;
+
+                push @fleshed_events,
+                    map { OpenILS::Application::Trigger::Event->new($_) }
+                    map { $_->content }
+                    @{ $req->{response} };
+            },
+        );
+
+        $self_multi->request( 'open-ils.trigger.event.gather' => $_ ) for ( @$events );
+        $client->status( new OpenSRF::DomainObject::oilsContinueStatus );
+
+        $self_multi->session_wait(1);
+        $client->status( new OpenSRF::DomainObject::oilsContinueStatus );
+    }
+
+    for my  $e (@fleshed_events) {
+        if (my $group = $e->event->event_def->group_field) {
+
+            # split the grouping link steps
+            my @steps = split /\./, $group;
+            my $group_field = pop(@steps); # we didn't flesh to this, it's a field not an object
+
+            my $node;
+            eval {
+                $node = $e->target;
+                $node = $node->$_() for ( @steps );
+            };
+
+            unless($node) { # should not get here, but to be safe..
+                $e->update_state('invalid');
+                next;
+            }
+
+            # get the grouping value for the grouping object on this event
+            my $ident_value = $node->$group_field();
+            if(ref $ident_value) {
+                my $ident_field = $ident_value->Identity; 
+                $ident_value = $ident_value->$ident_field()
+            }
+
+            # push this event onto the event+grouping_value stack
+            $groups{$e->event->event_def->id}{$ident_value} ||= [];
+            push @{ $groups{$e->event->event_def->id}{$ident_value} }, $e;
+        } else {
+            # it's a non-grouped event
+            push @{ $groups{'*'} }, $e;
+        }
+    }
+
+
+    return \%groups;
+}
+__PACKAGE__->register_method(
+    api_name => 'open-ils.trigger.event.find_pending_by_group',
+    method   => 'grouped_events',
+    api_level=> 1
+);
+
+sub run_all_events {
+    my $self = shift;
+    my $client = shift;
+    my $granularity = shift;
+    my $granflag = shift;
+
+    my ($groups) = $self->method_lookup('open-ils.trigger.event.find_pending_by_group')->run($granularity, $granflag);
+    $client->respond({"status" => "found"}) if (keys(%$groups) > 1 || @{$$groups{'*'}});
+
+    my $self_multi;
+    if ($parallel_react > 1 and (keys(%$groups) > 1 || @{$$groups{'*'}} > 1)) {
+        $self_multi = OpenSRF::MultiSession->new(
+            app                   => 'open-ils.trigger',
+            cap                   => $parallel_react,
+            session_hash_function => sub {
+                my $args = shift;
+                return $args->{target_id};
+            },
+            success_handler       => sub {
+                my $me = shift;
+                my $req = shift;
+                $client->respond( $req->{response}->[0]->content );
+            }
+        );
+    }
+
+    for my $def ( keys %$groups ) {
+        if ($def eq '*') {
+            $logger->info("trigger: run_all_events firing un-grouped events");
+            for my $event ( @{ $$groups{'*'} } ) {
+                try {
+                    if ($self_multi) {
+                        $event->environment->{EventProcessor} = undef; # remove circular ref for json encoding
+                        $self_multi->request({target_id => $event->id}, 'open-ils.trigger.event.fire', $event);
+                    } else {
+                        $client->respond(
+                            $self
+                                ->method_lookup('open-ils.trigger.event.fire')
+                                ->run($event)
+                        );
+                    }
+                } catch Error with { 
+                    $logger->error("trigger: event firing failed with ".shift());
+                };
+            }
+            $logger->info("trigger: run_all_events completed queuing un-grouped events");
+            $client->status( new OpenSRF::DomainObject::oilsContinueStatus );
+
+        } else {
+            my $defgroup = $$groups{$def};
+            $logger->info("trigger: run_all_events firing events for grouped event def=$def");
+            for my $ident ( keys %$defgroup ) {
+                $logger->info("trigger: run_all_events firing group for grouped event def=$def and grp ident $ident");
+                try {
+                    if ($self_multi) {
+                        $_->environment->{EventProcessor} = undef for @{$$defgroup{$ident}}; # remove circular ref for json encoding
+                        $self_multi->request({target_id => $ident}, 'open-ils.trigger.event_group.fire', $$defgroup{$ident});
+                    } else {
+                        $client->respond(
+                            $self
+                                ->method_lookup('open-ils.trigger.event_group.fire')
+                                ->run($$defgroup{$ident})
+                        );
+                    }
+                    $client->status( new OpenSRF::DomainObject::oilsContinueStatus );
+                } catch Error with {
+                    $logger->error("trigger: event firing failed with ".shift());
+                };
+            }
+            $logger->info("trigger: run_all_events completed queuing events for grouped event def=$def");
+        }
+    }
+
+    $self_multi->session_wait(1) if ($self_multi);
+    $logger->info("trigger: run_all_events completed firing events");
+
+    $client->respond_complete();
+    return undef;
+}
+__PACKAGE__->register_method(
+    api_name => 'open-ils.trigger.event.run_all_pending',
+    method   => 'run_all_events',
+    api_level=> 1
+);
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Cleanup.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Cleanup.pm
new file mode 100644
index 0000000000..495a60a0f8
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Cleanup.pm
@@ -0,0 +1,29 @@
+package OpenILS::Application::Trigger::Cleanup;
+use strict; use warnings;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenSRF::Utils::Logger qw/:logger/;
+
+sub fourty_two { return 42 }
+sub NOOP_True { return 1 }
+sub NOOP_False { return 0 }
+
+sub DeleteTempBiblioBucket {
+    my($self, $env) = @_;
+    my $e = new_editor(xact => 1);
+    my $buckets = $env->{target};
+
+    for my $bucket (@$buckets) {
+
+        foreach my $item (@{ $bucket->items }) {
+            $e->delete_container_biblio_record_entry_bucket_item($item);
+        }
+
+        $e->delete_container_biblio_record_entry_bucket($bucket);
+    }
+
+    $e->commit or $e->die_event;
+
+    return 1;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Collector.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Collector.pm
new file mode 100644
index 0000000000..db650ede98
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Collector.pm
@@ -0,0 +1,4 @@
+package OpenILS::Application::Trigger::Collector;
+use strict; use warnings;
+sub fourty_two { return 42 }
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Event.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Event.pm
new file mode 100644
index 0000000000..de11a15eac
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Event.pm
@@ -0,0 +1,606 @@
+package OpenILS::Application::Trigger::Event;
+use strict; use warnings;
+use OpenSRF::EX qw/:try/;
+use OpenSRF::Utils::JSON;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Application::Trigger::ModRunner;
+use Safe;
+
+my $log = 'OpenSRF::Utils::Logger';
+
+sub new {
+    my $class = shift;
+    my $id = shift;
+    my $editor = shift;
+    $class = ref($class) || $class;
+
+    my $standalone = $editor ? 0 : 1;
+    $editor ||= new_editor();
+
+    if (ref($id) && ref($id) eq $class) {
+        $id->environment->{EventProcessor} = $id
+             if ($id->environment->{complete}); # in case it came over an opensrf tube
+        $id->editor( $editor );
+        $id->standalone( $standalone );
+        return $id;
+    }
+
+    my $self = bless { id => $id, editor => $editor, standalone => $standalone } => $class;
+
+    return $self->init()
+}
+
+sub init {
+    my $self = shift;
+    my $id = shift;
+
+    return $self if ($self->event);
+
+    $self->id( $id ); 
+    $self->environment( {} ); 
+
+    if (!$self->id) {
+        $log->error("No Event ID provided");
+        die "No Event ID provided";
+    }
+
+    return $self if (!$self->id);
+
+    if ($self->standalone) {
+        $self->editor->xact_begin || return undef;
+    }
+
+    $self->event(
+        $self->editor->retrieve_action_trigger_event([
+            $self->id, {
+                flesh => 2,
+                flesh_fields => {
+                    atev    => [ qw/event_def/ ],
+                    atevdef => [ qw/hook env params/ ]
+                }
+            }
+        ])
+    );
+
+    if ($self->standalone) {
+        $self->editor->xact_rollback || return undef;
+    }
+
+    $self->user_data(OpenSRF::Utils::JSON->JSON2perl( $self->event->user_data ))
+        if (defined( $self->event->user_data ));
+
+    if ($self->event->state eq 'valid') {
+        $self->valid(1);
+    } elsif ($self->event->state eq 'invalid') {
+        $self->valid(0);
+    } elsif ($self->event->state eq 'reacting') {
+        $self->valid(1);
+    } elsif ($self->event->state eq 'reacted') {
+        $self->valid(1);
+        $self->reacted(1);
+    } elsif ($self->event->state eq 'cleaning') {
+        $self->valid(1);
+        $self->reacted(1);
+    } elsif ($self->event->state eq 'complete') {
+        $self->valid(1);
+        $self->reacted(1);
+        $self->cleanedup(1);
+    } elsif ($self->event->state eq 'error') {
+        $self->valid(0);
+        $self->reacted(0);
+        $self->cleanedup(0);
+    }
+
+
+    $self->update_state('found') || die 'Unable to update event state';
+
+    my $class = $self->_fm_class_by_hint( $self->event->event_def->hook->core_type );
+    
+    my $meth = "retrieve_" . $class;
+    $meth =~ s/Fieldmapper:://;
+    $meth =~ s/::/_/;
+    
+    if ($self->standalone) {
+        $self->editor->xact_begin || return undef;
+    }
+
+    $self->target( $self->editor->$meth( $self->event->target ) );
+
+    if ($self->standalone) {
+        $self->editor->xact_rollback || return undef;
+    }
+
+    unless($self->target) {
+        $self->update_state('invalid');
+        $self->valid(0);
+    }
+
+    return $self;
+}
+
+sub cleanup {
+    my $self = shift;
+    my $env = shift || $self->environment;
+
+    return $self if (defined $self->cleanedup);
+
+    if (defined $self->reacted) {
+        $self->update_state( 'cleaning') || die 'Unable to update event state';
+        try {
+            my $cleanup = $self->reacted ? $self->event->event_def->cleanup_success : $self->event->event_def->cleanup_failure;
+            if($cleanup) {
+                $self->cleanedup(
+                    OpenILS::Application::Trigger::ModRunner::Cleanup
+                        ->new( $cleanup, $env)
+                        ->run
+                        ->final_result
+                );
+            } else {
+                $self->cleanedup(1);
+            }
+        } otherwise {
+            $log->error("Event cleanup failed with ". shift() );
+            $self->update_state( 'error' ) || die 'Unable to update event state';
+        };
+
+        if ($self->cleanedup) {
+            $self->update_state( 'complete' ) || die 'Unable to update event state';
+        } else {
+            $self->update_state( 'error' ) || die 'Unable to update event state';
+        }
+
+    } else {
+        $self->{cleanedup} = undef;
+    }
+    return $self;
+}
+
+sub react {
+    my $self = shift;
+    my $env = shift || $self->environment;
+
+    return $self if (defined $self->reacted);
+
+    if ($self->valid) {
+        if ($self->event->event_def->group_field) { # can't react individually to a grouped definition
+            $self->{reacted} = undef;
+        } else {
+            $self->update_state( 'reacting') || die 'Unable to update event state';
+            try {
+                $self->reacted(
+                    OpenILS::Application::Trigger::ModRunner::Reactor
+                        ->new( $self->event->event_def->reactor, $env )
+                        ->run
+                        ->final_result
+                );
+            } otherwise {
+                $log->error("Event reacting failed with ". shift() );
+                $self->update_state( 'error' ) || die 'Unable to update event state';
+            };
+
+            if (defined $self->reacted) {
+                $self->update_state( 'reacted' ) || die 'Unable to update event state';
+            } else {
+                $self->update_state( 'error' ) || die 'Unable to update event state';
+            }
+        }
+    } else {
+        $self->{reacted} = undef;
+    }
+    return $self;
+}
+
+sub validate {
+    my $self = shift;
+
+    return $self if (defined $self->valid);
+
+    if ($self->build_environment->environment->{complete}) {
+        $self->update_state( 'validating') || die 'Unable to update event state';
+        try {
+            $self->valid(
+                OpenILS::Application::Trigger::ModRunner::Validator
+                    ->new( $self->event->event_def->validator, $self->environment )
+                    ->run
+                    ->final_result
+            );
+        } otherwise {
+            $log->error("Event validation failed with ". shift() );
+            $self->update_state( 'error' ) || die 'Unable to update event state';
+        };
+
+        if (defined $self->valid) {
+            if ($self->valid) {
+                $self->update_state( 'valid' ) || die 'Unable to update event state';
+            } else {
+                $self->update_state( 'invalid' ) || die 'Unable to update event state';
+            }
+        } else {
+            $self->update_state( 'error' ) || die 'Unable to update event state';
+        }
+    } else {
+        $self->{valid} = undef
+    }
+
+    return $self;
+}
+ 
+sub cleanedup {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $c = shift;
+    $self->{cleanedup} = $c if (defined $c);
+    return $self->{cleanedup};
+}
+
+sub user_data {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $r = shift;
+    $self->{user_data} = $r if (defined $r);
+    return $self->{user_data};
+}
+
+sub reacted {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $r = shift;
+    $self->{reacted} = $r if (defined $r);
+    return $self->{reacted};
+}
+
+sub valid {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $v = shift;
+    $self->{valid} = $v if (defined $v);
+    return $self->{valid};
+}
+
+sub event {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $e = shift;
+    $self->{event} = $e if (defined $e);
+    return $self->{event};
+}
+
+sub id {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $i = shift;
+    $self->{id} = $i if (defined $i);
+    return $self->{id};
+}
+
+sub environment {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $e = shift;
+    $self->{environment} = $e if (defined $e);
+    return $self->{environment};
+}
+
+sub editor {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $e = shift;
+    $self->{editor} = $e if (defined $e);
+    return $self->{editor};
+}
+
+sub unfind {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    die 'Cannot unfind a reacted event' if (defined $self->reacted);
+
+    $self->update_state( 'pending' ) || die 'Unable to update event state';
+    $self->{id} = undef;
+    $self->{event} = undef;
+    $self->{environment} = undef;
+    return $self;
+}
+
+sub target {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $t = shift;
+    $self->{target} = $t if (defined $t);
+    return $self->{target};
+}
+
+sub standalone {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $t = shift;
+    $self->{standalone} = $t if (defined $t);
+    return $self->{standalone};
+}
+
+sub update_state {
+    my $self = shift;
+    return undef unless ($self && ref $self);
+
+    my $state = shift;
+    return undef unless ($state);
+
+    my $fields = shift;
+
+    if ($self->standalone) {
+        $self->editor->xact_begin || return undef;
+    }
+
+    my $e = $self->editor->retrieve_action_trigger_event( $self->id );
+    if (!$e) {
+        $log->error( "Could not retrieve object ".$self->id." for update" ) if (!$e);
+        return undef;
+    }
+
+    if ($fields && ref($fields)) {
+        $e->$_($$fields{$_}) for (keys %$fields);
+    }
+
+    $log->info( "Retrieved object ".$self->id." for update" );
+    $e->start_time( 'now' ) unless $e->start_time;
+    $e->update_time( 'now' );
+    $e->update_process( $$ );
+    $e->state( $state );
+
+    $e->clear_start_time() if ($e->state eq 'pending');
+    $e->complete_time( 'now' ) if ($e->state eq 'complete');
+
+    my $ok = $self->editor->update_action_trigger_event( $e );
+    if (!$ok) {
+        $self->editor->xact_rollback if ($self->standalone);
+        $log->error( "Update of event ".$self->id." failed" );
+        return undef;
+    } else {
+        $e = $self->editor->data;
+        $e = $self->editor->retrieve_action_trigger_event( $e ) if (!ref($e));
+        if (!$e) {
+            $log->error( "Update of event ".$self->id." did not return an object" );
+            return undef;
+        }
+        $log->info( "Update of event ".$e->id." suceeded" );
+        $ok = $self->editor->xact_commit if ($self->standalone);
+    }
+
+    if ($ok) {
+        $self->event->start_time( $e->start_time );
+        $self->event->update_time( $e->update_time );
+        $self->event->update_process( $e->update_process );
+        $self->event->state( $e->state );
+    }
+
+    return $ok || undef;
+}
+
+my $current_environment;
+
+sub build_environment {
+    my $self = shift;
+    return $self if ($self->environment->{complete});
+
+    $self->update_state( 'collecting') || die 'Unable to update event state';
+
+    try {
+   
+        my $compartment = new Safe;
+        $compartment->permit(':default','require','dofile','caller');
+        $compartment->share('$current_environment');
+
+        $self->environment->{EventProcessor} = $self;
+        $self->environment->{target} = $self->target;
+        $self->environment->{event} = $self->event;
+        $self->environment->{template} = $self->event->event_def->template;
+        $self->environment->{user_data} = $self->user_data;
+
+        $current_environment = $self->environment;
+
+        $self->environment->{params}{ $_->param } = $compartment->reval($_->value) for ( @{$self->event->event_def->params} );
+    
+        for my $e ( @{$self->event->event_def->env} ) {
+            my (@label, @path);
+            @path = split(/\./, $e->path) if ($e->path);
+            @label = split(/\./, $e->label) if ($e->label);
+    
+            $self->_object_by_path( $self->target, $e->collector, \@label, \@path );
+        }
+
+        if ($self->event->event_def->group_field) {
+            my @group_path = split(/\./, $self->event->event_def->group_field);
+            pop(@group_path); # the last part is a field, should not get fleshed
+            my $group_object = $self->_object_by_path( $self->target, undef, [], \@group_path ) if (@group_path);
+        }
+    
+        $self->environment->{complete} = 1;
+    } otherwise {
+        $log->error( shift() );
+        $self->update_state( 'error' ) || die 'Unable to update event state';
+    };
+
+    if ($self->environment->{complete}) {
+        $self->update_state( 'collected' ) || die 'Unable to update event state';
+    } else {
+        $self->update_state( 'error' ) || die 'Unable to update event state';
+    }
+
+    return $self;
+}
+
+sub _fm_class_by_hint {
+    my $self = shift;
+    my $hint = shift;
+
+    my ($class) = grep {
+        Fieldmapper->publish_fieldmapper->{$_}->{hint} eq $hint
+    } keys %{ Fieldmapper->publish_fieldmapper };
+
+    return $class;
+}
+
+my %_object_by_path_cache = ();
+sub ClearObjectCache {
+    for my $did ( keys %_object_by_path_cache ) {
+        my $phash = $_object_by_path_cache{$did};
+        for my $path ( keys %$phash ) {
+            my $shash = $$phash{$path};
+            for my $step ( keys %$shash ) {
+                my $fhash = $$shash{$step};
+                for my $ffield ( keys %$fhash ) {
+                    my $lhash = $$fhash{$ffield};
+                    for my $lfield ( keys %$lhash ) {
+                        delete $$lhash{$lfield};
+                    }
+                    delete $$fhash{$ffield};
+                }
+                delete $$shash{$step};
+            }
+            delete $$phash{$path};
+        }
+        delete $_object_by_path_cache{$did};
+    }
+}
+        
+sub _object_by_path {
+    my $self = shift;
+    my $context = shift;
+    my $collector = shift;
+    my $label = shift;
+    my $path = shift;
+    my $ed = shift;
+    my $red = shift;
+
+    my $outer = 0;
+    if (!$ed) {
+        $ed = new_editor(xact=>1);
+        $outer = 1;
+    }
+
+    my $step = shift(@$path);
+
+    my $fhint = Fieldmapper->publish_fieldmapper->{$context->class_name}{links}{$step}{class};
+    my $fclass = $self->_fm_class_by_hint( $fhint );
+
+    OpenSRF::EX::ERROR->throw(
+        "$step is not a field on ".$context->class_name."  Please repair the environment.")
+        unless $fhint;
+
+    my $ffield = Fieldmapper->publish_fieldmapper->{$context->class_name}{links}{$step}{key};
+    my $rtype = Fieldmapper->publish_fieldmapper->{$context->class_name}{links}{$step}{reltype};
+
+    my $meth = 'retrieve_';
+    my $multi = 0;
+    my $lfield = $step;
+    if ($rtype ne 'has_a') {
+        $meth = 'search_';
+        $multi = 1;
+        $lfield = $context->Identity;
+    }
+
+    $meth .= $fclass;
+    $meth =~ s/Fieldmapper:://;
+    $meth =~ s/::/_/g;
+
+    my $obj = $context->$step(); 
+
+    $logger->debug(
+        sprintf "_object_by_path(): meth=%s, obj=%s, multi=%s, step=%s, lfield=%s",
+        map {defined($_)? $_ : ''} ($meth,  $obj,   $multi,   $step,   $lfield)
+    );
+
+    if (!ref $obj) {
+
+        my $lval = $context->$lfield();
+
+        if(defined $lval) {
+
+            my $def_id = $self->event->event_def->id;
+            my $str_path = join('.', @$path);
+
+            $obj = $_object_by_path_cache{$def_id}{$str_path}{$step}{$ffield}{$lval} ||
+                (
+                    (grep /cstore/, @{
+                        Fieldmapper->publish_fieldmapper->{$fclass}{controller}
+                    }) ? $ed : ($red ||= new_rstore_editor(xact=>1))
+                )->$meth( ($multi) ? { $ffield => $lval } : $lval);
+
+            $_object_by_path_cache{$def_id}{$str_path}{$step}{$ffield}{$lval} ||= $obj;
+        }
+    }
+
+    if (@$path) {
+
+        my $obj_list = [];
+        if (!$multi) {
+            $obj_list = [$obj] if ($obj);
+        } else {
+            $obj_list = $obj;
+        }
+
+        for (@$obj_list) {
+            my @path_clone = @$path;
+            $self->_object_by_path( $_, $collector, $label, \@path_clone, $ed, $red );
+        }
+
+        $obj = $$obj_list[0] if (!$multi || $rtype eq 'might_have');
+        $context->$step( $obj ) if ($obj && (!$label || !@$label));
+
+    } else {
+
+        if ($collector) {
+            my $obj_list = [$obj] if ($obj && !$multi);
+            $obj_list = $obj if ($multi);
+
+            my @new_obj_list;
+            for my $o ( @$obj_list ) {
+                push @new_obj_list,
+                    OpenILS::Application::Trigger::ModRunner::Collector
+                        ->new( $collector, $o )
+                        ->run
+                        ->final_result
+            }
+
+            if (!$multi) {
+                $obj = $new_obj_list[0];
+            } else {
+                $obj = \@new_obj_list;
+            }
+        }
+
+        if ($label && @$label) {
+            my $node = $self->environment;
+            my $i = 0; my $max = scalar(@$label);
+            for (; $i < $max; $i++) {
+                my $part = $$label[$i];
+                $$node{$part} ||= {};
+                $node = $$node{$part};
+            }
+            $$node{$$label[-1]} = $obj;
+        } else {
+            $obj = $$obj[0] if $rtype eq 'might_have';
+            $context->$step( $obj ) if ($obj);
+        }
+    }
+
+    if ($outer) {
+        $ed->rollback;
+        $red->rollback if $red;
+    }
+    return $obj;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/EventGroup.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/EventGroup.pm
new file mode 100644
index 0000000000..2a3c6c632c
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/EventGroup.pm
@@ -0,0 +1,270 @@
+package OpenILS::Application::Trigger::EventGroup;
+use strict; use warnings;
+use OpenILS::Application::Trigger::Event;
+use base 'OpenILS::Application::Trigger::Event';
+use OpenSRF::EX qw/:try/;
+
+use OpenSRF::Utils::Logger qw/$logger/;
+
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Application::Trigger::ModRunner;
+
+my $log = 'OpenSRF::Utils::Logger';
+
+sub new {
+    my $class = shift;
+    my @ids = @_;
+    $class = ref($class) || $class;
+
+    my $editor = new_editor(xact=>1);
+
+    my $self = bless {
+        environment => {},
+        events      => [
+            map {
+                ref($_) ?
+                    do { $_->standalone(0); $_->editor($editor); $_ } :
+                    OpenILS::Application::Trigger::Event->new($_, $editor)
+            } @ids
+        ],
+        ids         => [ map { ref($_) ? $_->id : $_ } @ids ],
+        editor      => $editor
+    } => $class;
+
+
+    $self->editor->xact_commit; # flush out those updates
+    $self->editor->xact_begin;
+
+    return $self;
+}
+
+sub react {
+    my $self = shift;
+
+    return $self if (defined $self->reacted);
+
+    if ($self->valid) {
+        $self->update_state( 'reacting') || die 'Unable to update event group state';
+        $self->build_environment;
+
+        try {
+            $self->reacted(
+                OpenILS::Application::Trigger::ModRunner::Reactor
+                    ->new( $self->event->event_def->reactor, $self->environment )
+                    ->run
+                    ->final_result
+            );
+        } otherwise {
+            $log->error("Event reacting failed with ". shift() );
+            $self->update_state( 'error' ) || die 'Unable to update event group state';
+        };
+
+        if (defined $self->reacted) {
+            $self->update_state( 'reacted' ) || die 'Unable to update event group state';
+        } else {
+            $self->update_state( 'error' ) || die 'Unable to update event group state';
+        }
+    } else {
+        $self->{reacted} = undef;
+    }
+    return $self;
+}
+
+sub validate {
+    my $self = shift;
+
+    return $self if (defined $self->valid);
+
+    $self->update_state( 'validating') || die 'Unable to update event group state';
+    $self->editor->xact_begin;
+
+    my @valid_events;
+    try {
+        for my $event ( @{ $self->events } ) {
+            $event->validate;
+            push @valid_events, $event if ($event->valid);
+        }
+        $self->valid(1) if (@valid_events);
+        $self->{events} = \@valid_events;
+        $self->{ids} = [ map { $_->id } @valid_events ];
+        $self->editor->xact_commit;
+    } otherwise {
+        $log->error("Event group validation failed with ". shift() );
+        $self->editor->xact_rollback;
+        $self->update_state( 'error' ) || die 'Unable to update event group state';
+    };
+
+    return $self;
+}
+ 
+sub cleanedup {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $c = shift;
+    $self->{cleanedup} = $c if (defined $c);
+    return $self->{cleanedup};
+}
+
+sub reacted {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $r = shift;
+    $self->{reacted} = $r if (defined $r);
+    return $self->{reacted};
+}
+
+sub valid {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $v = shift;
+    $self->{valid} = $v if (defined $v);
+    return $self->{valid};
+}
+
+sub event {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    return $self->{events}[0]->event;
+}
+
+sub events {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    return $self->{events};
+}
+
+sub ids {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    return $self->{ids};
+}
+
+sub environment {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $e = shift;
+    $self->{environment} = $e if (defined $e);
+    return $self->{environment};
+}
+
+sub editor {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $e = shift;
+    $self->{editor} = $e if (defined $e);
+    return $self->{editor};
+}
+
+sub unfind {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    die 'Cannot unfind a reacted event group' if (defined $self->reacted);
+
+    $self->update_state( 'pending' ) || die 'Unable to update event group state';
+    $self->{events} = undef;
+    return $self;
+}
+
+sub update_state {
+    my $self = shift;
+    return undef unless ($self && ref $self);
+
+    my $state = shift;
+    return undef unless ($state);
+
+    my $fields = shift;
+
+    $self->editor->xact_begin || return undef;
+
+    my @oks;
+    my $ok;
+    my $last_updated;
+    for my $event ( @{ $self->events } ) {
+        my $e = $self->editor->retrieve_action_trigger_event( $event->id );
+        $e->start_time( 'now' ) unless $e->start_time;
+        $e->update_time( 'now' );
+        $e->update_process( $$ );
+        $e->state( $state );
+
+        $e->clear_start_time() if ($e->state eq 'pending');
+
+        if ($fields && ref($fields)) {
+            $e->$_($$fields{$_}) for (keys %$fields);
+        }
+
+        my $ok = $self->editor->update_action_trigger_event( $e );
+        if ($ok) {
+            push @oks, $ok;
+            $last_updated = $e->id;
+        }
+    }
+
+    if (scalar(@oks) < scalar(@{ $self->ids })) {
+        $self->editor->xact_rollback;
+        return undef;
+    } 
+
+    my $updated = $self->editor->retrieve_action_trigger_event($last_updated);
+    $ok = $self->editor->xact_commit;
+
+    if ($ok) {
+        for my $event ( @{ $self->events } ) {
+            my $e = $event->event;
+            $e->start_time( $updated->start_time );
+            $e->update_time( $updated->update_time );
+            $e->update_process( $updated->update_process );
+            $e->state( $updated->state );
+        }
+    }
+
+    return $ok || undef;
+}
+
+sub findEvent {
+    my $self = shift;
+    my $member = shift;
+
+    $member = $member->id if (ref($member));
+
+    my @list = grep { $member == $_->id } @{ $self->events };
+
+    return shift(@list);
+}
+
+sub build_environment {
+    my $self = shift;
+    my $env = $self->environment;
+
+    $$env{EventProcessor} = $self;
+    $$env{target} = [];
+    $$env{event} = [];
+    $$env{user_data} = [];
+    for my $e ( @{ $self->events } ) {
+        for my $env_part ( keys %{ $e->environment } ) {
+            next if ($env_part eq 'EventProcessor');
+            if ($env_part eq 'target') {
+                push @{ $$env{target} }, $e->environment->{target};
+            } elsif ($env_part eq 'event') {
+                push @{ $$env{event} }, $e->environment->{event};
+            } elsif ($env_part eq 'user_data') {
+                push @{ $$env{user_data} }, $e->environment->{user_data};
+            } else {
+                $$env{$env_part} = $e->environment->{$env_part};
+            }
+        }
+    }
+
+    return $self;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/ModRunner.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/ModRunner.pm
new file mode 100644
index 0000000000..747da7abc1
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/ModRunner.pm
@@ -0,0 +1,239 @@
+package OpenILS::Application::Trigger::ModLoader;
+use strict; use warnings;
+use UNIVERSAL::require;
+
+sub prefix { return 'OpenILS::Application::Trigger' }
+
+sub new {
+    my $class = shift;
+    $class = ref($class) || $class;
+
+    my $mod = shift;
+    return undef unless ($mod);
+
+    my $self = bless {
+        module => ref $mod ? $mod->module() : $mod,
+        handler => 'handler'
+    } => $class;
+
+    return $self->load;
+}
+
+sub loaded {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $l = shift;
+    $self->{loaded} = $l if (defined $l);
+    return $self->{loaded};
+}
+
+sub handler {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $h = shift;
+    $self->{handler} = $h if $h;
+    return $self->{handler};
+}
+
+sub module {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $m = shift;
+    $self->{module} = $m if $m;
+    return $self->{module};
+}
+
+sub load {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $m = shift || $self->module;
+    my $h = shift || $self->handler;
+    return 1 unless $m;
+
+    my $loaded = $m->use;
+
+    if (!$loaded) {
+        my $builtin_m = $self->prefix . "::$m";
+        $loaded = $builtin_m->use;
+
+        if (!$loaded) {
+            if ($m =~ /::/o) {
+                ($h = $m) =~ s/^.+::([^:]+)$/$1/o;
+                $m =~ s/^(.+)::[^:]+$/$1/o;
+
+                $loaded = $m->use;
+
+                if (!$loaded) {
+                    $h =  $self->handler;
+                    $builtin_m = $self->prefix . "::$m";
+                    $loaded = $m->use;
+
+                    $m = $builtin_m if ($loaded);
+                }
+            } else {
+                $loaded = $m->use;
+
+                # The following is an escape hatch for builtin dummy handlers
+                if (!$loaded) {
+                    $loaded = $self->prefix->use;
+                    if ($loaded && $self->prefix->can( $self->module ) ) {
+                        $m = $self->prefix;
+                        $h = $self->module;
+                    }
+                }
+            }
+        } else {
+            $m = $builtin_m;
+        }
+    }
+
+    if ($loaded) {
+        $self->module( $m );
+        $self->handler( $h );
+    }
+
+    $self->loaded($loaded);
+    return $self;
+}
+
+package OpenILS::Application::Trigger::ModRunner;
+use base 'OpenILS::Application::Trigger::ModLoader';
+
+sub new {
+    my $class = shift;
+    $class = ref($class) || $class;
+
+    my $m = shift;
+    my $e = shift || {};
+
+    my $self = $class->SUPER::new( $m );
+    return undef unless ($self && $self->loaded);
+
+    $self->environment( $e );
+    return $self;
+}
+
+sub pass {
+    my $old = shift;
+    return undef unless (ref $old);
+
+    my $class = ref($old);
+    my $m = shift;
+
+    my $self = $class->SUPER::new( $m );
+    return undef unless ($self && $self->loaded);
+
+    $self->environment( $old->environment );
+    return $self;
+}
+
+sub environment {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $e = shift;
+    $self->{environment} = $e if (defined $e);
+    return $self->{environment};
+}
+
+sub final_result {
+    my $self = shift;
+    return undef unless (ref $self);
+
+    my $r = shift;
+    $self->{final_result} = $r if (defined $r);
+    return $self->{final_result};
+}
+
+sub run {
+    my $self = shift;
+    return undef unless (ref $self && $self->loaded);
+
+    $self->environment( shift );
+
+    my $m = $self->module;
+    my $h = $self->handler;
+    my $e = $self->environment;
+    $self->final_result( $m->$h( $e ) );
+
+    return $self;
+};
+
+package OpenILS::Application::Trigger::ModRunner::Collector;
+use base 'OpenILS::Application::Trigger::ModRunner';
+sub prefix { return 'OpenILS::Application::Trigger::Collector' }
+
+package OpenILS::Application::Trigger::ModRunner::Validator;
+use base 'OpenILS::Application::Trigger::ModRunner';
+sub prefix { return 'OpenILS::Application::Trigger::Validator' }
+
+package OpenILS::Application::Trigger::ModRunner::Reactor;
+use base 'OpenILS::Application::Trigger::ModRunner';
+sub prefix { return 'OpenILS::Application::Trigger::Reactor' }
+
+package OpenILS::Application::Trigger::ModRunner::Cleanup;
+use base 'OpenILS::Application::Trigger::ModRunner';
+sub prefix { return 'OpenILS::Application::Trigger::Cleanup' }
+
+package OpenILS::Application::Trigger::ModStackRunner;
+use base 'OpenILS::Application::Trigger::ModRunner';
+
+sub new {
+    my $class = shift;
+    $class = ref($class) || $class;
+
+    my $m = shift;
+    $m = [$m] unless (ref($m) =~ /ARRAY/o);
+
+    my $e = shift || {};
+
+    my $self = bless {
+        runners => []
+    } => $class;
+
+    for my $mod ( @$m ) {
+        my $r = $self->SUPER::new( $m );
+        return undef unless ($r && $r->loaded);
+        push @{$self->{runners}}, $r;
+    }
+
+    $self->loaded(1);
+
+    return $self;
+}
+
+sub pass {
+    my $old = shift;
+    return undef unless (ref $old);
+
+    my $class = ref($old);
+    my $m = shift;
+
+    my $self = $class->new( $m );
+    return undef unless ($self && $self->loaded);
+
+    $self->environment( $old->environment );
+    return $self;
+}
+
+sub run {
+    my $self = shift;
+    return undef unless (ref $self && $self->loaded);
+
+    $self->environment( shift );
+    my $e = $self->environment;
+
+    for my $r (@{$self->{runners}}) {
+        my $m = $r->module;
+        my $h = $r->handler;
+        $r->final_result( $m->$h( $e ) );
+    }
+
+    return $self;
+};
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor.pm
new file mode 100644
index 0000000000..4be542b0d6
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor.pm
@@ -0,0 +1,183 @@
+package OpenILS::Application::Trigger::Reactor;
+use strict; use warnings;
+use Template;
+use DateTime;
+use DateTime::Format::ISO8601;
+use Unicode::Normalize;
+use OpenSRF::Utils qw/:datetime/;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+my $U = 'OpenILS::Application::AppUtils';
+
+sub fourty_two { return 42 }
+sub NOOP_True  { return  1 }
+sub NOOP_False { return  0 }
+
+
+
+# helper functions inserted into the TT environment
+my $_TT_helpers = {
+
+    # turns a date into something TT can understand
+    format_date => sub {
+        my $date = shift;
+        $date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($date));
+        return sprintf(
+            "%0.2d:%0.2d:%0.2d %0.2d-%0.2d-%0.4d",
+            $date->hour,
+            $date->minute,
+            $date->second,
+            $date->day,
+            $date->month,
+            $date->year
+        );
+    },
+
+    # escapes a string for inclusion in an XML document.  escapes &, <, and > characters
+    escape_xml => sub {
+        my $str = shift;
+        $str =~ s/&/&/sog;
+        $str =~ s//>/sog;
+        return $str;
+    },
+
+    escape_json => sub {
+        my $str = shift;
+        $str =~ s/([\x{0080}-\x{fffd}])/sprintf('\u%0.4x',ord($1))/sgoe;
+        return $str;
+    },
+
+    # strip non-ASCII characters after splitting base characters and diacritics
+    # least common denominator for EDIFACT messages using the UNOB character set
+    force_jedi_unob => sub {
+        my $str = shift;
+        $str = NFD($str);
+        $str =~ s/[\x{0080}-\x{fffd}]//g;
+        return $str;
+    },
+
+    # returns the calculated user locale
+    get_user_locale => sub { 
+        my $user_id = shift;
+        return $U->get_user_locale($user_id);
+    },
+
+    # returns the calculated copy price
+    get_copy_price => sub {
+        my $copy_id = shift;
+        return $U->get_copy_price(new_editor(xact=>1), $copy_id);
+    },
+
+    # given a copy, returns the title and author in a hash
+    get_copy_bib_basics => sub {
+        my $copy_id = shift;
+        my $copy = new_editor(xact=>1)->retrieve_asset_copy([
+            $copy_id,
+            {
+                flesh => 2,
+                flesh_fields => {
+                    acp => ['call_number'],
+                    acn => ['record']
+                }
+            }
+        ]);
+        if($copy->call_number->id == -1) {
+            return {
+                title  => $copy->dummy_title,
+                author => $copy->dummy_author,
+            };
+        } else {
+            my $mvr = $U->record_to_mvr($copy->call_number->record);
+            return {
+                title  => $mvr->title,
+                author => $mvr->author
+            };
+        }
+    },
+
+    # returns the org unit setting value
+    get_org_setting => sub {
+        my($org_id, $setting) = @_;
+        return $U->ou_ancestor_setting_value($org_id, $setting);
+    },
+
+    # This basically greps/maps out ths isbn string values, but also promotes the first isbn-13 to the
+    # front of the line (so that the EDI translator takes it as primary) if there is one.
+    get_li_isbns => sub {
+        my $attrs = shift;
+        my @isbns;
+        my $primary;
+        foreach (@$attrs) {
+            $_->attr_name eq 'isbn' or next;
+            my $val = $_->attr_value;
+            if (! $primary and length($val) == 13) {
+                $primary = $val;
+            } else {
+                push @isbns, $val;
+            }
+        }
+        $primary and unshift @isbns, $primary;
+        $logger->debug("get_li_isbns returning isbns: " . join(', ', @isbns));
+        return @isbns;
+    },
+
+    # helpers.get_li_attr('isbn_13', li.attributes)
+    # returns matching line item attribute, or undef
+    get_li_attr => sub {
+        my $name = shift or return;     # the first arg is always the name
+        my ($type, $attr) = (scalar(@_) == 1) ? (undef, $_[0]) : @_;
+        # if the next is the last, it's the attributes, otherwise type
+        # use Data::Dumper; $logger->warn("get_li_attr: " . Dumper($attr));
+        ($name and @$attr) or return;
+        my $length;
+        $name =~ s/^(\D+)_(\d+)$/$1/ and $length = $2;
+        foreach (@$attr) {
+            $_->attr_name eq $name or next;
+            next if $length and $length != length($_->attr_value);
+            return $_->attr_value if (! $type) or $type eq $_->attr_type;
+        }
+        return;
+    },
+};
+
+
+# processes templates.  Returns template output on success, undef on error
+sub run_TT {
+    my $self = shift;
+    my $env = shift;
+    my $nostore = shift;
+    return undef unless $env->{template};
+
+    my $error;
+    my $output = '';
+    my $tt = Template->new;
+    # my $tt = Template->new(ENCODING => 'utf8');   # ??
+    $env->{helpers} = $_TT_helpers;
+
+    unless( $tt->process(\$env->{template}, $env, \$output) ) {
+        $output = undef;
+        ($error = $tt->error) =~ s/\n/ /og;
+        $logger->error("Error processing Trigger template: $error");
+    }
+
+    if ( $error or (!$nostore && $output) ) {
+        my $t_o = Fieldmapper::action_trigger::event_output->new;
+        $t_o->data( ($error) ? $error : $output );
+        $t_o->is_error( ($error) ? 't' : 'f' );
+        $logger->info("trigger: writing " . length($t_o->data) . " bytes to template output");
+
+        $env->{EventProcessor}->editor->xact_begin;
+        $t_o = $env->{EventProcessor}->editor->create_action_trigger_event_output( $t_o );
+
+        my $state = (ref $$env{event} eq 'ARRAY') ? $$env{event}->[0]->state : $env->{event}->state;
+        my $key = ($error) ? 'error_output' : 'template_output';
+        $env->{EventProcessor}->update_state( $state, { $key => $t_o->id } );
+    }
+	
+    return $output;
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/ApplyCircFee.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/ApplyCircFee.pm
new file mode 100644
index 0000000000..1574b2bdee
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/ApplyCircFee.pm
@@ -0,0 +1,56 @@
+package OpenILS::Application::Trigger::Reactor::ApplyCircFee;
+use base 'OpenILS::Application::Trigger::Reactor';
+use strict; use warnings;
+use Error qw/:try/;
+use OpenILS::Const qw/:const/;
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::Logger qw/:logger/;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+
+
+sub ABOUT {
+    return < 1);
+    my $btype = $e->retrieve_config_billing_type(OILS_BILLING_TYPE_NOTIFICATION_FEE);
+
+    my $circ = $$env{target};
+    my $amount = $$env{params}{amount} || $btype->default_price;
+
+    unless($amount) {
+        $logger->error("ApplyCircFee needs a fee amount");
+        $e->rollback;
+        return 0;
+    }
+
+    my $bill = Fieldmapper::money::billing->new;
+    $bill->xact($circ->id);
+    $bill->amount($amount);
+    $bill->btype(OILS_BILLING_TYPE_NOTIFICATION_FEE);
+    $bill->billing_type($btype->name);
+    $bill->note($self->run_TT($env));
+
+    unless( $e->create_money_billing($bill) ) {
+        $e->rollback;
+        return 0;
+    }
+        
+    $e->commit;
+    return 1;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/ApplyPatronPenalty.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/ApplyPatronPenalty.pm
new file mode 100644
index 0000000000..33e624e595
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/ApplyPatronPenalty.pm
@@ -0,0 +1,74 @@
+package OpenILS::Application::Trigger::Reactor::ApplyPatronPenalty;
+use base 'OpenILS::Application::Trigger::Reactor';
+use strict; use warnings;
+use Error qw/:try/;
+use OpenILS::Const qw/:const/;
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Application::AppUtils;
+my $U = "OpenILS::Application::AppUtils";
+
+
+sub ABOUT {
+    return <error("ApplyPatronPenalty: missing parameters");
+        return 0;
+    }
+
+    my $e = new_editor(xact => 1);
+
+    my $ptype = $e->search_config_standing_penalty({name => $pname})->[0];
+
+    unless($ptype) {
+        $logger->error("ApplyPatronPenalty: invalid penalty name '$pname'");
+        $e->rollback;
+        return 0;
+    }
+
+    $context_org = (defined $ptype->org_depth) ?
+        $U->org_unit_ancestor_at_depth($context_org->id, $ptype->org_depth) :
+        $context_org->id;
+
+    # apply the penalty
+    my $penalty = Fieldmapper::actor::usr_standing_penalty->new;
+    $penalty->usr($user->id);
+    $penalty->org_unit($context_org);
+    $penalty->standing_penalty($ptype->id);
+    $penalty->note($self->run_TT($env));
+
+    unless($e->create_actor_user_standing_penalty($penalty)) {
+        $e->rollback;
+        return 0;
+    }
+
+    $e->commit;
+    return 1;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/AstCall.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/AstCall.pm
new file mode 100644
index 0000000000..e664da6320
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/AstCall.pm
@@ -0,0 +1,360 @@
+package OpenILS::Application::Trigger::Reactor::AstCall;
+use base 'OpenILS::Application::Trigger::Reactor';
+use OpenSRF::Utils::Logger qw($logger);
+# use OpenILS::Application::AppUtils;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+
+use strict; use warnings;
+use Error qw/:try/;
+use Data::Dumper;
+
+use OpenSRF::Utils::SettingsClient;
+use RPC::XML::Client;
+$Data::Dumper::Indent = 0;
+
+my $U = 'OpenILS::Application::AppUtils';
+
+my $e = new_editor(xact => 1);
+
+# $last_channel_used is:
+# ~ index (not literal value) of last channel used in a callfile
+# ~ index is of position in @channels (zero-based)
+# ~ cached at package level
+# ~ typically for Zap (PSTN), not VOIP
+
+our @channels;
+our $last_channel_used = 0;
+our $telephony;
+
+sub ABOUT {
+    return <info(__PACKAGE__ . ": get_conf()");
+    $telephony and return $telephony;
+    my $config = OpenSRF::Utils::SettingsClient->new;
+    # config object cached by package
+    $telephony = $config->config_value('notifications', 'telephony');
+    return $telephony;
+}
+
+sub get_channels {
+    @channels and return @channels;
+    my $config = get_conf();    # populated $telephony object
+    @channels = @{ $config->{channels} };
+    return @channels;
+}
+
+sub next_channel {
+    # Increments $last_channel_used, or resets it to zero, as necessary.
+    # Returns appropriate value from channels array.
+    my @chans = get_channels();
+    unless(@chans) {
+        $logger->error(__PACKAGE__ . ": Cannot build call using " .
+            (shift ||'driver') .
+            ", no notifications.telephony.channels found in config!");
+        return;
+    }
+    if (++$last_channel_used > $#chans) {
+        $last_channel_used = 0;
+    }
+    return $chans[$last_channel_used];     # say, 'Zap/1' or 'Zap/12'
+}
+
+sub channel {
+    my $tech = get_conf()->{driver} || 'SIP';
+    if ($tech !~ /^SIP/) {
+        return next_channel($tech);
+    }
+    return $tech;                          #  say, 'SIP' or 'SIP/ubab33'
+}
+
+sub get_extra_lines {
+    my $lines = get_conf()->{callfile_lines} or return '';
+    my @fixed;
+    foreach (split "\n", $lines) {
+        s/^\s*//g;      # strip leading spaces
+        /\S/ or next;   # skip empty lines
+        push @fixed, $_;
+    }
+    (scalar @fixed) or return '';
+    return join("\n", @fixed) . "\n";
+}
+
+sub host_string {
+    my $conf = get_conf();
+    my $host = $conf->{host};
+    unless ($host) {
+        $logger->error(__PACKAGE__ . ": No telephony/host in config.");
+        return;
+    }
+
+    # prepend http:// if no protocol specified
+    $host =~ /^\S+:\/\// or $host  = 'http://' . $host;
+    # append port number if specified
+    $conf->{port} and $host .= ":" . $conf->{port};
+
+    return $host;
+}
+sub rpc_client {
+    # TODO: caching? (would take testing to ensure memory and
+    # connections are clean/stable)
+    my $host = (@_ ? shift : host_string()) or return;
+    return new RPC::XML::Client($host);
+}
+
+sub handler {
+    my ($self, $env) = @_;
+
+    $logger->info(__PACKAGE__ . ": entered handler");
+
+    # assignment, not comparison
+    unless ($env->{channel_prefix} = channel()) {
+        $logger->error(__PACKAGE__ . ": Cannot find tech/resource in config");
+        return 0;
+    }
+
+    $env->{extra_lines} = get_extra_lines() || '';
+    my $tmpl_output = $self->run_TT($env);
+    if (not $tmpl_output) {
+        $logger->error(__PACKAGE__ . ": no template input");
+        return 0;
+    }
+
+    my @eventids = map {$_->id} @{$env->{event}};
+    @eventids or push @eventids, '';
+
+    my $eo = Fieldmapper::action_trigger::event_output->new;
+
+    # XXX we have to actually create this in the DB now if we expect to use the
+    # ID later
+    $eo->data("");
+    $eo = $e->create_action_trigger_event_output($eo) or return $e->die_event;
+    if ($env->{"extra_lines"}) {
+        $tmpl_output .= ";; added by handler:\n";
+        $tmpl_output .= $env->{"extra_lines"};
+    }
+
+    # or would we prefer distinct lines instead of comma-separated?
+    $tmpl_output .= "; event_ids = " . join(",",@eventids) . "\n";
+    $tmpl_output .= "; event_output = " . $eo->id . "\n";
+
+    #my $filename_fragment = $userid . '_' . $eventids[0] . 'uniq' . time;
+    # not $noticetype,
+    # the event_output.id tells us all we need to know
+    # XXX why is id in here twice?
+    my $filename_fragment = $eo->id . '_' . $eo->id;
+
+    # TODO: add scheduling intelligence and use it here... or not if
+    # relying only on crontab
+    my $client = rpc_client();
+    my $resp = $client->send_request(
+        'inject', $tmpl_output, $filename_fragment, 0
+    ); # FIXME: 0 could be seconds-from-epoch UTC if deferred call needed
+
+    $logger->debug(
+        ref $resp ? ("Response: " . Dumper($resp->value)) : "Error: $resp"
+    );
+
+    if ($resp->{code} and $resp->{code}->value == 200) {
+        $eo->is_error('f');
+        $eo->data('filename: ' . $resp->{spooled_filename}->value);
+        # could look for the file that replaced it
+    } else {
+        $eo->is_error('t');
+        my $msg = $resp->{faultcode} ? $resp->{faultcode}->value :
+                    $resp->{     code} ? $resp->{     code}->value :
+                        " -- UNKNOWN response '$resp'";
+        $msg .= " for $filename_fragment";
+        $eo->data("Error " . $msg);
+        $logger->error(__PACKAGE__ . ": Mediator Error " . $msg);
+    }
+
+    # Now point all our events' async_output to the newly made row
+#    $eo = $env->{EventProcessor}->editor->
+#        create_action_trigger_event_output( $eo );
+    $e->update_action_trigger_event_output($eo) or return $e->die_event;
+    foreach (@eventids) {
+        my $event = $e->retrieve_action_trigger_event($_);
+        $event->async_output($eo->id);
+        $e->update_action_trigger_event($event);
+    }
+    $e->commit;    # defer till after loop?
+
+    # TODO: a sub for saving async_output might belong in Trigger.pm
+    1;
+}
+
+sub _files {
+    my $response = shift or return;
+    return map {$response->{$_}} sort grep {/^file_\d*/} keys %$response;
+}
+
+=head1 EXAMPLE CALFILES
+
+Note: all lines start flush left (no leading whitespace)
+
+=head2 Example callfile (successful)
+
+    Channel: SIP/ubab33/17707775555
+    Context: overdue-test
+    MaxRetries: 1
+    RetryTime: 60
+    WaitTime: 30
+    Extension: 10
+    Archive: 1
+    Set: items=1
+    Set: titlestring=chez nos gens;; added by OpenILS::Application::Trigger::Reactor::AstCall handler:
+    ; event_ids = 123,145
+    ; event_output = 14;; added by inject() in the mediator
+    Set: callfilename=EG_1258060382_6.call
+
+    StartRetry: 2139 1 (1258060442)
+    Status: Completed
+    Channel: SIP/ubab33/17707775555
+
+=head2 Example callfile (FAILED)
+
+    CallerID: "Jack Jackson" <17707775555>
+    Context: overdue-test
+    MaxRetries: 1
+    RetryTime: 60
+    WaitTime: 30
+    Extension: 10
+    Archive: 1
+    Set: items=1
+    Set: titlestring=Land Before Time;; added by OpenILS::Application::Trigger::Reactor::AstCall handler:
+    Set: LOOP=1
+    Set: callfilename=EG_joe_20091109145355.call
+
+    StartRetry: 2139 1 (1257907526)
+    ; FAILED: 0
+
+    EndRetry: 2139 1 (1257907496)
+
+    StartRetry: 2139 2 (1257907617)
+    ; FAILED: 0
+    Status: Expired
+
+=head2 Possible data structure:
+
+ $feedback = {
+     status => val,
+     attempts => [ $attempt1, $attempt2 ... $attemptN ],
+     anything_else => scalar,
+ }
+ ...
+ $attempt = {
+     time => secs from epoch (UTC) for the BEGINNING of the call,
+     duration => secs,
+     failed => code,
+ }
+
+=cut
+
+sub feedback_hash {
+    # parses the done callfile comments from Mediator
+    # return ref to hash
+    my $content  = shift or return;
+    my %hash     = ();
+    # my @attempts = ();
+    my @lines    = split "\n", $content;
+    foreach (shift @lines) {
+        s/^\s*(Set:\s*)?//i;   # strip leading whitespace, and possible "Set:"
+        if (/^StartRetry: \d+ (\d+) \((\d+)\)/) {
+            # go parse  an attempt;
+            # go record an attempt;
+        }
+        if (/^(Status):\s*(\S+)/i or /^;+\s*(FAILED):\s*(\S*)/i) {
+            $hash{lc $1} = $2;
+            next;
+        }
+
+        /^;+\s*(\S+)\s*[=:]\s*([^;]*)$/ and $hash{lc $1} = $2;
+    }
+    if (exists $hash{failed}) {
+        $hash{failcode} = $hash{failed};
+        # b/c "0" is a common failcode and we want a more binary indicator
+        $hash{failed}   = 1;
+    }
+    return \%hash;
+}
+
+sub cleanup {
+    my $self   = shift or return;
+    my $files  = join(',',@_) or return;
+    my $client = rpc_client();
+    return $client->send_request('cleanup', $files);
+    # TODO: more error checking
+}
+
+sub retrieve {
+    my $self   = shift or return;
+    my $client = rpc_client();
+    my $resp   = $client->send_request('retrieve');
+    unless ($resp and ref $resp) {
+         $logger->error(
+             __PACKAGE__ . ": Mediator Error: " .
+             ($resp ? 'Bad' : 'No') . " response to retrieve request"
+         );
+         return;
+    }
+
+    # my $count   = $resp{match_count}; # how many files we should have
+    # my @rm_list = ();
+    my @files   = _files($resp);
+    foreach (@files) {
+        my $content  = $resp->{$_}->content;
+        my $filename = $resp->{$_}->filename;
+        unless ($content) {
+            $logger->error(__PACKAGE__ .
+                ": Mediator sent incomplete/unintelligible message for " .
+                "filename " . ($filename || 'UNKNOWN'));
+            next;
+        }
+        my $feedback = feedback_hash($content);
+        my $output   = $e->retrieve_action_trigger_event_output(
+            $feedback->{event_output}
+        );
+        if ($content == $output->data) {
+            $logger->error(
+                __PACKAGE__ . ": Mediator sent duplicate file "
+                . $resp->{$_}->filename . " for event_output " .
+                $feedback->{event_output}
+            );
+        } else {
+            $output->data($content);
+        }
+        $e->commit;     # defer until after loop? probably not
+        my $clean = $client->send_request('cleanup', $filename);
+        # TODO: deletion by (comma-separated) filenames in chunks
+        # instead of individually?
+        # push @rm_list, $_; $client->send_request('cleanup', join(',',@rm_list));
+        unless ($clean and ref $clean) {
+            $logger->error(
+                __PACKAGE__ . ": Mediator Error: " .
+                ($clean ? 'Bad' : 'No') .
+                " response to cleanup $filename request");
+            next;
+        }
+        unless ($clean->{code}->value == 200 and $clean->{delete_count}) {
+            $logger->error(__PACKAGE__ . ": cleanup $filename returned " . (
+                $resp->{faultcode} ? $resp->{faultcode}->value :
+                    $resp->{     code} ? $resp->{     code}->value :
+                        " -- UNKNOWN response '$resp'"
+            ) . " with delete_count " .
+            (defined $clean->{delete_count} ? $clean->{delete_count} : 'UNDEF'));
+        }
+    }
+    return @files;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/GeneratePurchaseOrderJEDI.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/GeneratePurchaseOrderJEDI.pm
new file mode 100644
index 0000000000..f7e9fc5433
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/GeneratePurchaseOrderJEDI.pm
@@ -0,0 +1,22 @@
+package OpenILS::Application::Trigger::Reactor::GeneratePurchaseOrderJEDI;
+use base 'OpenILS::Application::Trigger::Reactor';
+use strict; use warnings;
+use OpenSRF::Utils::Logger qw/:logger/;
+
+sub ABOUT {
+    return <run_TT($env);
+    return 0;
+}
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/MarkItemLost.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/MarkItemLost.pm
new file mode 100644
index 0000000000..eaba44be53
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/MarkItemLost.pm
@@ -0,0 +1,47 @@
+package OpenILS::Application::Trigger::Reactor::MarkItemLost;
+use base 'OpenILS::Application::Trigger::Reactor';
+use strict; use warnings;
+use Error qw/:try/;
+use Data::Dumper;
+use OpenSRF::Utils::Logger qw/:logger/;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Application::Cat::AssetCommon;
+$Data::Dumper::Indent = 0;
+
+
+sub ABOUT {
+    return < 1);
+    $e->requestor($e->retrieve_actor_user($$env{params}{editor}));
+
+    my $circ = $$env{target};
+    my $evt = OpenILS::Application::Cat::AssetCommon->set_item_lost($e, $circ->target_copy);
+    if($evt) {
+        $logger->error("trigger: MarkItemLost failed with event ".$evt->{textcode});
+        return 0;
+    }
+
+    $e->commit;
+
+    my $ses = OpenSRF::AppSession->create('open-ils.trigger');
+    $ses->request('open-ils.trigger.event.autocreate', 'lost.auto', $circ, $circ->circ_lib);
+
+    return 1;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/ProcessTemplate.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/ProcessTemplate.pm
new file mode 100644
index 0000000000..34a6b31fc6
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/ProcessTemplate.pm
@@ -0,0 +1,23 @@
+package OpenILS::Application::Trigger::Reactor::ProcessTemplate;
+use base 'OpenILS::Application::Trigger::Reactor';
+use strict; use warnings;
+use OpenSRF::Utils::Logger qw/:logger/;
+
+sub ABOUT {
+    return <run_TT($env);
+    return 0;
+}
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/SendEmail.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/SendEmail.pm
new file mode 100644
index 0000000000..64826fda07
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/SendEmail.pm
@@ -0,0 +1,73 @@
+package OpenILS::Application::Trigger::Reactor::SendEmail;
+use strict; use warnings;
+use Error qw/:try/;
+use Data::Dumper;
+use Email::Send;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Application::Trigger::Reactor;
+use OpenSRF::Utils::Logger qw/:logger/;
+use utf8;
+$Data::Dumper::Indent = 0;
+
+use base 'OpenILS::Application::Trigger::Reactor';
+
+my $log = 'OpenSRF::Utils::Logger';
+
+sub ABOUT {
+    return <new;
+    my $smtp = $conf->config_value('email_notify', 'smtp_server');
+    $$env{default_sender} = $conf->config_value('email_notify', 'sender_address');
+
+    my $text = $self->run_TT($env);
+    return 0 if (!$text);
+
+    my $sender = Email::Send->new({mailer => 'SMTP'});
+    $sender->mailer_args([Host => $smtp]);
+
+    my $stat;
+    my $err;
+
+    utf8::encode($text); # prevent "Wide character" errors in Email::Send
+
+    try {
+        $stat = $sender->send($text);
+    } catch Error with {
+        $err = $stat = shift;
+        $logger->error("SendEmail Reactor: Email failed with error: $err");
+    };
+
+    if( !$err and $stat and $stat->type eq 'success' ) {
+        $logger->info("SendEmail Reactor: successfully sent email");
+        return 1;
+    } else {
+        $logger->warn("SendEmail Reactor: unable to send email: ".Dumper($stat));
+        $text =~ s/\n//og;
+        $logger->warn("SendEmail Reactor: failed email template: $text");
+        return 0;
+    }
+
+}
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/SendFile.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/SendFile.pm
new file mode 100644
index 0000000000..e3e6a9bf25
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/SendFile.pm
@@ -0,0 +1,48 @@
+package   OpenILS::Application::Trigger::Reactor::SendFile;
+use       OpenILS::Application::Trigger::Reactor;
+use base 'OpenILS::Application::Trigger::Reactor';
+
+# use OpenSRF::Utils::SettingsClient;
+use OpenILS::Utils::RemoteAccount;
+
+use strict;
+use warnings;
+
+sub ABOUT {
+    return <{params};
+
+    $params->{content} = $self->run_TT($env) or return;
+    my $connection = OpenILS::Utils::RemoteAccount->new(%$params) or return;
+    return $connection->put;
+}
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/StaticEmail.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/StaticEmail.pm
new file mode 100644
index 0000000000..289a4441da
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/StaticEmail.pm
@@ -0,0 +1,82 @@
+package OpenILS::Application::Trigger::Reactor::StaticEmail;
+use strict; use warnings;
+use Error qw/:try/;
+use Data::Dumper;
+use Email::Send;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Application::Trigger::Reactor;
+use OpenSRF::Utils::Logger qw/:logger/;
+
+use base 'OpenILS::Application::Trigger::Reactor';
+
+my $log = 'OpenSRF::Utils::Logger';
+
+my $default_template = <new;
+    my $smtp = $conf->config_value('email_notify', 'smtp_server');
+    $$env{params}{sender} ||= $conf->config_value('email_notify', 'sender_address');
+    $$env{params}{subject} ||= 'Test subject -- StaticEmail Reactor';
+    $$env{params}{body} ||= 'Test body -- StaticEmail Reactor';
+    $$env{template} ||= $default_template;
+
+    $$env{params}{recipient} or return 0;
+
+    my $text = $self->run_TT($env);
+    return 0 if (!$text);
+
+    $logger->info("StaticEmail Reactor: sending email to ".
+        $$env{params}{recipient}." via SMTP server $smtp");
+
+    my $sender = Email::Send->new({mailer => 'SMTP'});
+    $sender->mailer_args([Host => $smtp]);
+
+
+    my $stat;
+    my $err;
+
+    try {
+        $stat = $sender->send($text);
+    } catch Error with {
+        $err = $stat = shift;
+        $logger->error("StaticEmail Reactor: Email failed with error: $err");
+    };
+
+    if( !$err and $stat and $stat->type eq 'success' ) {
+        $logger->info("StaticEmail Reactor: successfully sent email");
+        return 1;
+    } else {
+        $logger->warn("StaticEmail Reactor: unable to send email: ".Dumper($stat));
+        return 0;
+    }
+
+}
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator.pm
new file mode 100644
index 0000000000..260af53def
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator.pm
@@ -0,0 +1,94 @@
+package OpenILS::Application::Trigger::Validator;
+use strict; use warnings;
+use DateTime;
+use DateTime::Format::ISO8601;
+use OpenSRF::Utils qw/:datetime/;
+use OpenSRF::Utils::Logger qw/:logger/;
+use OpenILS::Const qw/:const/;
+sub fourty_two { return 42 }
+sub NOOP_True { return 1 }
+sub NOOP_False { return 0 }
+
+sub CircIsOpen {
+    my $self = shift;
+    my $env = shift;
+
+    return 0 if (defined($env->{target}->checkin_time));
+
+    if ($env->{params}->{min_target_age}) {
+        $env->{params}->{target_age_field} = 'xact_start';
+        return 0 if (!$self->MinPassiveTargetAge($env));
+    }
+
+    return 1;
+}
+
+sub MinPassiveTargetAge {
+    my $self = shift;
+    my $env = shift;
+    my $target = $env->{target};
+    my $delay_field = $env->{params}->{target_age_field} || $env->{event}->event_def->delay_field;
+
+    unless($env->{params}->{min_target_age}) {
+        $logger->warn("'min_target_age' parameter required for MinPassiveTargetAge validator");
+        return 0; # no-op false
+    }
+
+    unless($delay_field) {
+        $logger->warn("'target_age_field' parameter or delay_field required for MinPassiveTargetAge validator");
+        return 0; # no-op false
+    }
+
+    my $delay_field_ts = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($target->$delay_field()));
+
+    # to get the minimum time that the target must have aged to, add the min age to the delay field
+    $delay_field_ts->add( seconds => interval_to_seconds( $env->{params}->{min_target_age} ) );
+
+    return 1 if $delay_field_ts <= DateTime->now;
+    return 0;
+}
+
+sub CircIsOverdue {
+    my $self = shift;
+    my $env = shift;
+    my $circ = $env->{target};
+
+    return 0 if $circ->checkin_time;
+    return 0 if $circ->stop_fines and not $circ->stop_fines =~ /MAXFINES|LONGOVERDUE/;
+
+    if ($env->{params}->{min_target_age}) {
+        $env->{params}->{target_age_field} = 'xact_start';
+        return 0 if (!$self->MinPassiveTargetAge($env));
+    }
+
+    my $due_date = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($circ->due_date));
+    return 0 if $due_date > DateTime->now;
+
+    return 1;
+}
+
+sub HoldIsAvailable {
+    my $self = shift;
+    my $env = shift;
+
+    my $hold = $env->{target};
+
+    return 1 if 
+        !$hold->cancel_time and
+        $hold->capture_time and 
+        $hold->current_copy and
+        $hold->current_copy->status == OILS_COPY_STATUS_ON_HOLDS_SHELF;
+
+    return 0;
+}
+
+sub HoldIsCancelled {
+    my $self = shift;
+    my $env = shift;
+
+    my $hold = $env->{target};
+
+    return ($hold->cancel_time) ? 1 : 0;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator/Acq.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator/Acq.pm
new file mode 100644
index 0000000000..06622abce7
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator/Acq.pm
@@ -0,0 +1,13 @@
+package OpenILS::Application::Trigger::Validator::Acq;
+use strict; use warnings;
+# use OpenSRF::Utils::Logger qw/:logger/;
+
+sub get_lineitem_from_req {
+    my($self, $env) = @_;
+    my $req = $env->{target};
+    return (ref $env->{target}->lineitem) ? 
+        $env->{target}->lineitem : 
+        $self->editor->retrieve_acq_lineitem($$env->{target}->lineitem);
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator/Acq/PurchaseOrderEDIRequired.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator/Acq/PurchaseOrderEDIRequired.pm
new file mode 100644
index 0000000000..211d75fee0
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator/Acq/PurchaseOrderEDIRequired.pm
@@ -0,0 +1,28 @@
+package OpenILS::Application::Trigger::Validator::Acq::PurchaseOrderEDIRequired;
+use strict; use warnings;
+# use OpenSRF::Utils::Logger qw/:logger/;
+use OpenILS::Utils::CStoreEditor qw/ new_editor /;
+use OpenILS::Application::AppUtils;
+my $U = 'OpenILS::Application::AppUtils';
+
+sub handler {
+    my $self = shift;
+    my $env  = shift;
+    my $po   = $env->{target};
+
+    my $provider = 
+        ref($po->provider) ? 
+            $po->provider : 
+            new_editor->retrieve_acq_provider($po->provider);
+
+    return 1 if 
+        ($po->state eq 'on-order' or
+         $po->state eq 'retry'      ) and 
+        $provider                     and 
+        $provider->edi_default        and 
+        $U->is_true($provider->active);
+
+    return 0;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator/Acq/UserRequestCancelled.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator/Acq/UserRequestCancelled.pm
new file mode 100644
index 0000000000..6cbf13ef78
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator/Acq/UserRequestCancelled.pm
@@ -0,0 +1,12 @@
+package OpenILS::Application::Trigger::Validator::Acq::UserRequestCancelled;
+use strict; use warnings;
+use OpenSRF::Utils::Logger qw/:logger/;
+use OpenILS::Application::Trigger::Validator::Acq;
+
+sub handler {
+    my $self = shift;
+    my $env = shift;
+    return OpenILS::Application::Trigger::Validator::Acq::get_lineitem_from_req($self, $env)->state eq 'cancelled';
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator/Acq/UserRequestOrdered.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator/Acq/UserRequestOrdered.pm
new file mode 100644
index 0000000000..a2552afc71
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator/Acq/UserRequestOrdered.pm
@@ -0,0 +1,12 @@
+package OpenILS::Application::Trigger::Validator::Acq::UserRequestOrdered;
+use strict; use warnings;
+use OpenSRF::Utils::Logger qw/:logger/;
+use OpenILS::Application::Trigger::Validator::Acq;
+
+sub handler {
+    my $self = shift;
+    my $env = shift;
+    return OpenILS::Application::Trigger::Validator::Acq::get_lineitem_from_req($self, $env)->state eq 'on-order';
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator/Acq/UserRequestReceived.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator/Acq/UserRequestReceived.pm
new file mode 100644
index 0000000000..d43e094017
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Validator/Acq/UserRequestReceived.pm
@@ -0,0 +1,12 @@
+package OpenILS::Application::Trigger::Validator::Acq::UserRequestReceived;
+use strict; use warnings;
+use OpenSRF::Utils::Logger qw/:logger/;
+use OpenILS::Application::Trigger::Validator::Acq;
+
+sub handler {
+    my $self = shift;
+    my $env = shift;
+    return OpenILS::Application::Trigger::Validator::Acq::get_lineitem_from_req($self, $env)->state eq 'received';
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Vandelay.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Vandelay.pm
new file mode 100644
index 0000000000..1311800be0
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Vandelay.pm
@@ -0,0 +1,1111 @@
+package OpenILS::Application::Vandelay;
+use strict; use warnings;
+use OpenILS::Application;
+use base qw/OpenILS::Application/;
+use Unicode::Normalize;
+use OpenSRF::EX qw/:try/;
+use OpenSRF::AppSession;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Cache;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use MARC::Batch;
+use MARC::Record;
+use MARC::File::XML;
+use OpenILS::Utils::Fieldmapper;
+use Time::HiRes qw(time);
+use OpenSRF::Utils::Logger qw/$logger/;
+use MIME::Base64;
+use OpenILS::Const qw/:const/;
+use OpenILS::Application::AppUtils;
+use OpenILS::Application::Cat::BibCommon;
+use OpenILS::Application::Cat::AuthCommon;
+use OpenILS::Application::Cat::AssetCommon;
+my $U = 'OpenILS::Application::AppUtils';
+
+# A list of LDR/06 values from http://loc.gov/marc
+my %record_types = (
+        a => 'bib',
+        c => 'bib',
+        d => 'bib',
+        e => 'bib',
+        f => 'bib',
+        g => 'bib',
+        i => 'bib',
+        j => 'bib',
+        k => 'bib',
+        m => 'bib',
+        o => 'bib',
+        p => 'bib',
+        r => 'bib',
+        t => 'bib',
+        u => 'holdings',
+        v => 'holdings',
+        x => 'holdings',
+        y => 'holdings',
+        z => 'auth',
+      ' ' => 'bib',
+);
+
+sub initialize {}
+sub child_init {}
+
+# --------------------------------------------------------------------------------
+# Biblio ingest
+
+sub create_bib_queue {
+    my $self = shift;
+    my $client = shift;
+    my $auth = shift;
+    my $name = shift;
+    my $owner = shift;
+    my $type = shift;
+    my $import_def = shift;
+
+    my $e = new_editor(authtoken => $auth, xact => 1);
+
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('CREATE_BIB_IMPORT_QUEUE');
+    $owner ||= $e->requestor->id;
+
+    if ($e->search_vandelay_bib_queue( {name => $name, owner => $owner, queue_type => $type})->[0]) {
+        $e->rollback;
+        return OpenILS::Event->new('BIB_QUEUE_EXISTS') 
+    }
+
+    my $queue = new Fieldmapper::vandelay::bib_queue();
+    $queue->name( $name );
+    $queue->owner( $owner );
+    $queue->queue_type( $type ) if ($type);
+    $queue->item_attr_def( $import_def ) if ($import_def);
+
+    my $new_q = $e->create_vandelay_bib_queue( $queue );
+    return $e->die_event unless ($new_q);
+    $e->commit;
+
+    return $new_q;
+}
+__PACKAGE__->register_method(  
+    api_name   => "open-ils.vandelay.bib_queue.create",
+    method     => "create_bib_queue",
+    api_level  => 1,
+    argc       => 4,
+);                      
+
+
+sub create_auth_queue {
+    my $self = shift;
+    my $client = shift;
+    my $auth = shift;
+    my $name = shift;
+    my $owner = shift;
+    my $type = shift;
+
+    my $e = new_editor(authtoken => $auth, xact => 1);
+
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless $e->allowed('CREATE_AUTHORITY_IMPORT_QUEUE');
+    $owner ||= $e->requestor->id;
+
+    if ($e->search_vandelay_bib_queue({name => $name, owner => $owner, queue_type => $type})->[0]) {
+        $e->rollback;
+        return OpenILS::Event->new('AUTH_QUEUE_EXISTS') 
+    }
+
+    my $queue = new Fieldmapper::vandelay::authority_queue();
+    $queue->name( $name );
+    $queue->owner( $owner );
+    $queue->queue_type( $type ) if ($type);
+
+    my $new_q = $e->create_vandelay_authority_queue( $queue );
+    $e->die_event unless ($new_q);
+    $e->commit;
+
+    return $new_q;
+}
+__PACKAGE__->register_method(  
+    api_name   => "open-ils.vandelay.authority_queue.create",
+    method     => "create_auth_queue",
+    api_level  => 1,
+    argc       => 3,
+);                      
+
+sub add_record_to_bib_queue {
+    my $self = shift;
+    my $client = shift;
+    my $auth = shift;
+    my $queue = shift;
+    my $marc = shift;
+    my $purpose = shift;
+    my $bib_source = shift;
+
+    my $e = new_editor(authtoken => $auth, xact => 1);
+
+    $queue = $e->retrieve_vandelay_bib_queue($queue);
+
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless
+        ($e->allowed('CREATE_BIB_IMPORT_QUEUE', undef, $queue) ||
+         $e->allowed('CREATE_BIB_IMPORT_QUEUE'));
+
+    my $new_rec = _add_bib_rec($e, $marc, $queue->id, $purpose, $bib_source);
+
+    return $e->die_event unless ($new_rec);
+    $e->commit;
+    return $new_rec;
+}
+__PACKAGE__->register_method(  
+    api_name   => "open-ils.vandelay.queued_bib_record.create",
+    method     => "add_record_to_bib_queue",
+    api_level  => 1,
+    argc       => 3,
+);                      
+
+sub _add_bib_rec {
+    my $e = shift;
+    my $marc = shift;
+    my $queue = shift;
+    my $purpose = shift;
+    my $bib_source = shift;
+
+    my $rec = new Fieldmapper::vandelay::queued_bib_record();
+    $rec->marc( $marc );
+    $rec->queue( $queue );
+    $rec->purpose( $purpose ) if ($purpose);
+    $rec->bib_source($bib_source);
+
+    return $e->create_vandelay_queued_bib_record( $rec );
+}
+
+sub add_record_to_authority_queue {
+    my $self = shift;
+    my $client = shift;
+    my $auth = shift;
+    my $queue = shift;
+    my $marc = shift;
+    my $purpose = shift;
+
+    my $e = new_editor(authtoken => $auth, xact => 1);
+
+    $queue = $e->retrieve_vandelay_authority_queue($queue);
+
+    return $e->die_event unless $e->checkauth;
+    return $e->die_event unless
+        ($e->allowed('CREATE_AUTHORITY_IMPORT_QUEUE', undef, $queue) ||
+         $e->allowed('CREATE_AUTHORITY_IMPORT_QUEUE'));
+
+    my $new_rec = _add_auth_rec($e, $marc, $queue->id, $purpose);
+
+    return $e->die_event unless ($new_rec);
+    $e->commit;
+    return $new_rec;
+}
+__PACKAGE__->register_method(
+    api_name   => "open-ils.vandelay.queued_authority_record.create",
+    method     => "add_record_to_authority_queue",
+    api_level  => 1,
+    argc       => 3,
+);
+
+sub _add_auth_rec {
+    my $e = shift;
+    my $marc = shift;
+    my $queue = shift;
+    my $purpose = shift;
+
+    my $rec = new Fieldmapper::vandelay::queued_authority_record();
+    $rec->marc( $marc );
+    $rec->queue( $queue );
+    $rec->purpose( $purpose ) if ($purpose);
+
+    return $e->create_vandelay_queued_authority_record( $rec );
+}
+
+sub process_spool {
+    my $self = shift;
+    my $client = shift;
+    my $auth = shift;
+    my $fingerprint = shift || '';
+    my $queue_id = shift;
+    my $purpose = shift;
+    my $filename = shift;
+    my $bib_source = shift;
+
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+
+    my $queue;
+    my $type = $self->{record_type};
+
+    if($type eq 'bib') {
+        $queue = $e->retrieve_vandelay_bib_queue($queue_id) or return $e->die_event;
+    } else {
+        $queue = $e->retrieve_vandelay_authority_queue($queue_id) or return $e->die_event;
+    }
+
+    my $evt = check_queue_perms($e, $type, $queue);
+    return $evt if ($evt);
+
+    my $cache = new OpenSRF::Utils::Cache();
+
+    if($fingerprint) {
+        my $data = $cache->get_cache('vandelay_import_spool_' . $fingerprint);
+        $purpose = $data->{purpose};
+        $filename = $data->{path};
+        $bib_source = $data->{bib_source};
+    }
+
+    unless(-r $filename) {
+        $logger->error("unable to read MARC file $filename");
+        return -1; # make this an event XXX
+    }
+
+    $logger->info("vandelay spooling $fingerprint purpose=$purpose file=$filename");
+
+    my $marctype = 'USMARC'; 
+
+    open F, $filename;
+    $marctype = 'XML' if (getc(F) =~ /^\D/o);
+    close F;
+
+    my $batch = new MARC::Batch ($marctype, $filename);
+    $batch->strict_off;
+
+    my $response_scale = 10;
+    my $count = 0;
+    my $r = -1;
+    while (try { $r = $batch->next } otherwise { $r = -1 }) {
+        if ($r == -1) {
+            $logger->warn("Processing of record $count in set $filename failed.  Skipping this record");
+            $count++;
+        }
+
+        $logger->info("processing record $count");
+
+        try {
+            (my $xml = $r->as_xml_record()) =~ s/\n//sog;
+            $xml =~ s/^<\?xml.+\?\s*>//go;
+            $xml =~ s/>\s+entityize($xml);
+            $xml =~ s/[\x00-\x1f]//go;
+
+            my $qrec;
+            # Check the leader to ensure we've got something resembling the expected
+            # Allow spaces to give records the benefit of the doubt
+            my $ldr_type = substr($r->leader(), 6, 1);
+            if ($type eq 'bib' && ($record_types{$ldr_type}) eq 'bib' || $ldr_type eq ' ') {
+                $qrec = _add_bib_rec( $e, $xml, $queue_id, $purpose, $bib_source ) or return $e->die_event;
+            } elsif ($type eq 'auth' && ($record_types{$ldr_type}) eq 'auth' || $ldr_type eq ' ') {
+                $qrec = _add_auth_rec( $e, $xml, $queue_id, $purpose ) or return $e->die_event;
+            } else {
+                # I don't know how to handle this type; rock on
+                $logger->error("In process_spool(), type was $type and leader type was $ldr_type ; not currently supported");
+                next;
+            }
+
+            if($self->api_name =~ /stream_results/ and $qrec) {
+                $client->respond($qrec->id)
+            } else {
+                $client->respond($count) if (++$count % $response_scale) == 0;
+                $response_scale *= 10 if ($count == ($response_scale * 10));
+            }
+        } catch Error with {
+            my $error = shift;
+            $logger->warn("Encountered a bad record at Vandelay ingest: ".$error);
+        }
+    }
+
+    $e->commit;
+    unlink($filename);
+    $cache->delete_cache('vandelay_import_spool_' . $fingerprint) if $fingerprint;
+    return $count;
+}
+
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.bib.process_spool",
+    method      => "process_spool",
+    api_level   => 1,
+    argc        => 3,
+    max_chunk_size => 0,
+    record_type => 'bib'
+);                      
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.auth.process_spool",
+    method      => "process_spool",
+    api_level   => 1,
+    argc        => 3,
+    max_chunk_size => 0,
+    record_type => 'auth'
+);                      
+
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.bib.process_spool.stream_results",
+    method      => "process_spool",
+    api_level   => 1,
+    argc        => 3,
+    stream      => 1,
+    max_chunk_size => 0,
+    record_type => 'bib'
+);                      
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.auth.process_spool.stream_results",
+    method      => "process_spool",
+    api_level   => 1,
+    argc        => 3,
+    stream      => 1,
+    max_chunk_size => 0,
+    record_type => 'auth'
+);
+
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.bib_queue.records.retrieve",
+    method      => 'retrieve_queued_records',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    record_type => 'bib'
+);
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.auth_queue.records.retrieve",
+    method      => 'retrieve_queued_records',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    record_type => 'auth'
+);
+
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.bib_queue.records.matches.retrieve",
+    method      => 'retrieve_queued_records',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    record_type => 'bib',
+    signature   => {
+        desc => q/Only retrieve queued bib records that have matches against existing records/
+    }
+);
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.auth_queue.records.matches.retrieve",
+    method      => 'retrieve_queued_records',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    record_type => 'auth',
+    signature   => {
+        desc => q/Only retrieve queued authority records that have matches against existing records/
+    }
+
+);
+
+sub retrieve_queued_records {
+    my($self, $conn, $auth, $queue_id, $options) = @_;
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+    $options ||= {};
+    my $limit = $$options{limit} || 20;
+    my $offset = $$options{offset} || 0;
+
+    my $type = $self->{record_type};
+    my $queue;
+    if($type eq 'bib') {
+        $queue = $e->retrieve_vandelay_bib_queue($queue_id) or return $e->die_event;
+    } else {
+        $queue = $e->retrieve_vandelay_authority_queue($queue_id) or return $e->die_event;
+    }
+    my $evt = check_queue_perms($e, $type, $queue);
+    return $evt if ($evt);
+
+    my $class = ($type eq 'bib') ? 'vqbr' : 'vqar';
+    my $search = ($type eq 'bib') ? 
+        'search_vandelay_queued_bib_record' : 'search_vandelay_queued_authority_record';
+    my $retrieve = ($type eq 'bib') ? 
+        'retrieve_vandelay_queued_bib_record' : 'retrieve_vandelay_queued_authority_record';
+
+    my $filter = ($$options{non_imported}) ? {import_time => undef} : {};
+
+    my $record_ids;
+    if($self->api_name =~ /matches/) {
+        # fetch only matched records
+        $record_ids = queued_records_with_matches($e, $type, $queue_id, $limit, $offset, $filter);
+    } else {
+        # fetch all queue records
+        $record_ids = $e->$search([
+                {queue => $queue_id, %$filter}, 
+                {order_by => {$class => 'id'}, limit => $limit, offset => $offset}
+            ],
+            {idlist => 1}
+        );
+    }
+
+
+    for my $rec_id (@$record_ids) {
+        my $params = {   
+            flesh => 1,
+            flesh_fields => {$class => ['attributes', 'matches']},
+        };
+        my $rec = $e->$retrieve([$rec_id, $params]);
+        $rec->clear_marc if $$options{clear_marc};
+        $conn->respond($rec);
+    }
+    $e->rollback;
+    return undef;
+}
+
+sub check_queue_perms {
+    my($e, $type, $queue) = @_;
+    if ($type eq 'bib') {
+        return $e->die_event unless
+            ($e->allowed('CREATE_BIB_IMPORT_QUEUE', undef, $queue) ||
+             $e->allowed('CREATE_BIB_IMPORT_QUEUE'));
+    } else {
+        return $e->die_event unless
+            ($e->allowed('CREATE_AUTHORITY_IMPORT_QUEUE', undef, $queue) ||
+             $e->allowed('CREATE_AUTHORITY_IMPORT_QUEUE'));
+    }
+
+    return undef;
+}
+
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.bib_record.list.import",
+    method      => 'import_record_list',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    record_type => 'bib'
+);
+
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.auth_record.list.import",
+    method      => 'import_record_list',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    record_type => 'auth'
+);
+
+sub import_record_list {
+    my($self, $conn, $auth, $rec_ids, $args) = @_;
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+    $args ||= {};
+    my $err = import_record_list_impl($self, $conn, $rec_ids, $e->requestor, $args);
+    $e->rollback;
+    return $err if $err;
+    return {complete => 1};
+}
+
+
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.bib_queue.import",
+    method      => 'import_queue',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    max_chunk_size => 0,
+    record_type => 'bib'
+);
+
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.auth_queue.import",
+    method      => 'import_queue',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    max_chunk_size => 0,
+    record_type => 'auth'
+);
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.bib_queue.nomatch.import",
+    method      => 'import_queue',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    signature   => {
+        desc => q/Only import records that have no collisions/
+    },
+    max_chunk_size => 0,
+    record_type => 'bib'
+);
+
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.auth_queue.nomatch.import",
+    method      => 'import_queue',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    signature   => {
+        desc => q/Only import records that have no collisions/
+    },
+    max_chunk_size => 0,
+    record_type => 'auth'
+);
+sub import_queue {
+    my($self, $conn, $auth, $q_id, $options) = @_;
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+    $options ||= {};
+    my $type = $self->{record_type};
+    my $class = ($type eq 'bib') ? 'vqbr' : 'vqar';
+
+    my $query = {queue => $q_id, import_time => undef};
+
+    if($self->api_name =~ /nomatch/) {
+        my $matched_recs = queued_records_with_matches($e, $type, $q_id, undef, undef, {import_time => undef});
+        $query->{id} = {'not in' => $matched_recs} if @$matched_recs;
+    }
+
+    my $search = ($type eq 'bib') ? 
+        'search_vandelay_queued_bib_record' : 'search_vandelay_queued_authority_record';
+    my $rec_ids = $e->$search($query, {idlist => 1});
+    my $err = import_record_list_impl($self, $conn, $rec_ids, $e->requestor, $options);
+    try {$e->rollback} otherwise {}; # only using this to make the read authoritative -- don't die from it
+    return $err if $err;
+    return {complete => 1};
+}
+
+# returns a list of queued record IDs for a given queue that 
+# have at least one entry in the match table
+sub queued_records_with_matches {
+    my($e, $type, $q_id, $limit, $offset, $filter) = @_;
+
+    my $match_class = 'vbm';
+    my $rec_class = 'vqbr';
+    if($type eq 'auth') {
+        $match_class = 'vam';
+         $rec_class = 'vqar';
+    }
+
+    $filter ||= {};
+    $filter->{queue} = $q_id;
+
+    my $query = {
+        distinct => 1, 
+        select => {$match_class => ['queued_record']}, 
+        from => {
+            $match_class => {
+                $rec_class => {
+                    field => 'id',
+                    fkey => 'queued_record',
+                    filter => $filter,
+                }
+            }
+        }
+    };        
+
+    if($limit or defined $offset) {
+        $limit ||= 20;
+        $offset ||= 0;
+        $query->{limit} = $limit;
+        $query->{offset} = $offset;
+    }
+
+    my $data = $e->json_query($query);
+    return [ map {$_->{queued_record}} @$data ];
+}
+
+sub import_record_list_impl {
+    my($self, $conn, $rec_ids, $requestor, $args) = @_;
+
+    my $overlay_map = $args->{overlay_map} || {};
+    my $type = $self->{record_type};
+    my $total = @$rec_ids;
+    my $count = 0;
+    my %queues;
+
+    my $step = 1;
+
+    my $auto_overlay_exact = $$args{auto_overlay_exact};
+    my $auto_overlay_1match = $$args{auto_overlay_1match};
+    my $merge_profile = $$args{merge_profile};
+    my $bib_source = $$args{bib_source};
+    my $report_all = $$args{report_all};
+
+    my $overlay_func = 'vandelay.overlay_bib_record';
+    my $auto_overlay_func = 'vandelay.auto_overlay_bib_record';
+    my $retrieve_func = 'retrieve_vandelay_queued_bib_record';
+    my $update_func = 'update_vandelay_queued_bib_record';
+    my $search_func = 'search_vandelay_queued_bib_record';
+    my $retrieve_queue_func = 'retrieve_vandelay_bib_queue';
+    my $update_queue_func = 'update_vandelay_bib_queue';
+    my $rec_class = 'vqbr';
+
+    my %bib_sources;
+    my $editor = new_editor();
+    my $sources = $editor->search_config_bib_source({id => {'!=' => undef}});
+
+    foreach my $src (@$sources) {
+        $bib_sources{$src->id} = $src->source;
+    }
+
+    if($type eq 'auth') {
+        $overlay_func =~ s/bib/auth/o;
+        $auto_overlay_func = s/bib/auth/o;
+        $retrieve_func =~ s/bib/authority/o;
+        $retrieve_queue_func =~ s/bib/authority/o;
+        $update_queue_func =~ s/bib/authority/o;
+        $update_func =~ s/bib/authority/o;
+        $search_func =~ s/bib/authority/o;
+        $rec_class = 'vqar';
+    }
+
+    my @success_rec_ids;
+    for my $rec_id (@$rec_ids) {
+
+        my $overlay_target = $overlay_map->{$rec_id};
+
+        my $error = 0;
+        my $e = new_editor(xact => 1);
+        $e->requestor($requestor);
+
+        my $rec = $e->$retrieve_func([
+            $rec_id,
+            {   flesh => 1,
+                flesh_fields => { $rec_class => ['matches']},
+            }
+        ]);
+
+        unless($rec) {
+            $conn->respond({total => $total, progress => ++$count, imported => $rec_id, err_event => $e->event});
+            $e->rollback;
+            next;
+        }
+
+        if($rec->import_time) {
+            $e->rollback;
+            next;
+        }
+
+        $queues{$rec->queue} = 1;
+
+        my $record;
+        my $imported = 0;
+
+        if(defined $overlay_target) {
+            # Caller chose an explicit overlay target
+
+            my $res = $e->json_query(
+                {
+                    from => [
+                        $overlay_func,
+                        $rec->id, 
+                        $overlay_target, 
+                        $merge_profile
+                    ]
+                }
+            );
+
+            if($res and ($res = $res->[0])) {
+
+                if($res->{$overlay_func} eq 't') {
+                    $logger->info("vl: $type direct overlay succeeded for queued rec " . 
+                        $rec->id . " and overlay target $overlay_target");
+                    $imported = 1;
+                }
+
+            } else {
+                $error = 1;
+                $logger->error("vl: Error attempting overlay with func=$overlay_func, profile=$merge_profile, record=$rec_id");
+            }
+
+        } else {
+
+            if($auto_overlay_1match) { 
+                # caller says to overlay if there is exactly 1 match
+
+                my %match_recs = map { $_->eg_record => 1 } @{$rec->matches};
+
+                if( scalar(keys %match_recs) == 1) { # all matches point to the same record
+
+                    my $res = $e->json_query(
+                        {
+                            from => [
+                                $overlay_func,
+                                $rec->id, 
+                                $rec->matches->[0]->eg_record,
+                                $merge_profile
+                            ]
+                        }
+                    );
+
+                    if($res and ($res = $res->[0])) {
+    
+                        if($res->{$overlay_func} eq 't') {
+                            $logger->info("vl: $type overlay-1match succeeded for queued rec " . $rec->id);
+                            $imported = 1;
+                        }
+
+                    } else {
+                        $error = 1;
+                        $logger->error("vl: Error attempting overlay with func=$overlay_func, profile=$merge_profile, record=$rec_id");
+                    }
+                }
+            }
+
+            if(!$imported and !$error and $auto_overlay_exact and scalar(@{$rec->matches}) == 1 ) {
+                
+                # caller says to overlay if there is an /exact/ match
+
+                my $res = $e->json_query(
+                    {
+                        from => [
+                            $auto_overlay_func,
+                            $rec->id, 
+                            $merge_profile
+                        ]
+                    }
+                );
+
+                if($res and ($res = $res->[0])) {
+
+                    if($res->{$auto_overlay_func} eq 't') {
+                        $logger->info("vl: $type auto-overlay succeeded for queued rec " . $rec->id);
+                        $imported = 1;
+                    }
+
+                } else {
+                    $error = 1;
+                    $logger->error("vl: Error attempting overlay with func=$auto_overlay_func, profile=$merge_profile, record=$rec_id");
+                }
+            }
+
+            if(!$imported and !$error) {
+            
+                # No overlay / merge occurred.  Do a traditional record import by creating a new record
+            
+                if($type eq 'bib') {
+                    $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import($e, $rec->marc, $bib_sources{$rec->bib_source});
+                } else {
+
+                    $record = OpenILS::Application::Cat::AuthCommon->import_authority_record($e, $rec->marc); #$source);
+                }
+
+                if($U->event_code($record)) {
+
+                    $e->event($record); 
+                    $e->rollback;
+
+                } else {
+
+                    $logger->info("vl: successfully imported new $type record");
+                    $rec->imported_as($record->id);
+                    $rec->import_time('now');
+
+                    $imported = 1 if $e->$update_func($rec);
+                }
+            }
+        }
+
+        if($imported) {
+            push @success_rec_ids, $rec_id;
+            $e->commit;
+        } else {
+            # Send an update whenever there's an error
+            $conn->respond({total => $total, progress => ++$count, imported => $rec_id, err_event => $e->event});
+        }
+
+        if($report_all or (++$count % $step) == 0) {
+            $conn->respond({total => $total, progress => $count, imported => $rec_id});
+            # report often at first, climb quickly, then hold steady
+            $step *= 2 unless $step == 256;
+        }
+    }
+
+    # see if we need to mark any queues as complete
+    for my $q_id (keys %queues) {
+
+    	my $e = new_editor(xact => 1);
+        my $remaining = $e->$search_func(
+            [{queue => $q_id, import_time => undef}, {limit =>1}], {idlist => 1});
+
+        unless(@$remaining) {
+            my $queue = $e->$retrieve_queue_func($q_id);
+
+            unless($U->is_true($queue->complete)) {
+                $queue->complete('t');
+                $e->$update_queue_func($queue) or return $e->die_event;
+                $e->commit;
+                next;
+            }
+        } 
+    	$e->rollback;
+    }
+
+    import_record_asset_list_impl($conn, \@success_rec_ids, $requestor);
+
+    $conn->respond({total => $total, progress => $count});
+    return undef;
+}
+
+
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.bib_queue.owner.retrieve",
+    method      => 'owner_queue_retrieve',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    record_type => 'bib'
+);
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.authority_queue.owner.retrieve",
+    method      => 'owner_queue_retrieve',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    record_type => 'auth'
+);
+
+sub owner_queue_retrieve {
+    my($self, $conn, $auth, $owner_id, $filters) = @_;
+    my $e = new_editor(authtoken => $auth, xact => 1);
+    return $e->die_event unless $e->checkauth;
+    $owner_id = $e->requestor->id; # XXX add support for viewing other's queues?
+    my $queues;
+    $filters ||= {};
+    my $search = {owner => $owner_id};
+    $search->{$_} = $filters->{$_} for keys %$filters;
+
+    if($self->{record_type} eq 'bib') {
+        $queues = $e->search_vandelay_bib_queue(
+            [$search, {order_by => {vbq => 'lower(name)'}}]);
+    } else {
+        $queues = $e->search_vandelay_authority_queue(
+            [$search, {order_by => {vaq => 'lower(name)'}}]);
+    }
+    $conn->respond($_) for @$queues;
+    $e->rollback;
+    return undef;
+}
+
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.bib_queue.delete",
+    method      => "delete_queue",
+    api_level   => 1,
+    argc        => 2,
+    record_type => 'bib'
+);            
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.auth_queue.delete",
+    method      => "delete_queue",
+    api_level   => 1,
+    argc        => 2,
+    record_type => 'auth'
+);  
+
+sub delete_queue {
+    my($self, $conn, $auth, $q_id) = @_;
+    my $e = new_editor(xact => 1, authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+    if($self->{record_type} eq 'bib') {
+        return $e->die_event unless $e->allowed('CREATE_BIB_IMPORT_QUEUE');
+        my $queue = $e->retrieve_vandelay_bib_queue($q_id)
+            or return $e->die_event;
+        $e->delete_vandelay_bib_queue($queue)
+            or return $e->die_event;
+    } else {
+           return $e->die_event unless $e->allowed('CREATE_AUTHORITY_IMPORT_QUEUE');
+        my $queue = $e->retrieve_vandelay_authority_queue($q_id)
+            or return $e->die_event;
+        $e->delete_vandelay_authority_queue($queue)
+            or return $e->die_event;
+    }
+    $e->commit;
+    return 1;
+}
+
+
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.queued_bib_record.html",
+    method      => 'queued_record_html',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    record_type => 'bib'
+);
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.queued_authority_record.html",
+    method      => 'queued_record_html',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    record_type => 'auth'
+);
+
+sub queued_record_html {
+    my($self, $conn, $auth, $rec_id) = @_;
+    my $e = new_editor(xact=>1,authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+    my $rec;
+    if($self->{record_type} eq 'bib') {
+        $rec = $e->retrieve_vandelay_queued_bib_record($rec_id)
+            or return $e->die_event;
+    } else {
+        $rec = $e->retrieve_vandelay_queued_authority_record($rec_id)
+            or return $e->die_event;
+    }
+
+    $e->rollback;
+    return $U->simplereq(
+        'open-ils.search',
+        'open-ils.search.biblio.record.html', undef, 1, $rec->marc);
+}
+
+
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.bib_queue.summary.retrieve", 
+    method      => 'retrieve_queue_summary',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    record_type => 'bib'
+);
+__PACKAGE__->register_method(  
+    api_name    => "open-ils.vandelay.auth_queue.summary.retrieve",
+    method      => 'retrieve_queue_summary',
+    api_level   => 1,
+    argc        => 2,
+    stream      => 1,
+    record_type => 'auth'
+);
+
+sub retrieve_queue_summary {
+    my($self, $conn, $auth, $queue_id) = @_;
+    my $e = new_editor(xact=>1, authtoken => $auth);
+    return $e->die_event unless $e->checkauth;
+
+    my $queue;
+    my $type = $self->{record_type};
+    if($type eq 'bib') {
+        $queue = $e->retrieve_vandelay_bib_queue($queue_id)
+            or return $e->die_event;
+    } else {
+        $queue = $e->retrieve_vandelay_authority_queue($queue_id)
+            or return $e->die_event;
+    }
+
+    my $evt = check_queue_perms($e, $type, $queue);
+    return $evt if $evt;
+
+    my $search = 'search_vandelay_queued_bib_record';
+    $search =~ s/bib/authority/ if $type ne 'bib';
+
+    return {
+        queue => $queue,
+        total => scalar(@{$e->$search({queue => $queue_id}, {idlist=>1})}),
+        imported => scalar(@{$e->$search({queue => $queue_id, import_time => {'!=' => undef}}, {idlist=>1})}),
+    };
+}
+
+# --------------------------------------------------------------------------------
+# Given a list of queued record IDs, imports all items attached to those records
+# --------------------------------------------------------------------------------
+sub import_record_asset_list_impl {
+    my($conn, $rec_ids, $requestor) = @_;
+
+    my $total = @$rec_ids;
+    my $try_count = 0;
+    my $in_count = 0;
+    my $roe = new_editor(xact=> 1, requestor => $requestor);
+
+    for my $rec_id (@$rec_ids) {
+        my $rec = $roe->retrieve_vandelay_queued_bib_record($rec_id);
+        next unless $rec and $rec->import_time;
+        my $item_ids = $roe->search_vandelay_import_item({record => $rec->id}, {idlist=>1});
+
+        for my $item_id (@$item_ids) {
+            my $e = new_editor(requestor => $requestor, xact => 1);
+            my $item = $e->retrieve_vandelay_import_item($item_id);
+            $try_count++;
+
+            # --------------------------------------------------------------------------------
+            # Find or create the volume
+            # --------------------------------------------------------------------------------
+            my ($vol, $evt) =
+                OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
+                    $e, $item->call_number, $rec->imported_as, $item->owning_lib);
+
+            if($evt) {
+                respond_with_status($conn, $total, $try_count, $in_count, $evt);
+                next;
+            }
+
+            # --------------------------------------------------------------------------------
+            # Create the new copy
+            # --------------------------------------------------------------------------------
+            my $copy = Fieldmapper::asset::copy->new;
+            $copy->loan_duration(2);
+            $copy->fine_level(2);
+            $copy->barcode($item->barcode);
+            $copy->location($item->location);
+            $copy->circ_lib($item->circ_lib || $item->owning_lib);
+            $copy->status($item->status || OILS_COPY_STATUS_IN_PROCESS);
+            $copy->circulate($item->circulate);
+            $copy->deposit($item->deposit);
+            $copy->deposit_amount($item->deposit_amount);
+            $copy->ref($item->ref);
+            $copy->holdable($item->holdable);
+            $copy->price($item->price);
+            $copy->circ_as_type($item->circ_as_type);
+            $copy->alert_message($item->alert_message);
+            $copy->opac_visible($item->opac_visible);
+            $copy->circ_modifier($item->circ_modifier);
+
+            # --------------------------------------------------------------------------------
+            # see if a valid circ_modifier was provided
+            # --------------------------------------------------------------------------------
+            #if($copy->circ_modifier and not $e->retrieve_config_circ_modifier($item->circ_modifier)) {
+            if($copy->circ_modifier and not $e->search_config_circ_modifier({code=>$item->circ_modifier})->[0]) {
+                respond_with_status($conn, $total, $try_count, $in_count, $e->die_event);
+                next;
+            }
+
+            if($evt = OpenILS::Application::Cat::AssetCommon->create_copy($e, $vol, $copy)) {
+                try { $e->rollback } otherwise {}; # sometimes calls die_event, sometimes not
+                respond_with_status($conn, $total, $try_count, $in_count, $evt);
+                next;
+            }
+
+            # --------------------------------------------------------------------------------
+            # create copy notes
+            # --------------------------------------------------------------------------------
+            $evt = OpenILS::Application::Cat::AssetCommon->create_copy_note(
+                $e, $copy, '', $item->pub_note, 1) if $item->pub_note;
+
+            if($evt) {
+                respond_with_status($conn, $total, $try_count, $in_count, $evt);
+                next;
+            }
+
+            $evt = OpenILS::Application::Cat::AssetCommon->create_copy_note(
+                $e, $copy, '', $item->priv_note, 1) if $item->priv_note;
+
+            if($evt) {
+                respond_with_status($conn, $total, $try_count, $in_count, $evt);
+                next;
+            }
+
+            # --------------------------------------------------------------------------------
+            # Item import succeeded
+            # --------------------------------------------------------------------------------
+            $e->commit;
+            respond_with_status($conn, $total, $try_count, ++$in_count, undef, imported_as => $copy->id);
+        }
+    }
+    $roe->rollback;
+    return undef;
+}
+
+
+sub respond_with_status {
+    my($conn, $total, $try_count, $success_count, $err, %args) = @_;
+    $conn->respond({
+        total => $total, 
+        progress => $try_count, 
+        err_event => $err, 
+        success_count => $success_count, %args }) if $err or ($try_count % 5 == 0);
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Const.pm b/Open-ILS/src/perlmods/lib/OpenILS/Const.pm
new file mode 100644
index 0000000000..281f465bd0
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Const.pm
@@ -0,0 +1,131 @@
+package OpenILS::Const;
+use strict; use warnings;
+use vars qw(@EXPORT_OK %EXPORT_TAGS);
+use Exporter;
+use base qw/Exporter/;
+
+
+# ---------------------------------------------------------------------
+# Shoves defined constants into the export array
+# so they don't have to be listed twice in the code
+# ---------------------------------------------------------------------
+sub econst {
+   my($name, $value) = @_;
+   my $caller = caller;
+   no strict;
+   *{$name} = sub () { $value };
+   push @{$caller.'::EXPORT_OK'}, $name;
+}
+
+# ---------------------------------------------------------------------
+# CONSTANTS
+# ---------------------------------------------------------------------
+
+
+
+# ---------------------------------------------------------------------
+# Copy Statuses
+# ---------------------------------------------------------------------
+econst OILS_COPY_STATUS_AVAILABLE     => 0;
+econst OILS_COPY_STATUS_CHECKED_OUT   => 1;
+econst OILS_COPY_STATUS_BINDERY       => 2;
+econst OILS_COPY_STATUS_LOST          => 3;
+econst OILS_COPY_STATUS_MISSING       => 4;
+econst OILS_COPY_STATUS_IN_PROCESS    => 5;
+econst OILS_COPY_STATUS_IN_TRANSIT    => 6;
+econst OILS_COPY_STATUS_RESHELVING    => 7;
+econst OILS_COPY_STATUS_ON_HOLDS_SHELF=> 8;
+econst OILS_COPY_STATUS_ON_ORDER	     => 9;
+econst OILS_COPY_STATUS_ILL           => 10;
+econst OILS_COPY_STATUS_CATALOGING    => 11;
+econst OILS_COPY_STATUS_RESERVES      => 12;
+econst OILS_COPY_STATUS_DISCARD       => 13;
+econst OILS_COPY_STATUS_DAMAGED       => 14;
+econst OILS_COPY_STATUS_ON_RESV_SHELF => 15;
+
+
+# ---------------------------------------------------------------------
+# Circ defaults for pre-cataloged copies
+# ---------------------------------------------------------------------
+econst OILS_PRECAT_COPY_FINE_LEVEL    => 2;
+econst OILS_PRECAT_COPY_LOAN_DURATION => 2;
+econst OILS_PRECAT_CALL_NUMBER        => -1;
+econst OILS_PRECAT_RECORD			     => -1;
+
+
+# ---------------------------------------------------------------------
+# Circ constants
+# ---------------------------------------------------------------------
+econst OILS_CIRC_DURATION_SHORT       => 1;
+econst OILS_CIRC_DURATION_NORMAL      => 2;
+econst OILS_CIRC_DURATION_EXTENDED    => 3;
+econst OILS_REC_FINE_LEVEL_LOW        => 1;
+econst OILS_REC_FINE_LEVEL_NORMAL     => 2;
+econst OILS_REC_FINE_LEVEL_HIGH       => 3;
+econst OILS_STOP_FINES_CHECKIN        => 'CHECKIN';
+econst OILS_STOP_FINES_RENEW          => 'RENEW';
+econst OILS_STOP_FINES_LOST           => 'LOST';
+econst OILS_STOP_FINES_CLAIMSRETURNED => 'CLAIMSRETURNED';
+econst OILS_STOP_FINES_LONGOVERDUE    => 'LONGOVERDUE';
+econst OILS_STOP_FINES_MAX_FINES      => 'MAXFINES';
+econst OILS_STOP_FINES_CLAIMS_NEVERCHECKEDOUT => 'CLAIMSNEVERCHECKEDOUT';
+econst OILS_UNLIMITED_CIRC_DURATION   => 'unlimited';
+
+# ---------------------------------------------------------------------
+# Settings
+# ---------------------------------------------------------------------
+econst OILS_SETTING_LOST_PROCESSING_FEE => 'circ.lost_materials_processing_fee';
+econst OILS_SETTING_DEF_ITEM_PRICE => 'cat.default_item_price';
+econst OILS_SETTING_ORG_BOUNCED_EMAIL => 'org.bounced_emails';
+econst OILS_SETTING_CHARGE_LOST_ON_ZERO => 'circ.charge_lost_on_zero';
+econst OILS_SETTING_VOID_OVERDUE_ON_LOST => 'circ.void_overdue_on_lost';
+econst OILS_SETTING_HOLD_SOFT_STALL => 'circ.hold_stalling.soft';
+econst OILS_SETTING_HOLD_HARD_STALL => 'circ.hold_stalling.hard';
+econst OILS_SETTING_HOLD_SOFT_BOUNDARY => 'circ.hold_boundary.soft';
+econst OILS_SETTING_HOLD_HARD_BOUNDARY => 'circ.hold_boundary.hard';
+econst OILS_SETTING_HOLD_EXPIRE => 'circ.hold_expire_interval';
+econst OILS_SETTING_HOLD_ESIMATE_WAIT_INTERVAL => 'circ.holds.default_estimated_wait_interval';
+econst OILS_SETTING_VOID_LOST_ON_CHECKIN                => 'circ.void_lost_on_checkin';
+econst OILS_SETTING_MAX_ACCEPT_RETURN_OF_LOST           => 'circ.max_accept_return_of_lost';
+econst OILS_SETTING_VOID_LOST_PROCESS_FEE_ON_CHECKIN    => 'circ.void_lost_proc_fee_on_checkin';
+econst OILS_SETTING_RESTORE_OVERDUE_ON_LOST_RETURN      => 'circ.restore_overdue_on_lost_return';
+econst OILS_SETTING_LOST_IMMEDIATELY_AVAILABLE          => 'circ.lost_immediately_available';
+econst OILS_SETTING_BLOCK_HOLD_FOR_EXPIRED_PATRON       => 'circ.holds.expired_patron_block';
+
+
+
+
+econst OILS_HOLD_TYPE_COPY        => 'C';
+econst OILS_HOLD_TYPE_FORCE       => 'F';
+econst OILS_HOLD_TYPE_RECALL      => 'R';
+econst OILS_HOLD_TYPE_ISSUANCE    => 'I';
+econst OILS_HOLD_TYPE_VOLUME      => 'V';
+econst OILS_HOLD_TYPE_TITLE       => 'T';
+econst OILS_HOLD_TYPE_METARECORD  => 'M';
+
+
+econst OILS_BILLING_TYPE_OVERDUE_MATERIALS => 'Overdue materials';
+econst OILS_BILLING_TYPE_COLLECTION_FEE => 'Long Overdue Collection Fee';
+econst OILS_BILLING_TYPE_DEPOSIT => 'System: Deposit';
+econst OILS_BILLING_TYPE_RENTAL => 'System: Rental';
+econst OILS_BILLING_NOTE_SYSTEM => 'SYSTEM GENERATED';
+
+econst OILS_ACQ_DEBIT_TYPE_PURCHASE => 'purchase';
+econst OILS_ACQ_DEBIT_TYPE_TRANSFER => 'xfer';
+
+# all penalties with ID < 100 are managed automatically
+econst OILS_PENALTY_AUTO_ID => 100;
+econst OILS_PENALTY_PATRON_EXCEEDS_FINES => 1;
+econst OILS_PENALTY_PATRON_EXCEEDS_OVERDUE_COUNT => 2;
+econst OILS_PENALTY_INVALID_PATRON_ADDRESS => 29;
+
+
+econst OILS_BILLING_TYPE_NOTIFICATION_FEE => 9;
+
+
+
+# ---------------------------------------------------------------------
+# finally, export all the constants
+# ---------------------------------------------------------------------
+%EXPORT_TAGS = ( const => [ @EXPORT_OK ] );
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Event.pm b/Open-ILS/src/perlmods/lib/OpenILS/Event.pm
new file mode 100644
index 0000000000..805859d41a
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Event.pm
@@ -0,0 +1,91 @@
+package OpenILS::Event;
+# vim:noet:ts=4
+use strict; use warnings;
+use XML::LibXML;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Logger;
+my $logger = "OpenSRF::Utils::Logger";
+
+
+# Returns a new Event data hash (not a blessed object)
+# The first param is the event name
+# Following the first param is an optional hash of params:
+#		perm => the name of the permission error for permimssion errors
+#		permloc => the location of the permission error for permission errors
+#		payload => the payload to be returned on successfull events
+
+
+my $events = undef;
+my $descs  = undef;
+
+sub new {
+    my( $class, $event, %params ) = @_;
+    _load_events() unless $events;
+
+    throw OpenSRF::EX ("Bad event name: $event") unless $event;
+    my $e = $events->{$event};
+    $e = '' unless defined $e;
+
+    my(   $m,   $f,   $l ) = caller(0);
+    my(  $mm,  $ff,  $ll ) = caller(1);
+    my( $mmm, $fff, $lll ) = caller(2);
+
+    $f   ||= "";
+    $l   ||= "";
+    $ff  ||= "";
+    $ll  ||= "";
+    $fff ||= "";
+    $lll ||= "";
+
+    my $lang = 'en-US'; # assume english for now
+
+    my $t = CORE::localtime();
+
+    return { 
+        ilsevent   => $e, 
+        textcode   => $event, 
+        stacktrace => "$f:$l $ff:$ll $fff:$lll", 
+        desc       => $descs->{$lang}->{$e || ''} || '',
+        servertime => $t,
+        pid        => $$, %params
+    };
+}
+
+sub _load_events {
+	my $settings_client = OpenSRF::Utils::SettingsClient->new();
+	my $eventsxml =  $settings_client->config_value( "ils_events" );
+
+	if(!$eventsxml) { 
+		throw OpenSRF::EX ("No ils_events file found in settings config"); 
+	}
+
+	$logger->info("Loading events xml file $eventsxml");
+
+	my $doc = XML::LibXML->new->parse_file($eventsxml);
+
+	my @nodes = $doc->documentElement->findnodes('//event');
+	for my $node (@nodes) {
+		$events->{$node->getAttribute('textcode')} = 
+			$node->getAttribute('code');
+	}
+
+	$descs = {};
+	my @desc = $doc->documentElement->findnodes('//desc');
+	for my $d (@desc) {
+		my $lang = $d->getAttributeNS('http://www.w3.org/XML/1998/namespace', 'lang');
+		my $code = $d->parentNode->getAttribute('code');
+		unless ($descs && $lang && exists $descs->{$lang}) {
+			$descs->{$lang} = {};
+			if (!$descs) {
+				$logger->error("No error description nodes found in $eventsxml.");
+			}
+			if (!$lang) {
+				$logger->error("No xml:lang attribute found for node in $eventsxml.");
+			}
+		}
+		$descs->{$lang}->{$code} = $d->textContent;
+	}
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Perm.pm b/Open-ILS/src/perlmods/lib/OpenILS/Perm.pm
new file mode 100644
index 0000000000..0bfbeb7a5c
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Perm.pm
@@ -0,0 +1,23 @@
+package OpenILS::Perm;
+use strict; use warnings;
+use Template;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::EX qw(:try);
+use OpenSRF::AppSession;
+use OpenSRF::Utils::Logger;
+
+# ----------------------------------------------------------------------------------
+# These permission strings
+# ----------------------------------------------------------------------------------
+
+# returns a new fieldmapper::perm_ex
+my $logger = 'OpenSRF::Utils::Logger';
+
+sub new {
+	my($class, $type) = @_;
+	$logger->warn("Returning permission error: $type");
+	return bless( { ilsevent => 5000, ilsperm => $type }, 'OpenILS::Perm');
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Reporter/Proxy.pm b/Open-ILS/src/perlmods/lib/OpenILS/Reporter/Proxy.pm
new file mode 100644
index 0000000000..d70d359b31
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Reporter/Proxy.pm
@@ -0,0 +1,162 @@
+package OpenILS::Reporter::Proxy;
+use strict; use warnings;
+
+use Apache2::Log;
+use Apache2::Const -compile => qw(REDIRECT FORBIDDEN OK NOT_FOUND DECLINED :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use CGI;
+use Data::Dumper;
+use Digest::MD5 qw/md5_hex/;
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::System;
+
+
+# set the bootstrap config and template include directory when 
+# this module is loaded
+my $bootstrap;
+
+sub import {
+	my $self = shift;
+	$bootstrap = shift;
+}
+
+
+sub child_init {
+	OpenSRF::System->bootstrap_client( config_file => $bootstrap );
+}
+
+sub handler {
+	my $apache = shift;
+	my $cgi = new CGI;
+	my $auth_ses = $cgi->cookie('ses');
+	my $ws_ou = $cgi->cookie('ws_ou') || 1;
+
+	my $url = $cgi->url;
+
+	# push everyone to the secure site
+	if ($url =~ /^http:/o) {
+		$url =~ s/^http:/https:/o;
+		print "Location: $url\n\n";
+		return Apache2::Const::OK;
+	}
+
+	if (!$auth_ses) {
+		my $u = $cgi->param('user');
+		my $p = $cgi->param('passwd');
+
+		if (!$u) {
+
+			print $cgi->header(-type=>'text/html', -expires=>'-1d');
+			print <<"			HTML";
+
+
+	
+		Report Output Login
+	
+	
+		



+		

+		

+			
+				
+					
+				
+				
+					
+					
+				
+				
+					
+					
+				
+			
Please log in to view reports
Username or barcode:
Password:

+			
+		

+		

+	
+
+
+			HTML
+			return Apache2::Const::OK;
+		}
+
+		$auth_ses = oils_login($u, $p);
+		if ($auth_ses) {
+			print $cgi->redirect(
+				-uri=>$url,
+				-cookie=>$cgi->cookie(
+					-name=>'ses',
+					-value=>$auth_ses,
+					-path=>'/',-expires=>'+1h'
+				)
+			);
+			return Apache2::Const::REDIRECT;
+		}
+	}
+
+	my $user = verify_login($auth_ses);
+	return Apache2::Const::FORBIDDEN unless ($user);
+
+	my $failures = OpenSRF::AppSession
+		->create('open-ils.actor')
+		->request('open-ils.actor.user.perm.check', $auth_ses, $user->id, $ws_ou, ['VIEW_REPORT_OUTPUT'])
+		->gather(1);
+
+	return Apache2::Const::FORBIDDEN if (@$failures > 0);
+
+	# they're good, let 'em through
+	return Apache2::Const::DECLINED if (-e $apache->filename);
+
+	# oops, file not found
+	return Apache2::Const::NOT_FOUND;
+}
+
+# returns the user object if the session is valid, 0 otherwise
+sub verify_login {
+	my $auth_token = shift;
+	return undef unless $auth_token;
+
+	my $user = OpenSRF::AppSession
+		->create("open-ils.auth")
+		->request( "open-ils.auth.session.retrieve", $auth_token )
+		->gather(1);
+
+	if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) {
+		return undef;
+	}
+
+	return $user if ref($user);
+	return undef;
+}
+
+sub oils_login {
+        my( $username, $password, $type ) = @_;
+
+        $type |= "staff";
+	my $nametype = 'username';
+	$nametype = 'barcode' if ($username =~ /^\d+$/o);
+
+        my $seed = OpenSRF::AppSession
+		->create("open-ils.auth")
+		->request( 'open-ils.auth.authenticate.init', $username )
+		->gather(1);
+
+        return undef unless $seed;
+
+        my $response = OpenSRF::AppSession
+		->create("open-ils.auth")
+		->request( 'open-ils.auth.authenticate.complete',
+			{ $nametype => $username,
+			  password => md5_hex($seed . md5_hex($password)),
+			  type => $type })
+		->gather(1);
+
+        return undef unless $response;
+
+        return $response->{payload}->{authtoken};
+}
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Reporter/SQLBuilder.pm b/Open-ILS/src/perlmods/lib/OpenILS/Reporter/SQLBuilder.pm
new file mode 100644
index 0000000000..637cbc50d8
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Reporter/SQLBuilder.pm
@@ -0,0 +1,1243 @@
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder;
+
+sub new {
+	my $class = shift;
+	$class = ref($class) || $class;
+
+	return bless { _sql => undef } => $class;
+}
+
+sub register_params {
+	my $self  = shift;
+	my $p = shift;
+	$self->{_params} = $p;
+}
+
+sub get_param {
+	my $self = shift;
+	my $p = shift;
+	return $self->{_builder}->{_params}->{$p};
+}
+
+sub set_builder {
+	my $self = shift;
+	$self->{_builder} = shift;
+	return $self;
+}
+
+sub builder {
+	my $self = shift;
+	return $self->{_builder};
+}
+
+sub relative_time {
+	my $self = shift;
+	my $t = shift;
+	$self->builder->{_relative_time} = $t if (defined $t);
+	return $self->builder->{_relative_time};
+}
+
+sub resolve_param {
+	my $self = shift;
+	my $val = shift;
+
+	if (defined($val) && $val =~ /^::(.+)$/o) {
+		$val = $self->get_param($1);
+	}
+
+	if (defined($val) && !ref($val)) {
+		$val =~ s/\\/\\\\/go;
+		$val =~ s/"/\\"/go;
+	}
+
+	return $val;
+}
+
+sub parse_report {
+	my $self = shift;
+	my $report = shift;
+
+	my $rs = OpenILS::Reporter::SQLBuilder::ResultSet->new;
+
+	if (!$report->{order_by} || @{$report->{order_by}} == 0) {
+		$report->{order_by} = $report->{select};
+	}
+
+	$rs->is_subquery( 1 ) if ( $report->{alias} );
+
+	$rs	->set_builder( $self )
+		->set_subquery_alias( $report->{alias} )
+		->set_select( $report->{select} )
+		->set_from( $report->{from} )
+		->set_where( $report->{where} )
+		->set_having( $report->{having} )
+		->set_order_by( $report->{order_by} )
+		->set_pivot_data( $report->{pivot_data} )
+		->set_pivot_label( $report->{pivot_label} )
+		->set_pivot_default( $report->{pivot_default} );
+
+	return $rs;
+}
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::ResultSet;
+use base qw/OpenILS::Reporter::SQLBuilder/;
+
+sub is_subquery {
+	my $self = shift;
+	my $flag = shift;
+	$self->{_is_subquery} = $flag if (defined $flag);
+	return $self->{_is_subquery};
+}
+
+sub pivot_data {
+	my $self = shift;
+	return $self->builder->{_pivot_data};
+}
+
+sub pivot_label {
+	my $self = shift;
+	return $self->builder->{_pivot_label};
+}
+
+sub pivot_default {
+	my $self = shift;
+	return $self->builder->{_pivot_default};
+}
+
+sub set_pivot_default {
+	my $self = shift;
+	my $p = shift;
+	$self->builder->{_pivot_default} = $p if (defined $p);
+	return $self;
+}
+
+sub set_pivot_data {
+	my $self = shift;
+	my $p = shift;
+	$self->builder->{_pivot_data} = $p if (defined $p);
+	return $self;
+}
+
+sub set_pivot_label {
+	my $self = shift;
+	my $p = shift;
+	$self->builder->{_pivot_label} = $p if (defined $p);
+	return $self;
+}
+
+sub set_subquery_alias {
+	my $self = shift;
+	my $alias = shift;
+	$self->{_alias} = $alias if (defined $alias);
+	return $self;
+}
+
+sub set_select {
+	my $self = shift;
+	my @cols = @_;
+
+	$self->{_select} = [];
+
+	return $self unless (@cols && defined($cols[0]));
+	@cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY');
+
+	push @{ $self->{_select} }, map { OpenILS::Reporter::SQLBuilder::Column::Select->new( $_ )->set_builder( $self->builder ) } @cols;
+
+	return $self;
+}
+
+sub set_from {
+	my $self = shift;
+	my $f = shift;
+
+	$self->{_from} = OpenILS::Reporter::SQLBuilder::Relation->parse( $f, $self->builder );
+
+	return $self;
+}
+
+sub set_where {
+	my $self = shift;
+	my @cols = @_;
+
+	$self->{_where} = [];
+
+	return $self unless (@cols && defined($cols[0]));
+	@cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY');
+
+	push @{ $self->{_where} }, map { OpenILS::Reporter::SQLBuilder::Column::Where->new( $_ )->set_builder( $self->builder ) } @cols;
+
+	return $self;
+}
+
+sub set_having {
+	my $self = shift;
+	my @cols = @_;
+
+	$self->{_having} = [];
+
+	return $self unless (@cols && defined($cols[0]));
+	@cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY');
+
+	push @{ $self->{_having} }, map { OpenILS::Reporter::SQLBuilder::Column::Having->new( $_ )->set_builder( $self->builder ) } @cols;
+
+	return $self;
+}
+
+sub set_order_by {
+	my $self = shift;
+	my @cols = @_;
+
+	$self->{_order_by} = [];
+
+	return $self unless (@cols && defined($cols[0]));
+	@cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY');
+
+	push @{ $self->{_order_by} }, map { OpenILS::Reporter::SQLBuilder::Column::OrderBy->new( $_ )->set_builder( $self->builder ) } @cols;
+
+	return $self;
+}
+
+sub column_label_list {
+	my $self = shift;
+
+	my @labels;
+	push @labels, $self->resolve_param( $_->{_alias} ) for ( @{ $self->{_select} } );
+	return @labels;
+}
+
+sub group_by_list {
+	my $self = shift;
+	my $base = shift;
+	$base = 1 unless (defined $base);
+
+	my $seen_label = 0;
+	my $gcount = $base;
+	my @group_by;
+	for my $c ( @{ $self->{_select} } ) {
+		if ($base == 0 && !$seen_label  && defined($self->pivot_label) && $gcount == $self->pivot_label - 1) {
+			$seen_label++;
+			next;
+		}
+		push @group_by, $gcount if (!$c->is_aggregate);
+		$gcount++;
+	}
+
+	return @group_by;
+}
+
+sub toSQL {
+	my $self = shift;
+
+	return $self->{_sql} if ($self->{_sql});
+
+	my $sql = '';
+
+	if ($self->is_subquery) {
+		$sql = '(';
+	}
+
+	$sql .= "SELECT\t" . join(",\n\t", map { $_->toSQL } @{ $self->{_select} }) . "\n" if (@{ $self->{_select} });
+	$sql .= "  FROM\t" . $self->{_from}->toSQL . "\n" if ($self->{_from});
+	$sql .= "  WHERE\t" . join("\n\tAND ", map { $_->toSQL } @{ $self->{_where} }) . "\n" if (@{ $self->{_where} });
+
+	my @group_by = $self->group_by_list;
+
+	$sql .= '  GROUP BY ' . join(', ', @group_by) . "\n" if (@group_by);
+	$sql .= "  HAVING " . join("\n\tAND ", map { $_->toSQL } @{ $self->{_having} }) . "\n" if (@{ $self->{_having} });
+	$sql .= '  ORDER BY ' . join(', ', map { $_->toSQL } @{ $self->{_order_by} }) . "\n" if (@{ $self->{_order_by} });
+
+	if ($self->is_subquery) {
+		$sql .= ') '. $self->{_alias} . "\n";
+	}
+
+	return $self->{_sql} = $sql;
+}
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Input;
+use base qw/OpenILS::Reporter::SQLBuilder/;
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::new;
+
+	my $col_data = shift;
+
+	if (ref($col_data)) {
+		$self->{params} = $col_data->{params};
+		my $trans = $col_data->{transform} || 'Bare';
+		my $pkg = "OpenILS::Reporter::SQLBuilder::Input::Transform::$trans";
+		if (UNIVERSAL::can($pkg => 'toSQL')) {
+			$self->{_transform} = $trans;
+		} else {
+			$self->{_transform} = 'GenericTransform';
+		}
+	} elsif( defined($col_data) ) {
+		$self->{_transform} = 'Bare';
+		$self->{params} = $col_data;
+	} else {
+		$self->{_transform} = 'NULL';
+	}
+
+
+
+	return $self;
+}
+
+sub toSQL {
+	my $self = shift;
+	my $type = $self->{_transform};
+	return $self->{_sql} if ($self->{_sql});
+	my $toSQL = "OpenILS::Reporter::SQLBuilder::Input::Transform::${type}::toSQL";
+	return $self->{_sql} = $self->$toSQL;
+}
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Input::Transform::GenericTransform;
+
+sub toSQL {
+	my $self = shift;
+	my $func = $self->{transform};
+
+	my @params;
+	@params = @{ $self->{params} } if ($self->{params});
+
+	my $sql = $func . '(\'';
+	$sql .= join("','", @params) if (@params);
+	$sql .= '\')';
+
+	return $sql;
+}
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Input::Transform::NULL;
+
+sub toSQL {
+	return "NULL";
+}
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Input::Transform::Bare;
+
+sub toSQL {
+	my $self = shift;
+
+	my $val = $self->{params};
+	$val = $$val[0] if (ref($val));
+	
+	$val =~ s/\\/\\\\/go;
+	$val =~ s/'/\\'/go;
+
+	return "'$val'";
+}
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Input::Transform::age;
+
+sub toSQL {
+	my $self = shift;
+
+	my $val = $self->{params};
+	$val = $$val[0] if (ref($val));
+
+	$val =~ s/\\/\\\\/go;
+	$val =~ s/'/\\'/go;
+
+	return "AGE(NOW(),'" . $val . "'::TIMESTAMPTZ)";
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Input::Transform::relative_year;
+
+sub toSQL {
+	my $self = shift;
+
+	my $rtime = $self->relative_time || 'now';
+
+	$rtime =~ s/\\/\\\\/go;
+	$rtime =~ s/'/\\'/go;
+
+	my $val = $self->{params};
+	$val = $$val[0] if (ref($val));
+
+	$val =~ s/\\/\\\\/go;
+	$val =~ s/'/\\'/go;
+
+	return "EXTRACT(YEAR FROM '$rtime'::TIMESTAMPTZ + '$val years')";
+}
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Input::Transform::relative_month;
+
+sub toSQL {
+	my $self = shift;
+
+	my $rtime = $self->relative_time || 'now';
+
+	$rtime =~ s/\\/\\\\/go;
+	$rtime =~ s/'/\\'/go;
+
+	my $val = $self->{params};
+	$val = $$val[0] if (ref($val));
+
+	$val =~ s/\\/\\\\/go;
+	$val =~ s/'/\\'/go;
+
+	return "EXTRACT(YEAR FROM '$rtime'::TIMESTAMPTZ + '$val months')" .
+		" || '-' || LPAD(EXTRACT(MONTH FROM '$rtime'::TIMESTAMPTZ + '$val months')::text,2,'0')";
+}
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Input::Transform::relative_date;
+
+sub toSQL {
+	my $self = shift;
+
+	my $rtime = $self->relative_time || 'now';
+
+	$rtime =~ s/\\/\\\\/go;
+	$rtime =~ s/'/\\'/go;
+
+	my $val = $self->{params};
+	$val = $$val[0] if (ref($val));
+
+	$val =~ s/\\/\\\\/go;
+	$val =~ s/'/\\'/go;
+
+	return "DATE('$rtime'::TIMESTAMPTZ + '$val days')";
+}
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Input::Transform::relative_week;
+
+sub toSQL {
+	my $self = shift;
+
+	my $rtime = $self->relative_time || 'now';
+
+	$rtime =~ s/\\/\\\\/go;
+	$rtime =~ s/'/\\'/go;
+
+	my $val = $self->{params};
+	$val = $$val[0] if (ref($val));
+
+	$val =~ s/\\/\\\\/go;
+	$val =~ s/'/\\'/go;
+
+	return "EXTRACT(WEEK FROM '$rtime'::TIMESTAMPTZ + '$val weeks')";
+}
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column;
+use base qw/OpenILS::Reporter::SQLBuilder/;
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::new;
+
+	my $col_data = shift;
+	$self->{_relation} = $col_data->{relation};
+	$self->{_column} = $col_data->{column};
+
+	$self->{_aggregate} = $col_data->{aggregate};
+
+	if (ref($self->{_column})) {
+		my $trans = $self->{_column}->{transform} || 'Bare';
+		my $pkg = "OpenILS::Reporter::SQLBuilder::Column::Transform::$trans";
+		if (UNIVERSAL::can($pkg => 'toSQL')) {
+			$self->{_transform} = $trans;
+		} else {
+			$self->{_transform} = 'GenericTransform';
+		}
+	} elsif( defined($self->{_column}) ) {
+		$self->{_transform} = 'Bare';
+	} else {
+		$self->{_transform} = 'NULL';
+	}
+
+
+	return $self;
+}
+
+sub find_relation {
+	my $self = shift;
+	return $self->builder->{_rels}->{$self->{_relation}};
+}
+
+sub name {
+	my $self = shift;
+	if (ref($self->{_column})) {
+		 return $self->{_column}->{colname};
+	} else {
+		return $self->{_column};
+	}
+}
+
+sub toSQL {
+	my $self = shift;
+	my $type = $self->{_transform};
+	return $self->{_sql} if ($self->{_sql});
+	my $toSQL = "OpenILS::Reporter::SQLBuilder::Column::Transform::${type}::toSQL";
+	return $self->{_sql} = $self->$toSQL;
+}
+
+sub is_aggregate {
+	my $self = shift;
+	my $type = $self->{_transform};
+	my $is_agg = "OpenILS::Reporter::SQLBuilder::Column::Transform::${type}::is_aggregate";
+	return $self->$is_agg;
+}
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::OrderBy;
+use base qw/OpenILS::Reporter::SQLBuilder::Column/;
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::new(@_);
+
+	my $col_data = shift;
+	$self->{_direction} = $col_data->{direction} || 'ascending';
+	return $self;
+}
+
+sub toSQL {
+	my $self = shift;
+	my $dir = ($self->{_direction} =~ /^d/oi) ? 'DESC' : 'ASC';
+	return $self->{_sql} if ($self->{_sql});
+	return $self->{_sql} = $self->SUPER::toSQL .  " $dir";
+}
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Select;
+use base qw/OpenILS::Reporter::SQLBuilder::Column/;
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::new(@_);
+
+	my $col_data = shift;
+	$self->{_alias} = $col_data->{alias} || $self->name;
+	return $self;
+}
+
+sub toSQL {
+	my $self = shift;
+	return $self->{_sql} if ($self->{_sql});
+	return $self->{_sql} = $self->SUPER::toSQL .  ' AS "' . $self->resolve_param( $self->{_alias} ) . '"';
+}
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::GenericTransform;
+
+sub toSQL {
+	my $self = shift;
+	my $name = $self->name;
+	my $func = $self->{_column}->{transform};
+
+	my @params;
+	@params = @{ $self->resolve_param( $self->{_column}->{params} ) } if ($self->{_column}->{params});
+
+	my $sql = $func . '("' . $self->{_relation} . '"."' . $self->name . '"';
+	$sql .= ",'" . join("','", @params) . "'" if (@params);
+	$sql .= ')';
+
+	return $sql;
+}
+
+sub is_aggregate { return $self->{_aggregate} }
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::Bare;
+
+sub toSQL {
+	my $self = shift;
+	return '"' . $self->{_relation} . '"."' . $self->name . '"';
+}
+
+sub is_aggregate { return 0 }
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::upper;
+
+sub toSQL {
+	my $self = shift;
+	my $params = $self->resolve_param( $self->{_column}->{params} );
+	my $start = $$params[0];
+	my $len = $$params[1];
+	return 'UPPER("' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::lower;
+
+sub toSQL {
+	my $self = shift;
+	my $params = $self->resolve_param( $self->{_column}->{params} );
+	my $start = $$params[0];
+	my $len = $$params[1];
+	return 'LOWER("' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::substring;
+
+sub toSQL {
+	my $self = shift;
+	my $params = $self->resolve_param( $self->{_column}->{params} );
+	my $start = $$params[0];
+	my $len = $$params[1];
+	return 'SUBSTRING("' . $self->{_relation} . '"."' . $self->name . "\",$start,$len)";
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::day_name;
+
+sub toSQL {
+	my $self = shift;
+	return 'TO_CHAR("' . $self->{_relation} . '"."' . $self->name . '", \'Day\')';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::month_name;
+
+sub toSQL {
+	my $self = shift;
+	return 'TO_CHAR("' . $self->{_relation} . '"."' . $self->name . '", \'Month\')';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::doy;
+
+sub toSQL {
+	my $self = shift;
+	return 'EXTRACT(DOY FROM "' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::woy;
+
+sub toSQL {
+	my $self = shift;
+	return 'EXTRACT(WEEK FROM "' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::moy;
+
+sub toSQL {
+	my $self = shift;
+	return 'EXTRACT(MONTH FROM "' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::qoy;
+
+sub toSQL {
+	my $self = shift;
+	return 'EXTRACT(QUARTER FROM "' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::dom;
+
+sub toSQL {
+	my $self = shift;
+	return 'EXTRACT(DAY FROM "' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::dow;
+
+sub toSQL {
+	my $self = shift;
+	return 'EXTRACT(DOW FROM "' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::year_trunc;
+
+sub toSQL {
+	my $self = shift;
+	return 'EXTRACT(YEAR FROM "' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::month_trunc;
+
+sub toSQL {
+	my $self = shift;
+	return 'EXTRACT(YEAR FROM "' . $self->{_relation} . '"."' . $self->name . '")' .
+		' || \'-\' || LPAD(EXTRACT(MONTH FROM "' . $self->{_relation} . '"."' . $self->name . '")::text,2,\'0\')';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::date_trunc;
+
+sub toSQL {
+	my $self = shift;
+	return 'DATE("' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::hour_trunc;
+
+sub toSQL {
+	my $self = shift;
+	return 'EXTRACT(HOUR FROM "' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::quarter;
+
+sub toSQL {
+	my $self = shift;
+	return 'EXTRACT(YEAR FROM "' . $self->{_relation} . '"."' . $self->name . '")' .
+		' || \'-Q\' || EXTRACT(QUARTER FROM "' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::months_ago;
+
+sub toSQL {
+	my $self = shift;
+	return 'EXTRACT(MONTH FROM AGE(NOW(),"' . $self->{_relation} . '"."' . $self->name . '"))';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::hod;
+
+sub toSQL {
+	my $self = shift;
+	return 'EXTRACT(HOUR FROM "' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::quarters_ago;
+
+sub toSQL {
+	my $self = shift;
+	return 'EXTRACT(QUARTER FROM AGE(NOW(),"' . $self->{_relation} . '"."' . $self->name . '"))';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::age;
+
+sub toSQL {
+	my $self = shift;
+	return 'AGE(NOW(),"' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 0 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::first;
+
+sub toSQL {
+	my $self = shift;
+	return 'FIRST("' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 1 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::last;
+
+sub toSQL {
+	my $self = shift;
+	return 'LAST("' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 1 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::min;
+
+sub toSQL {
+	my $self = shift;
+	return 'MIN("' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 1 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::max;
+
+sub toSQL {
+	my $self = shift;
+	return 'MAX("' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 1 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::count;
+
+sub toSQL {
+	my $self = shift;
+	return 'COUNT("' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 1 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::count_distinct;
+
+sub toSQL {
+	my $self = shift;
+	return 'COUNT(DISTINCT "' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 1 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::sum;
+
+sub toSQL {
+	my $self = shift;
+	return 'SUM("' . $self->{_relation} . '"."' . $self->name . '")';
+}
+
+sub is_aggregate { return 1 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Transform::average;
+
+sub toSQL {
+	my $self = shift;
+	return 'AVG("' . $self->{_relation} . '"."' . $self->name .  '")';
+}
+
+sub is_aggregate { return 1 }
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Where;
+use base qw/OpenILS::Reporter::SQLBuilder::Column/;
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::new(@_);
+
+	my $col_data = shift;
+	$self->{_condition} = $col_data->{condition};
+
+	return $self;
+}
+
+sub _flesh_conditions {
+	my $cond = shift;
+	my $builder = shift;
+	$cond = [$cond] unless (ref($cond) eq 'ARRAY');
+
+	my @out;
+	for my $c (@$cond) {
+		push @out, OpenILS::Reporter::SQLBuilder::Input->new( $c )->set_builder( $builder );
+	}
+
+	return \@out;
+}
+
+sub toSQL {
+	my $self = shift;
+
+	return $self->{_sql} if ($self->{_sql});
+
+	my $sql = '';
+
+	my $rel = $self->find_relation();
+	if ($rel && $rel->is_nullable) {
+		$sql = "((". $self->SUPER::toSQL .") IS NULL OR ";
+	}
+
+	$sql .= $self->SUPER::toSQL;
+
+	my ($op) = keys %{ $self->{_condition} };
+	my $val = _flesh_conditions( $self->resolve_param( $self->{_condition}->{$op} ), $self->builder );
+
+	if (lc($op) eq 'in') {
+		$sql .= " IN (". join(",", map { $_->toSQL } @$val).")";
+
+	} elsif (lc($op) eq 'not in') {
+		$sql .= " NOT IN (". join(",", map { $_->toSQL } @$val).")";
+
+	} elsif (lc($op) eq '= any') {
+		$val = $$val[0] if (ref($val) eq 'ARRAY');
+		$val = $val->toSQL;
+		if ($rel && $rel->is_nullable) { # need to redo this
+		    $sql = "((". $self->SUPER::toSQL .") IS NULL OR ";
+		} else {
+		    $sql = '';
+		}
+		$sql .= "$val = ANY (".$self->SUPER::toSQL.")";
+
+	} elsif (lc($op) eq '<> any') {
+		$val = $$val[0] if (ref($val) eq 'ARRAY');
+		$val = $val->toSQL;
+		if ($rel && $rel->is_nullable) { # need to redo this
+		    $sql = "((". $self->SUPER::toSQL .") IS NULL OR ";
+		} else {
+		    $sql = '';
+		}
+		$sql .= "$val <> ANY (".$self->SUPER::toSQL.")";
+
+	} elsif (lc($op) eq 'is blank') {
+		if ($rel && $rel->is_nullable) { # need to redo this
+		    $sql = "((". $self->SUPER::toSQL .") IS NULL OR ";
+		} else {
+		    $sql = '';
+		}
+		$sql .= '('. $self->SUPER::toSQL ." IS NULL OR ". $self->SUPER::toSQL ." = '')";
+
+	} elsif (lc($op) eq 'is not blank') {
+		if ($rel && $rel->is_nullable) { # need to redo this
+		    $sql = "((". $self->SUPER::toSQL .") IS NULL OR ";
+		} else {
+		    $sql = '';
+		}
+		$sql .= '('. $self->SUPER::toSQL ." IS NOT NULL AND ". $self->SUPER::toSQL ." <> '')";
+
+	} elsif (lc($op) eq 'between') {
+		$sql .= " BETWEEN ". join(" AND ", map { $_->toSQL } @$val);
+
+	} elsif (lc($op) eq 'not between') {
+		$sql .= " NOT BETWEEN ". join(" AND ", map { $_->toSQL } @$val);
+
+	} elsif (lc($op) eq 'like') {
+		$val = $$val[0] if (ref($val) eq 'ARRAY');
+		$val = $val->toSQL;
+		$val =~ s/^'(.*)'$/$1/o;
+		$val =~ s/%/\\\\%/o;
+		$val =~ s/_/\\\\_/o;
+		$sql .= " LIKE '\%$val\%'";
+
+	} elsif (lc($op) eq 'ilike') {
+		$val = $$val[0] if (ref($val) eq 'ARRAY');
+		$val = $val->toSQL;
+		$val =~ s/^'(.*)'$/$1/o;
+		$val =~ s/%/\\\\%/o;
+		$val =~ s/_/\\\\_/o;
+		$sql .= " ILIKE '\%$val\%'";
+
+	} else {
+		$val = $$val[0] if (ref($val) eq 'ARRAY');
+		$sql .= " $op " . $val->toSQL;
+	}
+
+	if ($rel && $rel->is_nullable) {
+		$sql .= ")";
+	}
+
+	return $self->{_sql} = $sql;
+}
+
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Column::Having;
+use base qw/OpenILS::Reporter::SQLBuilder::Column::Where/;
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Relation;
+use base qw/OpenILS::Reporter::SQLBuilder/;
+
+sub parse {
+	my $self = shift;
+	$self = $self->SUPER::new if (!ref($self));
+
+	my $rel_data = shift;
+	my $b = shift;
+	$self->set_builder($b);
+
+	$self->{_table} = $rel_data->{table};
+	$self->{_alias} = $rel_data->{alias} || $self->{_table};
+	$self->{_join} = [];
+	$self->{_columns} = [];
+
+	$self->builder->{_rels}{$self->{_alias}} = $self;
+
+	if ($rel_data->{join}) {
+		$self->add_join(
+			$_ => OpenILS::Reporter::SQLBuilder::Relation->parse( $rel_data->{join}->{$_}, $b ) => $rel_data->{join}->{$_}->{key} => $rel_data->{join}->{$_}->{type}
+		) for ( keys %{ $rel_data->{join} } );
+	}
+
+	return $self;
+}
+
+sub add_column {
+	my $self = shift;
+	my $col = shift;
+	
+	push @{ $self->{_columns} }, $col;
+}
+
+sub find_column {
+	my $self = shift;
+	my $col = shift;
+	return (grep { $_->name eq $col} @{ $self->{_columns} })[0];
+}
+
+sub add_join {
+	my $self = shift;
+	my $col = shift;
+	my $frel = shift;
+	my $fkey = shift;
+	my $type = lc(shift()) || 'inner';
+
+	if (UNIVERSAL::isa($col,'OpenILS::Reporter::SQLBuilder::Join')) {
+		push @{ $self->{_join} }, $col;
+	} else {
+		push @{ $self->{_join} }, OpenILS::Reporter::SQLBuilder::Join->build( $self => $col, $frel => $fkey, $type );
+	}
+
+	return $self;
+}
+
+sub is_nullable {
+	my $self = shift;
+	return $self->{_nullable};
+}
+
+sub is_join {
+	my $self = shift;
+	my $j = shift;
+	$self->{_is_join} = $j if ($j);
+	return $self->{_is_join};
+}
+
+sub join_type {
+	my $self = shift;
+	my $j = shift;
+	$self->{_join_type} = $j if ($j);
+	return $self->{_join_type};
+}
+
+sub toSQL {
+	my $self = shift;
+	return $self->{_sql} if ($self->{_sql});
+
+	my $sql = $self->{_table} .' AS "'. $self->{_alias} .'"';
+
+	if (!$self->is_join) {
+		for my $j ( @{ $self->{_join} } ) {
+			$sql .= $j->toSQL;
+		}
+	}
+
+	return $self->{_sql} = $sql;
+}
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Join;
+use base qw/OpenILS::Reporter::SQLBuilder/;
+
+sub build {
+	my $class = shift;
+	my $self = $class->SUPER::new if (!ref($class));
+
+	$self->{_left_rel} = shift;
+	($self->{_left_col}) = split(/-/,shift());
+
+	$self->{_right_rel} = shift;
+	$self->{_right_col} = shift;
+
+	$self->{_join_type} = shift;
+
+	$self->{_right_rel}->set_builder($self->{_left_rel}->builder);
+
+	$self->{_right_rel}->is_join(1);
+	$self->{_right_rel}->join_type($self->{_join_type});
+
+	bless $self => "OpenILS::Reporter::SQLBuilder::Join::$self->{_join_type}";
+
+	if ( $self->{_join_type} eq 'inner' or !$self->{_join_type}) {
+		$self->{_join_type} = 'i';
+	} else {
+		if ($self->{_join_type} eq 'left') {
+			$self->{_right_rel}->{_nullable} = 'l';
+		} elsif ($self->{_join_type} eq 'right') {
+			$self->{_left_rel}->{_nullable} = 'r';
+		} else {
+			$self->{_right_rel}->{_nullable} = 'f';
+			$self->{_left_rel}->{_nullable} = 'f';
+		}
+	}
+
+	return $self;
+}
+
+sub toSQL {
+	my $self = shift;
+	my $dir = shift;
+
+	my $sql = "JOIN " . $self->{_right_rel}->toSQL .
+		' ON ("' . $self->{_left_rel}->{_alias} . '"."' . $self->{_left_col} .
+		'" = "' . $self->{_right_rel}->{_alias} . '"."' . $self->{_right_col} . '")';
+
+	$sql .= $_->toSQL($dir) for (@{ $self->{_right_rel}->{_join} });
+
+	return $sql;
+}
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Join::left;
+use base qw/OpenILS::Reporter::SQLBuilder::Join/;
+
+sub toSQL {
+	my $self = shift;
+	my $dir = shift;
+	#return $self->{_sql} if ($self->{_sql});
+
+	my $j = $dir && $dir eq 'r' ? 'FULL OUTER' : 'LEFT OUTER';
+
+	my $sql = "\n\t$j ". $self->SUPER::toSQL('l');
+
+	#$sql .= $_->toSQL for (@{ $self->{_right_rel}->{_join} });
+
+	return $self->{_sql} = $sql;
+}
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Join::right;
+use base qw/OpenILS::Reporter::SQLBuilder::Join/;
+
+sub toSQL {
+	my $self = shift;
+	my $dir = shift;
+	#return $self->{_sql} if ($self->{_sql});
+
+	my $_nullable_rel = $dir && $dir eq 'l' ? '_right_rel' : '_left_rel';
+	$self->{_left_rel}->{_nullable} = 'r';
+	$self->{$_nullable_rel}->{_nullable} = $dir;
+
+	my $j = $dir && $dir eq 'l' ? 'FULL OUTER' : 'RIGHT OUTER';
+
+	my $sql = "\n\t$j ". $self->SUPER::toSQL('r');
+
+	#$sql .= $_->toSQL for (@{ $self->{_right_rel}->{_join} });
+
+	return $self->{_sql} = $sql;
+}
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Join::inner;
+use base qw/OpenILS::Reporter::SQLBuilder::Join/;
+
+sub toSQL {
+	my $self = shift;
+	my $dir = shift;
+	#return $self->{_sql} if ($self->{_sql});
+
+	my $_nullable_rel = $dir && $dir eq 'l' ? '_right_rel' : '_left_rel';
+	$self->{$_nullable_rel}->{_nullable} = $dir;
+
+	my $j = $dir ? ( $dir eq 'l' ? 'LEFT OUTER' : ( $dir eq 'r' ? 'RIGHT OUTER' : 'FULL OUTER' ) ) : 'INNER';
+
+	my $sql = "\n\t$j ". $self->SUPER::toSQL;
+
+	#$sql .= $_->toSQL for (@{ $self->{_right_rel}->{_join} });
+
+	return $self->{_sql} = $sql;
+}
+
+#-------------------------------------------------------------------------------------------------
+package OpenILS::Reporter::SQLBuilder::Join::cross;
+use base qw/OpenILS::Reporter::SQLBuilder::Join/;
+
+sub toSQL {
+	my $self = shift;
+	#return $self->{_sql} if ($self->{_sql});
+
+	$self->{_right_rel}->{_nullable} = 'f';
+	$self->{_left_rel}->{_nullable} = 'f';
+
+	my $sql = "\n\tFULL OUTER ". $self->SUPER::toSQL('f');
+
+	#$sql .= $_->toSQL for (@{ $self->{_right_rel}->{_join} });
+
+	return $self->{_sql} = $sql;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/SIP.pm b/Open-ILS/src/perlmods/lib/OpenILS/SIP.pm
new file mode 100644
index 0000000000..fe312ffd2f
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/SIP.pm
@@ -0,0 +1,693 @@
+#
+# ILS.pm: Test ILS interface module
+#
+
+package OpenILS::SIP;
+use warnings; use strict;
+
+use Sys::Syslog qw(syslog);
+use Time::HiRes q/time/;
+
+use OpenILS::SIP::Item;
+use OpenILS::SIP::Patron;
+use OpenILS::SIP::Transaction;
+use OpenILS::SIP::Transaction::Checkout;
+use OpenILS::SIP::Transaction::Checkin;
+use OpenILS::SIP::Transaction::Renew;
+
+use OpenSRF::System;
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Application::AppUtils;
+use OpenSRF::Utils qw/:datetime/;
+use DateTime::Format::ISO8601;
+use Encode;
+use Unicode::Normalize;
+my $U = 'OpenILS::Application::AppUtils';
+
+my $editor;
+my $config;
+my $target_encoding;    # FIXME: this is configured at the institution level. 
+
+use Digest::MD5 qw(md5_hex);
+
+sub new {
+	my ($class, $institution, $login) = @_;
+	my $type = ref($class) || $class;
+	my $self = {};
+
+	$self->{login} = $login;
+
+	$config = $institution;
+	syslog("LOG_DEBUG", "OILS: new ILS '%s'", $institution->{id});
+	$self->{institution} = $institution;
+
+	my $bsconfig     = $institution->{implementation_config}->{bootstrap};
+	$target_encoding = $institution->{implementation_config}->{encoding} || 'ascii';
+
+	syslog('LOG_DEBUG', "OILS: loading bootstrap config: $bsconfig");
+	
+	local $/ = "\n";    # why?
+	OpenSRF::System->bootstrap_client(config_file => $bsconfig);
+	syslog('LOG_DEBUG', "OILS: bootstrap loaded..");
+
+	$self->{osrf_config} = OpenSRF::Utils::SettingsClient->new;
+
+	Fieldmapper->import($self->{osrf_config}->config_value('IDL'));
+
+	bless( $self, $type );
+
+	return undef unless 
+		$self->login( $login->{id}, $login->{password} );
+
+	return $self;
+}
+
+sub fetch_session {
+    my $self = shift;
+
+	my $ses = $U->simplereq( 
+		'open-ils.auth',
+		'open-ils.auth.session.retrieve',  $self->{authtoken});
+
+    return undef if $U->event_code($ses); # auth timed out
+    return $self->{login_session} = $ses;
+}
+
+sub verify_session {
+	my $self = shift;
+
+    return 1 if $self->fetch_session;
+
+    syslog('LOG_INFO', "OILS: Logging back after session timeout as user ".$self->{login}->{id});
+    return $self->login( $self->{login}->{id}, $self->{login}->{password} );
+}
+
+sub editor {
+	return $editor = make_editor();
+}
+
+sub config {
+	return $config;
+}
+
+sub get_option_value {
+    my($self, $option) = @_;
+    my $ops = $config->{implementation_config}->{options}->{option};
+    $ops = [$ops] unless ref $ops eq 'ARRAY';
+    my @vals = grep { $_->{name} eq $option } @$ops;
+    return @vals ? $vals[0]->{value} : undef;
+}
+
+
+# Creates the global editor object
+my $cstore_init = 1; # call init on first use
+sub make_editor {
+    OpenILS::Utils::CStoreEditor::init() if $cstore_init;
+    $cstore_init = 0;
+	return OpenILS::Utils::CStoreEditor->new;
+}
+
+=head2 clean_text(scalar)
+
+Evergreen uses the UTF8 encoding for everything from the database up. Perl
+doesn't know this, however, so we have to convince it to treat our UTF8 strings
+as UTF8 strings. This may enable OpenNCIP to correctly calculate the checksums
+for UTF8 text for SIP clients that support such modern options.
+
+The target encoding is set in the  element of the SIPServer.pm
+configuration file.
+
+=cut
+
+sub clean_text {
+    my $text = shift || '';
+
+    # Convert our incoming UTF8 data into Perl's internal string format
+
+    # Also convert to Normalization Form D, as the ASCII, iso-8859-1,
+    # and latin-1 encodings (at least) require this to substitute
+    # characters rather than simply returning a string truncated
+    # after the first non-ASCII character
+    $text = NFD(decode_utf8($text));
+
+    if ($target_encoding eq 'ascii') {
+
+        # Try to maintain a reasonable version of the content by
+        # stripping diacritics from the text, given that the SIP client
+        # wants just plain ASCII. This is the base requirement according
+        # to the SIP2 specification.
+
+        # Stripping the combining characters converts ""béè♁ts"
+        # into "bee?ts" instead of "b???ts" - better, eh?
+        $text =~ s/\pM+//og;
+    }
+
+    # Characters that cannot be represented in the target encoding will
+    # generally be replaced with a question mark (?) character.
+    $text = encode($target_encoding, $text);
+
+    return $text;
+}
+
+my %org_sn_cache;
+sub shortname_from_id {
+    my $id = shift or return;
+    return $id->shortname if ref $id;
+    return $org_sn_cache{$id} if $org_sn_cache{$id};
+    return $org_sn_cache{$id} = editor()->retrieve_actor_org_unit($id)->shortname;
+}
+sub patron_barcode_from_id {
+    my $id = shift or return;
+    return editor()->search_actor_card({ usr => $id, active => 't' })->[0]->barcode;
+}
+
+sub format_date {
+	my $class = shift;
+	my $date = shift;
+	my $type = shift || 'dob';
+
+	return "" unless $date;
+
+	$date = DateTime::Format::ISO8601->new->
+		parse_datetime(OpenSRF::Utils::cleanse_ISO8601($date));
+	my @time = localtime($date->epoch);
+
+	my $year   = $time[5]+1900;
+	my $mon    = $time[4]+1;
+	my $day    = $time[3];
+	my $hour   = $time[2];
+ 	my $minute = $time[1];
+ 	my $second = $time[0];
+  
+	$date = sprintf("%04d%02d%02d", $year, $mon, $day);
+
+ 	# Due dates need hyphen separators and time of day as well
+ 	if ($type eq 'due') {
+ 		$date = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year, $mon, $day, $hour, $minute, $second);
+ 	}
+
+	syslog('LOG_DEBUG', "OILS: formatted date [type=$type]: $date");
+	return $date;
+}
+
+
+
+sub login {
+	my( $self, $username, $password ) = @_;
+	syslog('LOG_DEBUG', "OILS: Logging in with username $username");
+
+	my $seed = $U->simplereq( 
+		'open-ils.auth',
+		'open-ils.auth.authenticate.init', $username );
+
+	my $response = $U->simplereq(
+		'open-ils.auth', 
+		'open-ils.auth.authenticate.complete', 
+		{	
+			username => $username, 
+			password => md5_hex($seed . md5_hex($password)), 
+			type     => 'opac',
+		}
+	);
+
+	if( my $code = $U->event_code($response) ) {
+		my $txt = $response->{textcode};
+		syslog('LOG_WARNING', "OILS: Login failed for $username.  $txt:$code");
+		return undef;
+	}
+
+	my $key = $response->{payload}->{authtoken};
+	syslog('LOG_INFO', "OILS: Login succeeded for $username : authkey = $key");
+
+    $self->fetch_session; # to cache the login
+
+	return $self->{authtoken} = $key;
+}
+
+
+sub find_patron {
+	my $self = shift;
+	return OpenILS::SIP::Patron->new(@_);
+}
+
+
+sub find_item {
+	my $self = shift;
+	return OpenILS::SIP::Item->new(@_);
+}
+
+
+sub institution {
+    my $self = shift;
+    return $self->{institution}->{id};  # consider making this return the whole institution
+}
+
+sub institution_id {
+    my $self = shift;
+    return $self->{institution}->{id};  # then use this for just the ID
+}
+
+sub supports {
+	my ($self, $op) = @_;
+	my ($i) = grep { $_->{name} eq $op }  
+		@{$config->{implementation_config}->{supports}->{item}};
+	return to_bool($i->{value});
+}
+
+sub check_inst_id {
+    my ($self, $id, $whence) = @_;
+    if ($id ne $self->{institution}->{id}) {
+        syslog("LOG_WARNING", "OILS: %s: received institution '%s', expected '%s'", $whence, $id, $self->{institution}->{id});
+        # Just an FYI check, we don't expect the user to change location from that in SIPconfig.xml
+    }
+}
+
+
+sub to_bool {
+    my $bool = shift;
+    # If it's defined, and matches a true sort of string, or is
+    # a non-zero number, then it's true.
+    defined($bool) or return;                   # false
+    ($bool =~ /true|y|yes/i) and return 1;      # true
+    return ($bool =~ /^\d+$/ and $bool != 0);   # true for non-zero numbers, false otherwise
+}
+
+sub checkout_ok {
+	return to_bool($config->{policy}->{checkout});
+}
+
+sub checkin_ok {
+	return to_bool($config->{policy}->{checkin});
+}
+
+sub renew_ok {
+	return to_bool($config->{policy}->{renew});
+}
+
+sub status_update_ok {
+	return to_bool($config->{policy}->{status_update});
+}
+
+sub offline_ok {
+	return to_bool($config->{policy}->{offline});
+}
+
+
+
+##
+## Checkout(patron_id, item_id, sc_renew):
+##    patron_id & item_id are the identifiers send by the terminal
+##    sc_renew is the renewal policy configured on the terminal
+## returns a status opject that can be queried for the various bits
+## of information that the protocol (SIP or NCIP) needs to generate
+## the response.
+##
+
+sub checkout {
+	my ($self, $patron_id, $item_id, $sc_renew) = @_;
+	$sc_renew = 0;
+
+	$self->verify_session;
+
+	syslog('LOG_DEBUG', "OILS: OpenILS::Checkout attempt: patron=$patron_id, item=$item_id");
+
+    my $xact   = OpenILS::SIP::Transaction::Checkout->new( authtoken => $self->{authtoken} );
+    my $patron = $self->find_patron($patron_id);
+    my $item   = $self->find_item($item_id);
+
+	$xact->patron($patron);
+	$xact->item($item);
+
+	if (!$patron) {
+		$xact->screen_msg("Invalid Patron Barcode '$patron_id'");
+		return $xact;
+	}
+
+	if (!$patron->charge_ok) {
+		$xact->screen_msg("Patron Blocked");
+		return $xact;
+	}
+
+	if( !$item ) {
+		$xact->screen_msg("Invalid Item Barcode: '$item_id'");
+		return $xact;
+	}
+
+	syslog('LOG_DEBUG', "OILS: OpenILS::Checkout data loaded OK, checking out...");
+
+	if ($item->{patron} && ($item->{patron} eq $patron_id)) {
+		syslog('LOG_INFO', "OILS: OpenILS::Checkout data loaded OK, doing renew...");
+		$sc_renew = 1;
+	} elsif ($item->{patron} && ($item->{patron} ne $patron_id)) {
+		# I can't deal with this right now
+		# XXX check in then check out?
+		$xact->screen_msg("Item checked out to another patron");
+		$xact->ok(0);
+	} 
+
+	$xact->do_checkout($sc_renew);
+	$xact->desensitize(!$item->magnetic);
+
+	if( $xact->ok ) {
+		#editor()->commit;
+		syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
+			"patron %s checkout %s succeeded", $patron_id, $item_id);
+	} else {
+		#editor()->xact_rollback;
+		syslog("LOG_DEBUG", "OILS: OpenILS::Checkout: " .
+			"patron %s checkout %s FAILED, rolling back xact...", $patron_id, $item_id);
+	}
+
+	return $xact;
+}
+
+
+sub checkin {
+	my ($self, $item_id, $inst_id, $trans_date, $return_date,
+        $current_loc, $item_props, $cancel) = @_;
+
+    my $start_time = time();
+
+	$self->verify_session;
+
+	syslog('LOG_DEBUG', "OILS: OpenILS::Checkin of item=$item_id (to $inst_id)");
+	
+    my $xact = OpenILS::SIP::Transaction::Checkin->new(authtoken => $self->{authtoken});
+    my $item = OpenILS::SIP::Item->new($item_id);
+
+    unless ( $xact->item($item) ) {
+        $xact->ok(0);
+        # $circ->alert(1); $circ->alert_type(99);
+        $xact->screen_msg("Invalid Item Barcode: '$item_id'");
+        syslog('LOG_INFO', "OILS: Checkin failed.  " . $xact->screen_msg() );
+        return $xact;
+    }
+
+	$xact->do_checkin( $self, $inst_id, $trans_date, $return_date, $current_loc, $item_props );
+	
+	if ($xact->ok) {
+        $xact->patron($self->find_patron(usr => $xact->{circ_user_id}, slim_user => 1)) if $xact->{circ_user_id};
+        delete $item->{patron};
+        delete $item->{due_date};
+        syslog('LOG_INFO', "OILS: Checkin succeeded");
+    } else {
+        syslog('LOG_WARNING', "OILS: Checkin failed");
+    }
+
+    syslog('LOG_INFO', "OILS: SIP Checkin request took %0.3f seconds", (time() - $start_time));
+	return $xact;
+}
+
+## If the ILS caches patron information, this lets it free it up.
+## Also, this could be used for centrally logging session duration.
+## We don't do anything with it.
+sub end_patron_session {
+    my ($self, $patron_id) = @_;
+    return (1, 'Thank you!', '');
+}
+
+
+#sub pay_fee {
+#    my ($self, $patron_id, $patron_pwd, $fee_amt, $fee_type,
+#	$pay_type, $fee_id, $trans_id, $currency) = @_;
+#    my $trans;
+#    my $patron;
+#
+#    $trans = new ILS::Transaction::FeePayment;
+#
+#    $patron = new ILS::Patron $patron_id;
+#
+#    $trans->transaction_id($trans_id);
+#    $trans->patron($patron);
+#    $trans->ok(1);
+#
+#    return $trans;
+#}
+#
+#sub add_hold {
+#    my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
+#	$expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
+#    my ($patron, $item);
+#    my $hold;
+#    my $trans;
+#
+#
+#    $trans = new ILS::Transaction::Hold;
+#
+#    # BEGIN TRANSACTION
+#    $patron = new ILS::Patron $patron_id;
+#    if (!$patron
+#	|| (defined($patron_pwd) && !$patron->check_password($patron_pwd))) {
+#	$trans->screen_msg("Invalid Patron.");
+#
+#	return $trans;
+#    }
+#
+#    $item = new ILS::Item ($item_id || $title_id);
+#    if (!$item) {
+#	$trans->screen_msg("No such item.");
+#
+#	# END TRANSACTION (conditionally)
+#	return $trans;
+#    } elsif ($item->fee && ($fee_ack ne 'Y')) {
+#	$trans->screen_msg = "Fee required to place hold.";
+#
+#	# END TRANSACTION (conditionally)
+#	return $trans;
+#    }
+#
+#    $hold = {
+#	item_id         => $item->id,
+#	patron_id       => $patron->id,
+#	expiration_date => $expiry_date,
+#	pickup_location => $pickup_location,
+#	hold_type       => $hold_type,
+#    };
+#
+#    $trans->ok(1);
+#    $trans->patron($patron);
+#    $trans->item($item);
+#    $trans->pickup_location($pickup_location);
+#
+#    push(@{$item->hold_queue}, $hold);
+#    push(@{$patron->{hold_items}}, $hold);
+#
+#
+#    # END TRANSACTION
+#    return $trans;
+#}
+#
+#sub cancel_hold {
+#    my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_;
+#    my ($patron, $item, $hold);
+#    my $trans;
+#
+#    $trans = new ILS::Transaction::Hold;
+#
+#    # BEGIN TRANSACTION
+#    $patron = new ILS::Patron $patron_id;
+#    if (!$patron) {
+#	$trans->screen_msg("Invalid patron barcode.");
+#
+#	return $trans;
+#    } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
+#	$trans->screen_msg('Invalid patron password.');
+#
+#	return $trans;
+#    }
+#
+#    $item = new ILS::Item ($item_id || $title_id);
+#    if (!$item) {
+#	$trans->screen_msg("No such item.");
+#
+#	# END TRANSACTION (conditionally)
+#	return $trans;
+#    }
+#
+#    # Remove the hold from the patron's record first
+#    $trans->ok($patron->drop_hold($item_id));
+#
+#    if (!$trans->ok) {
+#	# We didn't find it on the patron record
+#	$trans->screen_msg("No such hold on patron record.");
+#
+#	# END TRANSACTION (conditionally)
+#	return $trans;
+#    }
+#
+#    # Now, remove it from the item record.  If it was on the patron
+#    # record but not on the item record, we'll treat that as success.
+#    foreach my $i (0 .. scalar @{$item->hold_queue}) {
+#	$hold = $item->hold_queue->[$i];
+#
+#	if ($hold->{patron_id} eq $patron->id) {
+#	    # found it: delete it.
+#	    splice @{$item->hold_queue}, $i, 1;
+#	    last;
+#	}
+#    }
+#
+#    $trans->screen_msg("Hold Cancelled.");
+#    $trans->patron($patron);
+#    $trans->item($item);
+#
+#    return $trans;
+#}
+#
+#
+## The patron and item id's can't be altered, but the
+## date, location, and type can.
+#sub alter_hold {
+#    my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
+#	$expiry_date, $pickup_location, $hold_type, $fee_ack) = @_;
+#    my ($patron, $item);
+#    my $hold;
+#    my $trans;
+#
+#    $trans = new ILS::Transaction::Hold;
+#
+#    # BEGIN TRANSACTION
+#    $patron = new ILS::Patron $patron_id;
+#    if (!$patron) {
+#	$trans->screen_msg("Invalid patron barcode.");
+#
+#	return $trans;
+#    }
+#
+#    foreach my $i (0 .. scalar @{$patron->{hold_items}}) {
+#	$hold = $patron->{hold_items}[$i];
+#
+#	if ($hold->{item_id} eq $item_id) {
+#	    # Found it.  So fix it.
+#	    $hold->{expiration_date} = $expiry_date if $expiry_date;
+#	    $hold->{pickup_location} = $pickup_location if $pickup_location;
+#	    $hold->{hold_type} = $hold_type if $hold_type;
+#
+#	    $trans->ok(1);
+#	    $trans->screen_msg("Hold updated.");
+#	    $trans->patron($patron);
+#	    $trans->item(new ILS::Item $hold->{item_id});
+#	    last;
+#	}
+#    }
+#
+#    # The same hold structure is linked into both the patron's
+#    # list of hold items and into the queue of outstanding holds
+#    # for the item, so we don't need to search the hold queue for
+#    # the item, since it's already been updated by the patron code.
+#
+#    if (!$trans->ok) {
+#	$trans->screen_msg("No such outstanding hold.");
+#    }
+#
+#    return $trans;
+#}
+
+
+sub renew {
+	my ($self, $patron_id, $patron_pwd, $item_id, $title_id,
+		$no_block, $nb_due_date, $third_party, $item_props, $fee_ack) = @_;
+
+	$self->verify_session;
+
+	my $trans = OpenILS::SIP::Transaction::Renew->new( authtoken => $self->{authtoken} );
+	$trans->patron($self->find_patron($patron_id));
+	$trans->item($self->find_item($item_id));
+
+	if(!$trans->patron) {
+		$trans->screen_msg("Invalid patron barcode.");
+		$trans->ok(0);
+		return $trans;
+	}
+
+	if(!$trans->patron->renew_ok) {
+		$trans->screen_msg("Renewals not allowed.");
+		$trans->ok(0);
+		return $trans;
+	}
+
+	if(!$trans->item) {
+		if( $title_id ) {
+			$trans->screen_msg("Title ID renewal not supported.  Use item barcode.");
+		} else {
+			$trans->screen_msg("Invalid item barcode.");
+		}
+		$trans->ok(0);
+		return $trans;
+	}
+
+	if(!$trans->item->{patron} or 
+			$trans->item->{patron} ne $patron_id) {
+		$trans->screen_msg("Item not checked out to " . $trans->patron->name);
+		$trans->ok(0);
+		return $trans;
+	}
+
+	# Perform the renewal
+	$trans->do_renew();
+
+	$trans->desensitize(0);	# It's already checked out
+	$trans->item->{due_date} = $nb_due_date if $no_block eq 'Y';
+	$trans->item->{sip_item_properties} = $item_props if $item_props;
+
+	return $trans;
+}
+
+
+
+
+
+#
+#sub renew_all {
+#    my ($self, $patron_id, $patron_pwd, $fee_ack) = @_;
+#    my ($patron, $item_id);
+#    my $trans;
+#
+#    $trans = new ILS::Transaction::RenewAll;
+#
+#    $trans->patron($patron = new ILS::Patron $patron_id);
+#    if (defined $patron) {
+#	syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s",
+#	       $patron->name, $patron->renew_ok);
+#    } else {
+#	syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'",
+#	       $patron_id);
+#    }
+#
+#    if (!defined($patron)) {
+#	$trans->screen_msg("Invalid patron barcode.");
+#	return $trans;
+#    } elsif (!$patron->renew_ok) {
+#	$trans->screen_msg("Renewals not allowed.");
+#	return $trans;
+#    } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) {
+#	$trans->screen_msg("Invalid patron password.");
+#	return $trans;
+#    }
+#
+#    foreach $item_id (@{$patron->{items}}) {
+#	my $item = new ILS::Item $item_id;
+#
+#	if (!defined($item)) {
+#	    syslog("LOG_WARNING",
+#		   "renew_all: Invalid item id associated with patron '%s'",
+#		   $patron->id);
+#	    next;
+#	}
+#
+#	if (@{$item->hold_queue}) {
+#	    # Can't renew if there are outstanding holds
+#	    push @{$trans->unrenewed}, $item_id;
+#	} else {
+#	    $item->{due_date} = time + (14*24*60*60); # two weeks hence
+#	    push @{$trans->renewed}, $item_id;
+#	}
+#    }
+#
+#    $trans->ok(1);
+#
+#    return $trans;
+#}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/SIP/Item.pm b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Item.pm
new file mode 100644
index 0000000000..7eb815c9eb
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Item.pm
@@ -0,0 +1,515 @@
+package OpenILS::SIP::Item;
+use strict; use warnings;
+
+use Sys::Syslog qw(syslog);
+use Carp;
+
+use OpenILS::SIP;
+use OpenILS::SIP::Transaction;
+use OpenILS::Application::AppUtils;
+use OpenILS::Application::Circ::ScriptBuilder;
+# use Data::Dumper;
+use OpenILS::Const qw/:const/;
+use OpenSRF::Utils qw/:datetime/;
+use DateTime::Format::ISO8601;
+use OpenSRF::Utils::SettingsClient;
+my $U = 'OpenILS::Application::AppUtils';
+
+my %item_db;
+
+# 0 means read-only
+# 1 means read/write    Actually, gloves are off.  Set what you like.
+
+my %fields = (
+    id => 0,
+#   sip_media_type     => 0,
+    sip_item_properties => 0,
+#   magnetic_media     => 0,
+    permanent_location => 0,
+    current_location   => 0,
+#   print_line         => 1,
+#   screen_msg         => 1,
+#   itemnumber         => 0,
+#   biblionumber       => 0,
+    hold               => 0,
+    hold_patron_bcode  => 0,
+    hold_patron_name   => 0,
+    barcode            => 0,
+    onloan             => 0,
+    collection_code    => 0,
+    destination_loc    => 0,
+    call_number        => 0,
+    enumchron          => 0,
+    location           => 0,
+    author             => 0,
+    title              => 0,
+    copy               => 0,
+    volume             => 0,
+    record             => 0,
+    mods               => 0,
+);
+
+our $AUTOLOAD;
+sub DESTROY { } # keeps AUTOLOAD from catching inherent DESTROY calls
+
+sub AUTOLOAD {
+    my $self = shift;
+    my $class = ref($self) or croak "$self is not an object";
+    my $name = $AUTOLOAD;
+
+    $name =~ s/.*://;
+
+    unless (exists $fields{$name}) {
+        croak "Cannot access '$name' field of class '$class'";
+    }
+
+    if (@_) {
+        # $fields{$name} or croak "Field '$name' of class '$class' is READ ONLY.";  # nah, go ahead
+        return $self->{$name} = shift;
+    } else {
+        return $self->{$name};
+    }
+}
+
+
+sub new {
+    my ($class, $item_id) = @_;
+    my $type = ref($class) || $class;
+    my $self = bless( {}, $type );
+
+    syslog('LOG_DEBUG', "OILS: Loading item $item_id...");
+    return undef unless $item_id;
+
+    my $e = OpenILS::SIP->editor();
+
+    my $copy = $e->search_asset_copy(
+		[
+			{ barcode => $item_id, deleted => 'f' },
+			{
+				flesh => 3,
+				flesh_fields => {
+					acp => [ 'circ_lib', 'call_number', 'status' ],
+					acn => [ 'owning_lib', 'record' ],
+				}
+			}
+		]
+    )->[0];
+
+	if(!$copy) {
+		syslog("LOG_DEBUG", "OILS: Item '%s' : not found", $item_id);
+		return undef;
+	}
+
+    my $circ = $e->search_action_circulation([
+        {
+            target_copy => $copy->id,
+            stop_fines_time => undef, 
+            checkin_time => undef
+        },
+        {
+            flesh => 2,
+            flesh_fields => {
+                circ => ['usr'],
+                au => ['card']
+            }
+        }
+    ])->[0];
+
+    if($circ) {
+
+        my $user = $circ->usr;
+        my $bc = ($user->card) ? $user->card->barcode : '';
+        $self->{patron} = $bc;
+        $self->{patron_object} = $user;
+
+        syslog('LOG_DEBUG', "OILS: Open circulation exists on $item_id : user = $bc");
+    }
+
+    $self->{id}         = $item_id;
+    $self->{copy}       = $copy;
+    $self->{volume}     = $copy->call_number;
+    $self->{record}     = $copy->call_number->record;
+    $self->{call_number} = $copy->call_number->label;
+    $self->{mods}       = $U->record_to_mvr($self->{record}) if $self->{record}->marc;
+    $self->{transit}    = $self->fetch_transit;
+    $self->{hold}       = $self->fetch_hold;
+
+
+    # use the non-translated version of the copy location as the
+    # collection code, since it may be used for additional routing
+    # purposes by the SIP client.  Config option?
+    $self->{collection_code} = 
+        $e->retrieve_asset_copy_location([
+            $copy->location, {no_i18n => 1}])->name;
+
+
+    if($self->{transit}) {
+        $self->{destination_loc} = $self->{transit}->dest->shortname;
+
+    } elsif($self->{hold}) {
+        $self->{destination_loc} = $self->{hold}->pickup_lib->shortname;
+    }
+
+    syslog("LOG_DEBUG", "OILS: Item('$item_id'): found with title '%s'", $self->title_id);
+
+    my $config = OpenILS::SIP->config();    # FIXME : will not always match!
+    my $legacy = $config->{implementation_config}->{legacy_script_support} || undef;
+
+    if( defined $legacy ) {
+        $self->{legacy_script_support} = ($legacy =~ /t(rue)?/io) ? 1 : 0;
+        syslog("LOG_DEBUG", "legacy_script_support is set in SIP config: " . $self->{legacy_script_support});
+
+    } else {
+        my $lss = OpenSRF::Utils::SettingsClient->new->config_value(
+            apps         => 'open-ils.circ',
+            app_settings => 'legacy_script_support'
+        );
+        $self->{legacy_script_support} = ($lss =~ /t(rue)?/io) ? 1 : 0;
+        syslog("LOG_DEBUG", "legacy_script_support is set in SRF config: " . $self->{legacy_script_support});
+    }
+
+    return $self;
+}
+
+# fetch copy transit
+sub fetch_transit {
+    my $self = shift;
+    my $copy = $self->{copy} or return;
+    my $e = OpenILS::SIP->editor();
+
+    if ($copy->status->id == OILS_COPY_STATUS_IN_TRANSIT) {
+        my $transit = $e->search_action_transit_copy([
+            {
+                target_copy    => $copy->id,    # NOT barcode ($self->id)
+                dest_recv_time => undef
+            },
+            {
+                flesh => 1,
+                flesh_fields => {
+                    atc => ['dest']
+                }
+            }
+        ])->[0];
+
+        syslog('LOG_WARNING', "OILS: Item(".$copy->barcode.
+            ") status is In Transit, but no action.transit_copy found!") unless $transit;
+            
+        return $transit;
+    }
+    
+    return undef;
+}
+
+# fetch captured hold.
+# Assume transit has already beeen fetched
+sub fetch_hold {
+    my $self = shift;
+    my $copy = $self->{copy} or return;
+    my $e = OpenILS::SIP->editor();
+
+    if( ($copy->status->id == OILS_COPY_STATUS_ON_HOLDS_SHELF) ||
+        ($self->{transit} and $self->{transit}->copy_status == OILS_COPY_STATUS_ON_HOLDS_SHELF) ) {
+        # item has been captured for a hold
+
+        my $hold = $e->search_action_hold_request([
+            {
+                current_copy        => $copy->id,
+                capture_time        => {'!=' => undef},
+                cancel_time         => undef,
+                fulfillment_time    => undef
+            },
+            {
+                limit => 1,
+                flesh => 1,
+                flesh_fields => {
+                    ahr => ['pickup_lib']
+                }
+            }
+        ])->[0];
+
+        syslog('LOG_WARNING', "OILS: Item(".$copy->barcode.
+            ") is captured for a hold, but there is no matching hold request") unless $hold;
+
+        return $hold;
+    }
+
+    return undef;
+}
+
+sub run_attr_script {
+	my $self = shift;
+	return 1 if $self->{ran_script};
+	$self->{ran_script} = 1;
+
+    if($self->{legacy_script_support}){
+
+        syslog('LOG_DEBUG', "Legacy script support is ON");
+        my $config = OpenILS::SIP->config();
+        my $path               = $config->{implementation_config}->{scripts}->{path};
+        my $item_config_script = $config->{implementation_config}->{scripts}->{item_config};
+
+        $path = ref($path) eq 'ARRAY' ? $path : [$path];
+        my $path_str = join(", ", @$path);
+
+        syslog('LOG_DEBUG', "OILS: Script path = [$path_str], Item config script = $item_config_script");
+
+        my $runner = OpenILS::Application::Circ::ScriptBuilder->build({
+            copy   => $self->{copy},
+            editor => OpenILS::SIP->editor(),
+        });
+
+        $runner->add_path($_) for @$path;
+        $runner->load($item_config_script);
+
+        unless( $self->{item_config_result} = $runner->run ) {      # assignment, not comparison
+            $runner->cleanup;
+            warn "Item config script [$path_str : $item_config_script] failed to run: $@\n";
+            syslog('LOG_ERR', "OILS: Item config script [$path_str : $item_config_script] failed to run: $@");
+            return undef;
+        }
+
+        $runner->cleanup;
+
+    } else {
+
+        # use the in-db circ modifier configuration 
+        my $config = {magneticMedia => 'f', SIPMediaType => '001'};     # defaults
+        my $mod = $self->{copy}->circ_modifier;
+
+        if($mod) {
+            my $mod_obj = OpenILS::SIP->editor()->retrieve_config_circ_modifier($mod);
+            if($mod_obj) {
+                $config->{magneticMedia} = $mod_obj->magnetic_media;
+                $config->{SIPMediaType}  = $mod_obj->sip2_media_type;
+            }
+        }
+
+        $self->{item_config_result} = { item_config => $config };
+    }
+
+	return 1;
+}
+
+sub magnetic_media {
+    my $self = shift;
+    $self->magnetic(@_);
+}
+sub magnetic {
+    my $self = shift;
+    return 0 unless $self->run_attr_script;
+    my $mag = $self->{item_config_result}->{item_config}->{magneticMedia} || '';
+    syslog('LOG_DEBUG', "OILS: magnetic = $mag");
+    return ($mag and $mag =~ /t(rue)?/io) ? 1 : 0;
+}
+
+sub sip_media_type {
+    my $self = shift;
+    return 0 unless $self->run_attr_script;
+    my $media = $self->{item_config_result}->{item_config}->{SIPMediaType} || '';
+    syslog('LOG_DEBUG', "OILS: media type = $media");
+    return ($media) ? $media : '001';
+}
+
+sub title_id {
+    my $self = shift;
+    my $t =  ($self->{mods}) ? $self->{mods}->title : $self->{copy}->dummy_title;
+    return OpenILS::SIP::clean_text($t);
+}
+
+sub permanent_location {
+    my $self = shift;
+    return OpenILS::SIP::clean_text($self->{copy}->circ_lib->shortname);
+}
+
+sub current_location {
+    my $self = shift;
+    return OpenILS::SIP::clean_text($self->{copy}->circ_lib->shortname);
+}
+
+
+# 2 chars 0-99 
+# 01 Other
+# 02 On order
+# 03 Available
+# 04 Charged
+# 05 Charged; not to be recalled until earliest recall date
+# 06 In process
+# 07 Recalled
+# 08 Waiting on hold shelf
+# 09 Waiting to be re-shelved
+# 10 In transit between library locations
+# 11 Claimed returned
+# 12 Lost
+# 13 Missing 
+sub sip_circulation_status {
+    my $self = shift;
+    my $stat = $self->{copy}->status->id;
+
+    return '02' if $stat == OILS_COPY_STATUS_ON_ORDER;
+    return '03' if $stat == OILS_COPY_STATUS_AVAILABLE;
+    return '04' if $stat == OILS_COPY_STATUS_CHECKED_OUT;
+    return '06' if $stat == OILS_COPY_STATUS_IN_PROCESS;
+    return '08' if $stat == OILS_COPY_STATUS_ON_HOLDS_SHELF;
+    return '09' if $stat == OILS_COPY_STATUS_RESHELVING;
+    return '10' if $stat == OILS_COPY_STATUS_IN_TRANSIT;
+    return '12' if $stat == OILS_COPY_STATUS_LOST;
+    return '13' if $stat == OILS_COPY_STATUS_MISSING;
+        
+    return 01;
+}
+
+sub sip_security_marker {
+    return '02';    # FIXME? 00-other; 01-None; 02-Tattle-Tape Security Strip (3M); 03-Whisper Tape (3M)
+}
+
+sub sip_fee_type {
+    return '01';    # FIXME? 01-09 enumerated in spec.  We just use O1-other/unknown.
+}
+
+sub fee {           # TODO
+    my $self = shift;
+    return 0;
+}
+
+
+sub fee_currency {
+	my $self = shift;
+	return OpenILS::SIP->config()->{implementation_config}->{currency};
+}
+
+sub owner {
+    my $self = shift;
+    return OpenILS::SIP::clean_text($self->{copy}->circ_lib->shortname);
+}
+
+sub hold_queue {
+    my $self = shift;
+    return [];
+}
+
+sub hold_queue_position {       # TODO
+    my ($self, $patron_id) = @_;
+    return 1;
+}
+
+sub due_date {
+    my $self = shift;
+
+    # this should force correct circ fetching
+    require OpenILS::Utils::CStoreEditor;
+    my $e = OpenILS::Utils::CStoreEditor->new(xact => 1);
+    #my $e = OpenILS::SIP->editor();
+
+    my $circ = $e->search_action_circulation(
+        { target_copy => $self->{copy}->id, checkin_time => undef } )->[0];
+
+    $e->rollback;
+
+    if( !$circ ) {
+        syslog('LOG_INFO', "OILS: No open circ found for copy");
+        return 0;
+    }
+
+    my $due = OpenILS::SIP->format_date($circ->due_date, 'due');
+    syslog('LOG_DEBUG', "OILS: Found item due date = $due");
+    return $due;
+}
+
+sub recall_date {       # TODO
+    my $self = shift;
+    return 0;
+}
+
+
+# Note: If the held item is in transit, this will be an approximation of shelf 
+# expire time, since the time is not set until the item is  checked in at the pickup location
+my %shelf_expire_setting_cache;
+sub hold_pickup_date {  
+    my $self = shift;
+    my $copy = $self->{copy};
+    my $hold = $self->{hold} or return 0;
+
+    my $date = $hold->shelf_expire_time;
+
+    if(!$date) {
+        # hold has not hit the shelf.  create a best guess.
+
+        my $interval = $shelf_expire_setting_cache{$hold->pickup_lib->id} ||
+            $U->ou_ancestor_setting_value(
+                $hold->pickup_lib->id, 
+                'circ.holds.default_shelf_expire_interval');
+
+        $shelf_expire_setting_cache{$hold->pickup_lib->id} = $interval;
+
+        if($interval) {
+            my $seconds = OpenSRF::Utils->interval_to_seconds($interval);
+            $date = DateTime->now->add(seconds => $seconds);
+            $date = $date->strftime('%FT%T%z') if $date;
+        }
+    }
+
+    return OpenILS::SIP->format_date($date) if $date;
+
+    return 0;
+}
+
+# message to display on console
+sub screen_msg {
+    my $self = shift;
+    return OpenILS::SIP::clean_text($self->{screen_msg}) || '';
+}
+
+
+# reciept printer
+sub print_line {
+    my $self = shift;
+    return OpenILS::SIP::clean_text($self->{print_line}) || '';
+}
+
+
+# An item is available for a patron if
+# 1) It's not checked out and (there's no hold queue OR patron
+#    is at the front of the queue)
+# OR
+# 2) It's checked out to the patron and there's no hold queue
+sub available {
+    my ($self, $for_patron) = @_;
+
+    my $stat = $self->{copy}->status->id;
+    return 1 if 
+        $stat == OILS_COPY_STATUS_AVAILABLE or
+        $stat == OILS_COPY_STATUS_RESHELVING;
+
+    return 0;
+}
+
+
+1;
+__END__
+
+=head1 NAME
+
+OpenILS::SIP::Item - SIP abstraction layer for OpenILS Items.
+
+=head1 DESCRIPTION
+
+=head2 owning_lib vs. circ_lib
+
+In Evergreen, owning_lib is the org unit that purchased the item, the place to which the item 
+should return after it's done rotating/floating to other branches (via staff intervention),
+or some combination of those.  The owning_lib, however, is not necessarily where the item
+should be going "right now" or where it should return to by default.  That would be the copy
+circ_lib or the transit destination.  (In fact, the item may B go to the owning_lib for
+its entire existence).  In the context of SIP, the circ_lib more accurately describes the item's
+permanent location, i.e. where it needs to be sent if it's not en route to somewhere else.
+
+This confusion extends also to the SIP extension field of "owner".  It means that the SIP owner does not 
+correspond to EG's asset.volume.owning_lib, mainly because owning_lib is effectively the "ultimate
+owner" but not necessarily the "current owner".  Because we populate SIP fields with circ_lib, the
+owning_lib is unused by SIP.  
+
+=head1 TODO
+
+Holds queue logic
+
+=cut
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/SIP/Msg.pm b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Msg.pm
new file mode 100644
index 0000000000..620a9ba9df
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Msg.pm
@@ -0,0 +1,31 @@
+package OpenILS::SIP::Msg;
+use strict; use warnings;
+# -------------------------------------------------------
+# Defines the various screen messages
+# Currently they are just constants.. they need to be
+# moved to an external lang-specific source
+# -------------------------------------------------------
+use vars qw(@EXPORT_OK %EXPORT_TAGS);
+use Exporter;
+use base qw/Exporter/;
+
+
+# ---------------------------------------------------------------------
+# Shoves defined constants into the export array
+# so they don't have to be listed twice in the code
+# ---------------------------------------------------------------------
+sub econst {
+   my($name, $value) = @_;
+   my $caller = caller;
+   no strict;
+   *{$name} = sub () { $value };
+   push @{$caller.'::EXPORT_OK'}, $name;
+}
+
+
+econst OILS_SIP_MSG_CIRC_EXISTS => 'This item is already checked out';
+econst OILS_SIP_MSG_CIRC_PERMIT_FAILED => 'Patron is not allowed to check out the selected item';
+
+%EXPORT_TAGS = ( const => [ @EXPORT_OK ] );
+
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/SIP/Patron.pm b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Patron.pm
new file mode 100644
index 0000000000..214281ac8f
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Patron.pm
@@ -0,0 +1,703 @@
+#
+# 
+# A Class for hiding the ILS's concept of the patron from the OpenSIP
+# system
+#
+
+package OpenILS::SIP::Patron;
+
+use strict;
+use warnings;
+use Exporter;
+
+use Sys::Syslog qw(syslog);
+use Data::Dumper;
+use Digest::MD5 qw(md5_hex);
+
+use OpenILS::SIP;
+use OpenILS::Application::AppUtils;
+use OpenILS::Application::Actor;
+use OpenSRF::Utils qw/:datetime/;
+use DateTime::Format::ISO8601;
+my $U = 'OpenILS::Application::AppUtils';
+
+our (@ISA, @EXPORT_OK);
+
+@ISA = qw(Exporter);
+
+@EXPORT_OK = qw(invalid_patron);
+
+my $INET_PRIVS;
+
+#
+# OpenILS::SIP::Patron->new($barcode);
+# OpenILS::SIP::Patron->new(barcode => $barcode);   # same as above
+# OpenILS::SIP::Patron->new(    usr => $id);       
+
+sub new {
+    my $class = shift;
+    my $key   = (@_ > 1) ? shift : 'barcode';  # if we have multiple args, the first is the key index (default barcode)
+    my $patron_id = shift;
+    my %args = @_;
+
+    if ($key ne 'usr' and $key ne 'barcode') {
+        syslog("LOG_ERROR", "Patron (card) lookup requested by illegeal key '$key'");
+        return undef;
+    }
+
+    unless(defined $patron_id) {
+        syslog("LOG_WARNING", "No patron ID provided to ILS::Patron->new");
+        return undef;
+    }
+
+    my $type = ref($class) || $class;
+    my $self = bless({}, $type);
+
+    syslog("LOG_DEBUG", "OILS: new OpenILS Patron(%s => %s): searching...", $key, $patron_id);
+
+    my $e = OpenILS::SIP->editor();
+
+    my $usr_flesh = {
+        flesh => 2,
+        flesh_fields => {
+            au => [
+                "card",
+                "addresses",
+                "billing_address",
+                "mailing_address",
+                'profile',
+            ],
+        }
+    };
+
+    # in some cases, we don't need all of this data.  Only fetch the user + barcode
+    $usr_flesh = {flesh => 1, flesh_fields => {au => ['card']}} if $args{slim_user};
+    
+    my $user;
+    if($key eq 'barcode') { # retrieve user by barcode
+
+        $$usr_flesh{flesh} += 1;
+        $$usr_flesh{flesh_fields}{ac} = ['usr'];
+
+        my $card = $e->search_actor_card([{barcode => $patron_id}, $usr_flesh])->[0];
+
+        if(!$card) {
+            syslog("LOG_WARNING", "No such patron barcode: $patron_id");
+            return undef;
+        }
+
+        $user = $card->usr;
+
+    } else {
+	    $user = $e->retrieve_actor_user([$patron_id, $usr_flesh]);
+    }
+
+    if(!$user) {
+        syslog("LOG_WARNING", "OILS: Unable to find patron %s => %s", $key, $patron_id);
+        return undef;
+    }
+
+    # now grab the user's penalties
+
+    $self->flesh_user_penalties($user, $e) unless $args{slim_user};
+
+    $self->{editor} = $e;
+    $self->{user}   = $user;
+    $self->{id}     = ($key eq 'barcode') ? $patron_id : $user->card->barcode;   # The barcode IS the ID to SIP.  
+    # We give back the passed barcode if the key was indeed a barcode, just to be safe.  Otherwise pull it from the card.
+
+    syslog("LOG_DEBUG", "OILS: new OpenILS Patron(%s => %s): found patron : barred=%s, card:active=%s", 
+        $key, $patron_id, $user->barred, $user->card->active );
+
+    return $self;
+}
+
+# grab patron penalties.  Only grab non-archived penalties that are for fines,
+# excessive overdues, or otherwise block circluation activity
+sub flesh_user_penalties {
+    my ($self, $user, $e) = @_;
+
+    $user->standing_penalties(
+        $e->search_actor_user_standing_penalty([
+            {   
+                usr => $user->id,
+                '-or' => [
+
+                    # ignore "archived" penalties
+                    {stop_date => undef},
+                    {stop_date => {'>' => 'now'}}
+                ],
+
+                org_unit => {
+                    in  => {
+                        select => {
+                            aou => [{
+                                column => 'id', 
+                                transform => 'actor.org_unit_ancestors', 
+                                result_field => 'id'
+                            }]
+                        },
+                        from => 'aou',
+
+                        # at this point, there is no concept of "here", so fetch penalties 
+                        # for the patron's home lib plus ancestors
+                        where => {id => $user->home_ou}, 
+                        distinct => 1
+                    }
+                },
+
+                # in addition to fines and excessive overdue penalties, 
+                # we only care about penalties that result in blocks
+                standing_penalty => {
+                    in => {
+                        select => {csp => ['id']},
+                        from => 'csp',
+                        where => {
+                            '-or' => [
+                                {id => [1,2]}, # fines / overdues
+                                {block_list => {'!=' => undef}}
+                            ]
+                        },
+                    }
+                }
+            },
+        ])
+    );
+}
+
+sub id {
+    my $self = shift;
+    return $self->{id};
+}
+
+sub name {
+    my $self = shift;
+    return format_name($self->{user});
+}
+
+sub format_name {
+    my $u = shift;
+    return OpenILS::SIP::clean_text(
+        sprintf('%s %s %s', 
+            ($u->first_given_name || ''),
+            ($u->second_given_name || ''),
+            ($u->family_name || '')));
+}
+
+sub home_library {
+    my $self = shift;
+    my $lib = OpenILS::SIP::shortname_from_id($self->{user}->home_ou);
+	syslog('LOG_DEBUG', "OILS: Patron->home_library() = $lib");
+    return $lib;
+}
+
+sub __addr_string {
+    my $addr = shift;
+    return "" unless $addr;
+    my $return = OpenILS::SIP::clean_text(
+        join( ' ', map {$_ || ''} (
+            $addr->street1,
+            $addr->street2,
+            $addr->city . ',',
+            $addr->county,
+            $addr->state,
+            $addr->country,
+            $addr->post_code
+            )
+        )
+    );
+    $return =~ s/\s+/ /sg;     # Compress any run of of whitespace to one space
+    return $return;
+}
+
+sub internal_id {
+    my $self = shift;
+    return $self->{user}->id;
+}
+
+sub address {
+	my $self = shift;
+	my $u    = $self->{user};
+	my $str  = __addr_string($u->billing_address || $u->mailing_address);
+	syslog('LOG_DEBUG', "OILS: Patron address: $str");
+	return $str;
+}
+
+sub email_addr {
+    my $self = shift;
+    return OpenILS::SIP::clean_text($self->{user}->email);
+}
+
+sub home_phone {
+    my $self = shift;
+    return $self->{user}->day_phone;
+}
+
+sub sip_birthdate {
+	my $self = shift;
+	my $dob = OpenILS::SIP->format_date($self->{user}->dob);
+	syslog('LOG_DEBUG', "OILS: Patron DOB = $dob");
+	return $dob;
+}
+
+sub ptype {
+    my $self = shift;
+
+	my $use_code = OpenILS::SIP->get_option_value('patron_type_uses_code') || '';
+
+    # should we use the no_i18n version of patron profile name (as a 'code')?
+    return $self->{editor}->retrieve_permission_grp_tree(
+        [$self->{user}->profile->id, {no_i18n => 1}])->name
+        if $use_code =~ /true/io;
+
+    return OpenILS::SIP::clean_text($self->{user}->profile->name);
+}
+
+sub language {
+    my $self = shift;
+    return '000'; # Unspecified
+}
+
+# How much more detail do we need to check here?
+sub charge_ok {
+    my $self = shift;
+    my $u = $self->{user};
+    return (($u->barred eq 'f') and ($u->card->active eq 't'));
+}
+
+# How much more detail do we need to check here?
+sub renew_ok {
+    my $self = shift;
+    return $self->charge_ok;
+}
+
+sub recall_ok {
+    my $self = shift;
+    return 0;
+}
+
+sub hold_ok {
+    my $self = shift;
+    return $self->charge_ok;
+}
+
+# return true if the card provided is marked as lost
+sub card_lost {
+    my $self = shift;
+    return $self->{user}->card->active eq 'f';
+}
+
+sub recall_overdue {        # not implemented
+    my $self = shift;
+    return 0;
+}
+
+sub check_password {
+	my ($self, $pwd) = @_;
+	syslog('LOG_DEBUG', 'OILS: Patron->check_password()');
+    return 0 unless (defined $pwd and $self->{user});
+	return md5_hex($pwd) eq $self->{user}->passwd;
+}
+
+sub currency {              # not really implemented
+	my $self = shift;
+	syslog('LOG_DEBUG', 'OILS: Patron->currency()');
+	return 'USD';
+}
+
+sub fee_amount {
+	my $self = shift;
+	syslog('LOG_DEBUG', 'OILS: Patron->fee_amount()');
+    my $user_id = $self->{user}->id;
+
+    my $e = $self->{editor};
+    $e->xact_begin;
+    my $summary = $e->retrieve_money_open_user_summary($user_id);
+    $e->rollback; # xact_rollback + disconnect
+
+    my $total = ($summary) ? $summary->balance_owed : 0;
+	syslog('LOG_INFO', "User ".$self->{id} .":$user_id has a fee amount of \$$total");
+	return $total;
+}
+
+sub screen_msg {
+	my $self = shift;
+	my $u = $self->{user};
+
+	return 'barred' if $u->barred eq 't';
+
+	my $b = 'blocked';
+
+	return $b if $u->active eq 'f';
+	return $b if $u->card->active eq 'f';
+
+    # if we have any penalties at this point, they are blocking penalties
+    return $b if $u->standing_penalties and @{$u->standing_penalties};
+
+    # has the patron account expired?
+	my $expire = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($u->expire_date));
+	return $b if CORE::time > $expire->epoch;
+
+	return 'OK';
+}
+
+sub print_line {            # not implemented
+    my $self = shift;
+	return '';
+}
+
+sub too_many_charged {      # not implemented
+    my $self = shift;
+	return 0;
+}
+
+sub too_many_overdue { 
+	my $self = shift;
+    return scalar( # PATRON_EXCEEDS_OVERDUE_COUNT
+        grep { $_->standing_penalty == 2 } @{$self->{user}->standing_penalties}
+    );
+}
+
+# not completely sure what this means
+sub too_many_renewal {
+    my $self = shift;
+    return 0;
+}
+
+# not relevant, handled by fines/fees
+sub too_many_claim_return {
+    my $self = shift;
+    return 0;
+}
+
+# not relevant, handled by fines/fees
+sub too_many_lost {
+    my $self = shift;
+    return 0;
+}
+
+sub excessive_fines { 
+    my $self = shift;
+    return scalar( # PATRON_EXCEEDS_FINES
+        grep { $_->standing_penalty == 1 } @{$self->{user}->standing_penalties}
+    );
+}
+
+# Until someone suggests otherwise, fees and fines are the same
+
+sub excessive_fees {
+	my $self = shift;
+    return $self->excessive_fines;
+}
+
+# not relevant, handled by fines/fees
+sub too_many_billed {
+    my $self = shift;
+	return 0;
+}
+
+
+
+#
+# List of outstanding holds placed
+#
+sub hold_items {
+    my ($self, $start, $end) = @_;
+	syslog('LOG_DEBUG', 'OILS: Patron->hold_items()');
+
+	 my $holds = $self->{editor}->search_action_hold_request(
+		{ usr => $self->{user}->id, fulfillment_time => undef, cancel_time => undef }
+	 );
+
+	my @holds;
+	push( @holds, OpenILS::SIP::clean_text($self->__hold_to_title($_)) ) for @$holds;
+
+	return (defined $start and defined $end) ? 
+		[ $holds[($start-1)..($end-1)] ] : 
+		\@holds;
+}
+
+sub __hold_to_title {
+	my $self = shift;
+	my $hold = shift;
+	my $e = $self->{editor};
+
+	my( $id, $mods, $title, $volume, $copy );
+
+	return __copy_to_title($e, 
+		$e->retrieve_asset_copy($hold->target)) 
+		if $hold->hold_type eq 'C';
+
+	return __volume_to_title($e, 
+		$e->retrieve_asset_call_number($hold->target))
+		if $hold->hold_type eq 'V';
+
+	return __record_to_title(
+		$e, $hold->target) if $hold->hold_type eq 'T';
+
+	return __metarecord_to_title(
+		$e, $hold->target) if $hold->hold_type eq 'M';
+}
+
+sub __copy_to_title {
+	my( $e, $copy ) = @_;
+	#syslog('LOG_DEBUG', "OILS: copy_to_title(%s)", $copy->id);
+	return $copy->dummy_title if $copy->call_number == -1;	
+
+	my $vol = (ref $copy->call_number) ?
+		$copy->call_number :
+		$e->retrieve_asset_call_number($copy->call_number);
+
+	return __volume_to_title($e, $vol);
+}
+
+
+sub __volume_to_title {
+	my( $e, $volume ) = @_;
+	#syslog('LOG_DEBUG', "OILS: volume_to_title(%s)", $volume->id);
+	return __record_to_title($e, $volume->record);
+}
+
+
+sub __record_to_title {
+	my( $e, $title_id ) = @_;
+	#syslog('LOG_DEBUG', "OILS: record_to_title($title_id)");
+	my $mods = $U->simplereq(
+		'open-ils.search',
+		'open-ils.search.biblio.record.mods_slim.retrieve', $title_id );
+	return ($mods) ? $mods->title : "";
+}
+
+sub __metarecord_to_title {
+	my( $e, $m_id ) = @_;
+	#syslog('LOG_DEBUG', "OILS: metarecord_to_title($m_id)");
+	my $mods = $U->simplereq(
+		'open-ils.search',
+		'open-ils.search.biblio.metarecord.mods_slim.retrieve', $m_id);
+	return ($U->event_code($mods)) ? "" : $mods->title;
+}
+
+
+#
+# remove the hold on item item_id from my hold queue.
+# return true if I was holding the item, false otherwise.
+# 
+sub drop_hold {
+    my ($self, $item_id) = @_;
+    return 0;
+}
+
+sub __patron_items_info {
+	my $self = shift;
+	return if $self->{item_info};
+	$self->{item_info} = 
+		OpenILS::Application::Actor::_checked_out(
+			0, $self->{editor}, $self->{user}->id);;
+}
+
+
+
+sub overdue_items {
+	my ($self, $start, $end) = @_;
+
+	$self->__patron_items_info();
+	my @overdues = @{$self->{item_info}->{overdue}};
+	#$overdues[$_] = __circ_to_title($self->{editor}, $overdues[$_]) for @overdues;
+
+	my @o;
+	syslog('LOG_DEBUG', "OILS: overdue_items() fleshing circs @overdues");
+
+	my $return_datatype = OpenILS::SIP->get_option_value('msg64_summary_datatype') || '';
+	
+	for my $circid (@overdues) {
+		next unless $circid;
+		if($return_datatype eq 'barcode') {
+			push( @o, __circ_to_barcode($self->{editor}, $circid));
+		} else {
+			push( @o, OpenILS::SIP::clean_text(__circ_to_title($self->{editor}, $circid)));
+		}
+	}
+	@overdues = @o;
+
+	return (defined $start and defined $end) ? 
+		[ $overdues[($start-1)..($end-1)] ] : \@overdues;
+}
+
+sub __circ_to_barcode {
+	my ($e, $circ) = @_;
+	return unless $circ;
+	$circ = $e->retrieve_action_circulation($circ);
+	my $copy = $e->retrieve_asset_copy($circ->target_copy);
+	return $copy->barcode;
+}
+
+sub __circ_to_title {
+	my( $e, $circ ) = @_;
+	return unless $circ;
+	$circ = $e->retrieve_action_circulation($circ);
+	return __copy_to_title( $e, 
+		$e->retrieve_asset_copy($circ->target_copy) );
+}
+
+sub charged_items {
+	my ($self, $start, $end) = shift;
+
+	$self->__patron_items_info();
+
+	my @charges = (
+		@{$self->{item_info}->{out}},
+		@{$self->{item_info}->{overdue}}
+		);
+
+	#$charges[$_] = __circ_to_title($self->{editor}, $charges[$_]) for @charges;
+
+	my @c;
+	syslog('LOG_DEBUG', "OILS: charged_items() fleshing circs @charges");
+
+	my $return_datatype = OpenILS::SIP->get_option_value('msg64_summary_datatype') || '';
+
+	for my $circid (@charges) {
+		next unless $circid;
+		if($return_datatype eq 'barcode') {
+			push( @c, __circ_to_barcode($self->{editor}, $circid));
+		} else {
+			push( @c, OpenILS::SIP::clean_text(__circ_to_title($self->{editor}, $circid)));
+		}
+	}
+
+	@charges = @c;
+
+	return (defined $start and defined $end) ? 
+		[ $charges[($start-1)..($end-1)] ] : 
+		\@charges;
+}
+
+sub fine_items {
+	my ($self, $start, $end) = @_;
+	my @fines;
+	syslog('LOG_DEBUG', 'OILS: Patron->fine_items()');
+	return (defined $start and defined $end) ? 
+		[ $fines[($start-1)..($end-1)] ] : \@fines;
+}
+
+# not currently supported
+sub recall_items {
+    my ($self, $start, $end) = @_;
+    return [];
+}
+
+sub unavail_holds {
+	my ($self, $start, $end) = @_;
+	my @holds;
+	syslog('LOG_DEBUG', 'OILS: Patron->unavail_holds()');
+	return (defined $start and defined $end) ? 
+		[ $holds[($start-1)..($end-1)] ] : \@holds;
+}
+
+sub block {
+	my ($self, $card_retained, $blocked_card_msg) = @_;
+    $blocked_card_msg ||= '';
+
+    my $e = $self->{editor};
+	my $u = $self->{user};
+
+	syslog('LOG_INFO', "OILS: Blocking user %s", $u->card->barcode );
+
+	return $self if $u->card->active eq 'f';
+
+    $e->xact_begin;    # connect and start a new transaction
+
+	$u->card->active('f');
+	if( ! $e->update_actor_card($u->card) ) {
+		syslog('LOG_ERR', "OILS: Block card update failed: %s", $e->event->{textcode});
+		$e->rollback; # rollback + disconnect
+		return $self;
+	}
+
+	# retrieve the un-fleshed user object for update
+	$u = $e->retrieve_actor_user($u->id);
+	my $note = OpenILS::SIP::clean_text($u->alert_message) || "";
+	$note = " CARD BLOCKED BY SELF-CHECK MACHINE. $blocked_card_msg\n$note"; # XXX Config option
+    $note =~ s/\s*$//;  # kill trailng whitespace
+	$u->alert_message($note);
+
+	if( ! $e->update_actor_user($u) ) {
+		syslog('LOG_ERR', "OILS: Block: patron alert update failed: %s", $e->event->{textcode});
+		$e->rollback; # rollback + disconnect
+		return $self;
+	}
+
+	# stay in synch
+	$self->{user}->alert_message( $note );
+
+	$e->commit; # commits and disconnects
+	return $self;
+}
+
+# Testing purposes only
+sub enable {
+    my ($self, $card_retained) = @_;
+    $self->{screen_msg} = "All privileges restored.";
+
+    # Un-mark card as inactive, grep out the patron alert
+    my $e = $self->{editor};
+    my $u = $self->{user};
+
+    syslog('LOG_INFO', "OILS: Unblocking user %s", $u->card->barcode );
+
+    return $self if $u->card->active eq 't';
+
+    $e->xact_begin;    # connect and start a new transaction
+
+    $u->card->active('t');
+    if( ! $e->update_actor_card($u->card) ) {
+        syslog('LOG_ERR', "OILS: Unblock card update failed: %s", $e->event->{textcode});
+        $e->rollback; # rollback + disconnect
+        return $self;
+    }
+
+    # retrieve the un-fleshed user object for update
+    $u = $e->retrieve_actor_user($u->id);
+    my $note = OpenILS::SIP::clean_text($u->alert_message) || "";
+    $note =~ s#.*##;
+    $note =~ s/^\s*//;  # kill leading whitespace
+    $note =~ s/\s*$//;  # kill trailng whitespace
+    $u->alert_message($note);
+
+    if( ! $e->update_actor_user($u) ) {
+        syslog('LOG_ERR', "OILS: Unblock: patron alert update failed: %s", $e->event->{textcode});
+        $e->rollback; # rollback + disconnect
+        return $self;
+    }
+
+    # stay in synch
+    $self->{user}->alert_message( $note );
+
+    $e->commit; # commits and disconnects
+    return $self;
+}
+
+#
+# Messages
+#
+
+sub invalid_patron {
+    return "Please contact library staff";
+}
+
+sub charge_denied {
+    return "Please contact library staff";
+}
+
+sub inet_privileges {
+    my( $self ) = @_;
+    my $e = OpenILS::SIP->editor();
+    $INET_PRIVS = $e->retrieve_all_config_net_access_level() unless $INET_PRIVS;
+    my ($level) = grep { $_->id eq $self->{user}->net_access_level } @$INET_PRIVS;
+    my $name = OpenILS::SIP::clean_text($level->name);
+    syslog('LOG_DEBUG', "OILS: Patron inet_privs = $name");
+    return $name;
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction.pm b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction.pm
new file mode 100644
index 0000000000..eeb9fafc80
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction.pm
@@ -0,0 +1,71 @@
+#
+# Transaction: Superclass of all the transactional status objects
+#
+
+package OpenILS::SIP::Transaction;
+
+use Carp;
+use strict; use warnings;
+use Sys::Syslog qw(syslog);
+
+use OpenILS::SIP;
+use OpenILS::SIP::Msg qw/:const/;
+
+
+my %fields = (
+      ok            => 0,
+      patron        => undef,
+      item          => undef,
+      desensitize   => 0,
+      alert         => '',
+      transation_id => undef,
+      sip_fee_type  => '01', # Other/Unknown
+      fee_amount    => undef,
+      sip_currency  => 'CAD',
+      screen_msg    => '',
+      print_line    => '',
+      editor        => undef,
+      authtoken     => '',
+);
+
+our $AUTOLOAD;
+
+sub new {
+    my( $class, %args ) = @_;
+
+    my $self = { _permitted => \%fields, %fields };
+
+	bless $self, $class;
+	$self->authtoken($args{authtoken});
+
+	syslog('LOG_DEBUG', "OILS: Created new transaction with authtoken %s", $self->authtoken);
+
+	my $e = OpenILS::SIP->editor();
+	$e->{authtoken} = $self->authtoken;
+
+	return $self;
+}
+
+sub DESTROY { 
+	# be cool
+}
+
+sub AUTOLOAD {
+	my $self = shift;
+	my $class = ref($self) or croak "$self is not an object";
+	my $name = $AUTOLOAD;
+
+	$name =~ s/.*://;
+
+	unless (exists $self->{_permitted}->{$name}) {
+		croak "Can't access '$name' field of class '$class'";
+	}
+
+	if (@_) {
+		return $self->{$name} = shift;
+	} else {
+		return $self->{$name};
+	}
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction/Checkin.pm b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction/Checkin.pm
new file mode 100644
index 0000000000..42a689cb7e
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction/Checkin.pm
@@ -0,0 +1,239 @@
+package OpenILS::SIP::Transaction::Checkin;
+use warnings; use strict;
+
+use POSIX qw(strftime);
+use Sys::Syslog qw(syslog);
+use Data::Dumper;
+use Time::HiRes q/time/;
+
+use OpenILS::SIP;
+use OpenILS::SIP::Transaction;
+use OpenILS::Const qw/:const/;
+use OpenILS::Application::AppUtils;
+my $U = 'OpenILS::Application::AppUtils';
+
+use base qw(OpenILS::SIP::Transaction);
+
+my $debug = 0;
+
+my %fields = (
+    magnetic => 0,
+    sort_bin => undef,
+    # 3M extensions: (most of the data is stored under Item)
+#   collection_code  => undef,
+#   call_number      => undef,
+    destination_loc  => undef,
+    alert_type       => undef,  # 00,01,02,03,04 or 99
+#   hold_patron_id   => undef,
+#   hold_patron_name => "",
+#   hold             => undef,
+);
+
+sub new {
+    my $class = shift;;
+    my $self = $class->SUPER::new(@_);              # start with an Transaction object
+
+    foreach (keys %fields) {
+        $self->{_permitted}->{$_} = $fields{$_};    # overlaying _permitted
+    }
+
+    @{$self}{keys %fields} = values %fields;        # copying defaults into object
+
+    $self->load_override_events;
+
+    return bless $self, $class;
+}
+
+sub resensitize {
+    my $self = shift;
+    return 0 if !$self->{item};
+    return !$self->{item}->magnetic;
+}
+
+my %override_events;
+sub load_override_events {
+    return if %override_events;
+    my $override = OpenILS::SIP->config->{implementation_config}->{checkin_override};
+    return unless $override;
+    my $events = $override->{event};
+    $events = [$events] unless ref $events eq 'ARRAY';
+    $override_events{$_} = 1 for @$events;
+}
+
+my %org_sn_cache;
+sub do_checkin {
+    my $self = shift;
+    my ($sip_handler, $inst_id, $trans_date, $return_date, $current_loc, $item_props) = @_; # most unused
+
+    unless($self->{item}) {
+        $self->ok(0);
+        return undef;
+    }
+
+    $inst_id ||= '';
+
+    # physical location defaults to ws ou of the logged in sip user,
+    # which currently defaults to home_ou, since ws's aren't used.
+    my $phys_location = $sip_handler->{login_session}->ws_ou;
+
+    my $args = {barcode => $self->{item}->id};
+
+    if($return_date) {
+        # SIP date format is YYYYMMDD.  Translate to ISO8601
+        $return_date =~ s/(\d{4})(\d{2})(\d{2}).*/$1-$2-$3/;
+        syslog('LOG_INFO', "Checking in with backdate $return_date");
+        $args->{backdate} = $return_date;
+    }
+
+    if($current_loc) { # SIP client specified a physical location
+
+        my $org_id = (defined $org_sn_cache{$current_loc}) ? 
+            $org_sn_cache{$current_loc} :
+            OpenILS::SIP->editor()->search_actor_org_unit({shortname => $current_loc}, {idlist => 1})->[0];
+
+        $org_sn_cache{$current_loc} = $org_id;
+
+        # if the caller specifies a physical location, use it as the checkin circ lib
+        $args->{circ_lib} = $phys_location = $org_id if defined $org_id;
+    }
+
+    my $override = 0;
+    my ($resp, $txt, $code);
+
+    while(1) {
+
+        my $method = 'open-ils.circ.checkin';
+        $method .= '.override' if $override;
+
+        my $start_time = time();
+        $resp = $U->simplereq('open-ils.circ', $method, $self->{authtoken}, $args);
+        syslog('LOG_INFO', "OILS: Checkin API call took %0.3f seconds", (time() - $start_time));
+
+        if ($debug) {
+            my $s = Dumper($resp);
+            $s =~ s/\n//mog;
+            syslog('LOG_INFO', "OILS: Checkin response: $s");
+        }
+
+        # In oddball cases, we can receive an array of events.
+        # The first event received should be treated as the main result.
+        $resp = $$resp[0] if ref($resp) eq 'ARRAY';
+        $code = $U->event_code($resp);
+        $txt  = (defined $code) ? $resp->{textcode} : '';
+
+        last if $override;
+
+        if ( $override_events{$txt} ) {
+            $override = 1;
+        } else {
+            last;
+        }
+    }
+
+    syslog('LOG_INFO', "OILS: Checkin resulted in event: $txt, phys_location: $phys_location");
+
+    $resp->{org} &&= OpenILS::SIP::shortname_from_id($resp->{org}); # Convert id to shortname
+
+    $self->destination_loc($resp->{org}) if $resp->{org};
+
+    if ($txt eq 'ROUTE_ITEM') {
+        # Note, this alert_type will be overridden below if this is a hold transit
+        $self->alert_type('04'); # send to other branch
+
+    } elsif ($txt and $txt ne 'NO_CHANGE' and $txt ne 'SUCCESS') {
+        syslog('LOG_WARNING', "OILS: Checkin returned unexpected event $code : $txt");
+        $self->alert_type('00'); # unknown
+    }
+    
+    my $payload = $resp->{payload} || {};
+
+    my ($circ, $copy);
+
+    if(ref $payload eq 'HASH') {
+
+        # Two places to look for hold data.  These are more important and more definitive than above.
+        if ($payload->{remote_hold}) {
+            # actually only used for checkin at non-owning branch w/ hold at same branch
+            $self->item->hold($payload->{remote_hold});     
+
+        } elsif ($payload->{hold}) {
+            $self->item->hold($payload->{hold});
+        }
+
+        $circ = $resp->{payload}->{circ} || '';
+        $copy = $resp->{payload}->{copy} || '';
+    }
+
+    if ($self->item->hold) {
+        my ($pickup_lib_id, $pickup_lib_sn);
+
+        my $holder = OpenILS::SIP->editor()->retrieve_actor_user(
+            [$self->item->hold->usr, {flesh => 1, flesh_fields => {au => ['card']}}]);
+
+        my $holder_name = OpenILS::SIP::Patron::format_name($holder);
+
+        if (ref $self->item->hold->pickup_lib) {
+            $pickup_lib_id = $self->item->hold->pickup_lib->id;
+            $pickup_lib_sn = $self->item->hold->pickup_lib->shortname;
+
+        } else {
+            $pickup_lib_id = $self->item->hold->pickup_lib;
+            $pickup_lib_sn = OpenILS::SIP::shortname_from_id($pickup_lib_id);
+        }
+
+        $self->item->hold_patron_bcode( ($holder->card) ? $holder->card->barcode : '');
+        $self->item->hold_patron_name($holder_name);
+        $self->item->destination_loc($pickup_lib_sn); 
+
+        my $atype = ($pickup_lib_id == $phys_location) ? '01' : '02';
+        $self->alert_type($atype);
+    }
+
+    $self->alert(1) if defined $self->alert_type;  # alert_type could be "00", hypothetically
+
+    if ( $circ ) {
+        $self->{circ_user_id} = $circ->usr;
+        $self->ok(1);
+    } elsif ($txt eq 'NO_CHANGE' or $txt eq 'SUCCESS' or $txt eq 'ROUTE_ITEM') {
+        $self->ok(1); # NO_CHANGE means it wasn't checked out anyway, no problem
+    } else {
+        $self->alert(1);
+        $self->alert_type('00') unless $self->alert_type; # wasn't checked out, but *something* changed
+        # $self->ok(0); # maybe still ok?
+    }
+}
+
+1;
+__END__
+
+Successful Checkin event payload includes:
+    $payload->{copy}   (unfleshed)
+    $payload->{record} 
+    $payload->{circ}   
+    $payload->{transit}
+    $payload->{cancelled_hold_transit}
+    $payload->{hold}   
+    $payload->{patron} 
+
+Some EVENT strings:
+    SUCCESS                => ,
+    ASSET_COPY_NOT_FOUND   => ,
+    NO_CHANGE              => ,
+    PERM_FAILURE           => ,
+    CIRC_CLAIMS_RETURNED   => ,
+    COPY_ALERT_MESSAGE     => ,
+    COPY_STATUS_LOST       => ,
+    COPY_STATUS_MISSING    => ,
+    COPY_BAD_STATUS        => ,
+    ITEM_DEPOSIT_PAID      => ,
+    ROUTE_ITEM             => ,
+    DATABASE_UPDATE_FAILED => ,
+    DATABASE_QUERY_FAILED  => ,
+
+# alert_type:
+#   00 - Unknown
+#   01 - hold in local library
+#   02 - hold for other branch
+#   03 - hold for ILL (not used in EG)
+#   04 - send to other branch (no hold)
+#   99 - Other
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction/Checkout.pm b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction/Checkout.pm
new file mode 100644
index 0000000000..1b94492c01
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction/Checkout.pm
@@ -0,0 +1,148 @@
+#
+# An object to handle checkout status
+#
+
+package OpenILS::SIP::Transaction::Checkout;
+
+use warnings;
+use strict;
+
+use POSIX qw(strftime);
+
+use OpenILS::SIP;
+use OpenILS::SIP::Transaction;
+use OpenILS::SIP::Msg qw/:const/;
+use Sys::Syslog qw(syslog);
+
+use OpenILS::Application::AppUtils;
+my $U = 'OpenILS::Application::AppUtils';
+
+
+our @ISA = qw(OpenILS::SIP::Transaction);
+
+# Most fields are handled by the Transaction superclass
+my %fields = (
+	      security_inhibit => 0,
+	      due              => undef,
+	      renew_ok         => 0,
+	      );
+
+sub new {
+	 my $class = shift;
+
+    my $self = $class->SUPER::new(@_);
+
+    my $element;
+
+	foreach $element (keys %fields) {
+		$self->{_permitted}->{$element} = $fields{$element};
+	}
+
+    @{$self}{keys %fields} = values %fields;
+	 
+    return bless $self, $class;
+}
+
+
+# if this item is already checked out to the requested patron,
+# renew the item and set $self->renew_ok to true.  
+# XXX if it's a renewal and the renewal is not permitted, set 
+# $self->screen_msg("Item on Hold for Another User"); (or somesuch)
+# XXX Set $self->ok(0) on any errors
+sub do_checkout {
+	my $self = shift;
+	my $is_renew = shift || 0;
+
+	$self->ok(0); 
+
+	my $args = { 
+		barcode => $self->{item}->id, 
+		patron_barcode => $self->{patron}->id
+	};
+
+	my $resp;
+
+	if ($is_renew) {
+		$resp = $U->simplereq(
+			'open-ils.circ',
+			'open-ils.circ.renew', $self->{authtoken},
+			{ barcode => $self->item->id, patron_barcode => $self->patron->id });
+	} else {
+		$resp = $U->simplereq(
+			'open-ils.circ',
+			'open-ils.circ.checkout.permit', 
+			$self->{authtoken}, $args );
+
+		$resp = [$resp] unless ref $resp eq 'ARRAY';
+
+		my $key;
+
+		syslog('LOG_DEBUG', "OILS: Checkout permit returned event: " . OpenSRF::Utils::JSON->perl2JSON($resp));
+
+		if( @$resp == 1 and ! $U->event_code($$resp[0]) ) {
+			$key = $$resp[0]->{payload};
+			syslog('LOG_INFO', "OILS: circ permit key => $key");
+
+		} else {
+
+			# We got one or more non-success events
+			$self->screen_msg('');
+			for my $r (@$resp) {
+
+				if( my $code = $U->event_code($resp) ) {
+					my $txt = $resp->{textcode};
+					syslog('LOG_INFO', "OILS: Checkout permit failed with event $code : $txt");
+
+					if( $txt eq 'OPEN_CIRCULATION_EXISTS' ) {
+						$self->screen_msg(OILS_SIP_MSG_CIRC_EXISTS);
+						return 0;
+					} else {
+						$self->screen_msg(OILS_SIP_MSG_CIRC_PERMIT_FAILED);
+					}
+				}
+			}
+			return 0;
+		}
+
+		# --------------------------------------------------------------------
+		# Now do the actual checkout
+		# --------------------------------------------------------------------
+
+		$args = { 
+			permit_key		=> $key, 
+			patron_barcode => $self->{patron}->id, 
+			barcode			=> $self->{item}->id
+		};
+
+		$resp = $U->simplereq(
+			'open-ils.circ',
+			'open-ils.circ.checkout', $self->{authtoken}, $args );
+	}
+
+	syslog('LOG_INFO', "OILS: Checkout returned event: " . OpenSRF::Utils::JSON->perl2JSON($resp));
+
+	# XXX Check for events
+	if( $resp ) {
+
+		if( my $code = $U->event_code($resp) ) {
+			my $txt = $resp->{textcode};
+			syslog('LOG_INFO', "OILS: Checkout failed with event $code : $txt");
+			$self->screen_msg('Checkout failed.  Please contact a librarian');
+			return 0; 
+		}
+
+		syslog('LOG_INFO', "OILS: Checkout succeeded");
+
+		my $circ = $resp->{payload}->{circ};
+		$self->{'due'} = OpenILS::SIP->format_date($circ->due_date, 'due');
+		$self->ok(1);
+
+		return 1;
+	}
+
+	return 0;
+}
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction/Renew.pm b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction/Renew.pm
new file mode 100644
index 0000000000..fb2681e1d6
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/SIP/Transaction/Renew.pm
@@ -0,0 +1,57 @@
+#
+# Status of a Renew Transaction
+#
+
+package OpenILS::SIP::Transaction::Renew;
+use warnings; use strict;
+
+use Sys::Syslog qw(syslog);
+use OpenILS::SIP;
+use OpenILS::SIP::Transaction;
+use OpenILS::Application::AppUtils;
+my $U = 'OpenILS::Application::AppUtils';
+
+our @ISA = qw(OpenILS::SIP::Transaction);
+
+my %fields = (
+	      renewal_ok => 0,
+	      );
+
+sub new {
+	my $class = shift;;
+	my $self = $class->SUPER::new(@_);
+
+	$self->{_permitted}->{$_} = $fields{$_} for keys %fields;
+	@{$self}{keys %fields} = values %fields;
+
+	return bless $self, $class;
+}
+
+sub do_renew {
+	my $self = shift;
+
+	my $resp = $U->simplereq(
+		'open-ils.circ',
+		'open-ils.circ.renew', $self->{authtoken},
+		{ barcode => $self->item->id, patron_barcode => $self->patron->id });
+
+	if( my $code = $U->event_code($resp) ) {
+		syslog('LOG_INFO', "OILS: Renewal failed with event $code : " . $resp->{textcode});
+		$self->renewal_ok(0);
+		$self->ok(0);
+		return $self;
+	}
+
+	$self->item->{due_date} = $resp->{payload}->{circ}->due_date;
+	syslog('LOG_INFO', "OILS: Renewal succeeded with due_date = " . $self->item->{due_date});
+
+	$self->renewal_ok(1);
+	$self->ok(1);
+
+	return $self;
+}
+
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Template/Plugin/Unicode.pm b/Open-ILS/src/perlmods/lib/OpenILS/Template/Plugin/Unicode.pm
new file mode 100644
index 0000000000..6a3423793a
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Template/Plugin/Unicode.pm
@@ -0,0 +1,12 @@
+package OpenILS::Template::Plugin::Unicode;
+use Unicode::Normalize;
+
+sub new { return bless {}, __PACKAGE__ }
+sub load { return __PACKAGE__ }
+
+sub C { shift; return NFC(@_); }
+sub D { shift; return NFD(@_); }
+sub entityDecode { shift; $_ = shift; s/&#x([0-9a-fA-F]+);/chr(hex($1))/egos; return $_ }
+sub entityEncode { shift; $_ = shift; s/(\PM\pM+)/sprintf('&#x%0.4x;',ord(NFC($1)))/sgoe; return $_ }
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Template/Plugin/WebSession.pm b/Open-ILS/src/perlmods/lib/OpenILS/Template/Plugin/WebSession.pm
new file mode 100644
index 0000000000..ace78c0a35
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Template/Plugin/WebSession.pm
@@ -0,0 +1,34 @@
+package OpenILS::Template::Plugin::WebSession;
+use strict; use warnings;
+use OpenILS::Utils::Fieldmapper;
+
+use Template::Plugin;
+use base qw/Template::Plugin/;
+use OpenSRF::AppSession;
+use OpenSRF::System;
+
+sub new {
+	my ($class) = @_;
+	$class = ref($class) || $class;
+	my $self = {};
+	return bless($self,$class);
+}
+	
+my $bootstrapped = 0;
+sub bootstrap_client {
+	my( $self, $config_file ) = @_;
+	if(!$bootstrapped) {
+		OpenSRF::System->bootstrap_client( config_file => $config_file );
+		$bootstrapped = 1;
+	}
+}
+
+sub init_app_session {
+	my($self, $service) = @_;
+	return undef unless $service;
+	return OpenSRF::AppSession->create($service);
+}
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Template/Plugin/WebUtils.pm b/Open-ILS/src/perlmods/lib/OpenILS/Template/Plugin/WebUtils.pm
new file mode 100644
index 0000000000..050aee2b4a
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Template/Plugin/WebUtils.pm
@@ -0,0 +1,49 @@
+package OpenILS::Template::Plugin::WebUtils;
+use strict; use warnings;
+use OpenILS::Utils::Fieldmapper;
+
+use Template::Plugin;
+use base qw/Template::Plugin/;
+use OpenSRF::AppSession;
+use OpenSRF::System;
+use XML::LibXML;
+use OpenSRF::Utils::SettingsParser;
+use OpenSRF::Utils::JSON;
+
+sub new {
+	my ($class) = @_;
+	$class = ref($class) || $class;
+	my $self = {};
+	return bless($self,$class);
+}
+	
+
+sub XML2perl {
+	my( $self, $doc ) = @_;
+	return OpenSRF::Utils::SettingsParser::XML2perl($doc);
+}
+
+
+sub perl2JSON {
+	my( $self, $perl ) = @_;
+	my $json = OpenSRF::Utils::JSON->perl2JSON($perl);
+	warn "Created JSON from perl:\n$json\n";
+	return $json;
+}
+	
+sub JSON2perl {
+	my( $self, $perl ) = @_;
+	warn "Turning JSON into perl:\n$perl\n";
+	my $obj = OpenSRF::Utils::JSON->JSON2perl($perl);
+	warn "Created Perl from JSON: $obj \n";
+	return $obj;
+}
+
+sub perl2prettyJSON {
+	my( $self, $perl ) = @_;
+	return OpenSRF::Utils::JSON->perl2prettyJSON($perl);
+}
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/CStoreEditor.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/CStoreEditor.pm
new file mode 100644
index 0000000000..ff298f42d1
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/CStoreEditor.pm
@@ -0,0 +1,856 @@
+use strict; use warnings;
+package OpenILS::Utils::CStoreEditor;
+use OpenILS::Application::AppUtils;
+use OpenSRF::AppSession;
+use OpenSRF::EX qw(:try);
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Event;
+use Data::Dumper;
+use OpenSRF::Utils::JSON;
+use OpenSRF::Utils::Logger qw($logger);
+my $U = "OpenILS::Application::AppUtils";
+my %PERMS;
+my $cache;
+my %xact_ed_cache;
+
+our $always_xact = 0;
+our $_loaded = 1;
+
+#my %PERMS = (
+#	'biblio.record_entry'	=> { update => 'UPDATE_MARC' },
+#	'asset.copy'				=> { update => 'UPDATE_COPY'},
+#	'asset.call_number'		=> { update => 'UPDATE_VOLUME'},
+#	'action.circulation'		=> { retrieve => 'VIEW_CIRCULATIONS'},
+#);
+
+sub flush_forced_xacts {
+    for my $k ( keys %xact_ed_cache ) {
+        try {
+            $xact_ed_cache{$k}->rollback;
+        } catch Error with {
+            # rollback failed
+        };
+        delete $xact_ed_cache{$k};
+    }
+}
+
+# -----------------------------------------------------------------------------
+# Export some useful functions
+# -----------------------------------------------------------------------------
+use vars qw(@EXPORT_OK %EXPORT_TAGS);
+use Exporter;
+use base qw/Exporter/;
+push @EXPORT_OK, ( 'new_editor', 'new_rstore_editor' );
+%EXPORT_TAGS = ( funcs => [ qw/ new_editor new_rstore_editor / ] );
+
+sub new_editor { return OpenILS::Utils::CStoreEditor->new(@_); }
+
+sub new_rstore_editor { 
+	my $e = OpenILS::Utils::CStoreEditor->new(@_); 
+	$e->app('open-ils.reporter-store');
+	return $e;
+}
+
+
+# -----------------------------------------------------------------------------
+# Log levels
+# -----------------------------------------------------------------------------
+use constant E => 'error';
+use constant W => 'warn';
+use constant I => 'info';
+use constant D => 'debug';
+use constant A => 'activity';
+
+
+
+# -----------------------------------------------------------------------------
+# Params include:
+#	xact=> : creates a storage transaction
+#	authtoken=>$token : the login session key
+# -----------------------------------------------------------------------------
+sub new {
+	my( $class, %params ) = @_;
+	$class = ref($class) || $class;
+	my $self = bless( \%params, $class );
+	$self->{checked_perms} = {};
+	return $self;
+}
+
+sub DESTROY {
+        my $self = shift;
+        $self->reset;
+        return undef;
+}
+
+sub app {
+	my( $self, $app ) = @_;
+	$self->{app} = $app if $app;
+	$self->{app} = 'open-ils.cstore' unless $self->{app};
+	return $self->{app};
+}
+
+
+# -----------------------------------------------------------------------------
+# Log the editor metadata along with the log string
+# -----------------------------------------------------------------------------
+sub log {
+	my( $self, $lev, $str ) = @_;
+	my $s = "editor[";
+    if ($always_xact) {
+        $s .= "!|";
+    } elsif ($self->{xact}) {
+        $s .= "1|";
+    } else {
+	    $s .= "0|";
+    }
+	$s .= "0" unless $self->requestor;
+	$s .= $self->requestor->id if $self->requestor;
+	$s .= "]";
+	$logger->$lev("$s $str");
+}
+
+# -----------------------------------------------------------------------------
+# Verifies the auth token and fetches the requestor object
+# -----------------------------------------------------------------------------
+sub checkauth {
+	my $self = shift;
+	$self->log(D, "checking auth token ".$self->authtoken);
+	my ($reqr, $evt) = $U->checkses($self->authtoken);
+	$self->event($evt) if $evt;
+	return $self->{requestor} = $reqr;
+}
+
+
+=head test
+sub checkauth {
+	my $self = shift;
+	$cache = OpenSRF::Utils::Cache->new('global') unless $cache;
+	$self->log(D, "checking cached auth token ".$self->authtoken);
+	my $user = $cache->get_cache("oils_auth_".$self->authtoken);
+	return $self->{requestor} = $user->{userobj} if $user;
+	$self->event(OpenILS::Event->new('NO_SESSION'));
+	return undef;
+}
+=cut
+
+
+# -----------------------------------------------------------------------------
+# Returns the last generated event
+# -----------------------------------------------------------------------------
+sub event {
+	my( $self, $evt ) = @_;
+	$self->{event} = $evt if $evt;
+	return $self->{event};
+}
+
+# -----------------------------------------------------------------------------
+# Destroys the transaction and disconnects where necessary,
+# then returns the last event that occurred
+# -----------------------------------------------------------------------------
+sub die_event {
+	my $self = shift;
+    my $evt = shift;
+	$self->rollback;
+    $self->died(1);
+    $self->event($evt);
+	return $self->event;
+}
+
+
+# -----------------------------------------------------------------------------
+# Clears the last caught event
+# -----------------------------------------------------------------------------
+sub clear_event {
+	my $self = shift;
+	$self->{event} = undef;
+}
+
+sub died {
+    my($self, $died) = @_;
+    $self->{died} = $died if defined $died;
+    return $self->{died};
+}
+
+sub authtoken {
+	my( $self, $auth ) = @_;
+	$self->{authtoken} = $auth if $auth;
+	return $self->{authtoken};
+}
+
+sub timeout {
+    my($self, $to) = @_;
+    $self->{timeout} = $to if defined $to;
+    return defined($self->{timeout}) ? $self->{timeout} : 60;
+}
+
+# -----------------------------------------------------------------------------
+# fetches the session, creating if necessary.  If 'xact' is true on this
+# object, a db session is created
+# -----------------------------------------------------------------------------
+sub session {
+	my( $self, $session ) = @_;
+	$self->{session} = $session if $session;
+
+	if(!$self->{session}) {
+		$self->{session} = OpenSRF::AppSession->create($self->app);
+
+		if( ! $self->{session} ) {
+			my $str = "Error creating cstore session with OpenSRF::AppSession->create()!";
+			$self->log(E, $str);
+			throw OpenSRF::EX::ERROR ($str);
+		}
+
+		$self->{session}->connect if $self->{xact} or $self->{connect} or $always_xact;
+		$self->xact_begin if $self->{xact} or $always_xact;
+	}
+
+    $xact_ed_cache{$self->{xact_id}} = $self if $always_xact and $self->{xact_id};
+	return $self->{session};
+}
+
+
+# -----------------------------------------------------------------------------
+# Starts a storage transaction
+# -----------------------------------------------------------------------------
+sub xact_begin {
+    my $self = shift;
+    return $self->{xact_id} if $self->{xact_id};
+    $self->session->connect unless $self->session->state == OpenSRF::AppSession::CONNECTED();
+	$self->log(D, "starting new database transaction");
+	unless($self->{xact_id}) {
+	    my $stat = $self->request($self->app . '.transaction.begin');
+	    $self->log(E, "error starting database transaction") unless $stat;
+        $self->{xact_id} = $stat;
+    }
+    $self->{xact} = 1;
+    return $self->{xact_id};
+}
+
+# -----------------------------------------------------------------------------
+# Commits a storage transaction
+# -----------------------------------------------------------------------------
+sub xact_commit {
+	my $self = shift;
+    return unless $self->{xact_id};
+	$self->log(D, "comitting db session");
+	my $stat = $self->request($self->app.'.transaction.commit');
+	$self->log(E, "error comitting database transaction") unless $stat;
+    delete $self->{xact_id};
+    delete $self->{xact};
+	return $stat;
+}
+
+# -----------------------------------------------------------------------------
+# Rolls back a storage stransaction
+# -----------------------------------------------------------------------------
+sub xact_rollback {
+	my $self = shift;
+    return unless $self->{session} and $self->{xact_id};
+	$self->log(I, "rolling back db session");
+	my $stat = $self->request($self->app.".transaction.rollback");
+	$self->log(E, "error rolling back database transaction") unless $stat;
+    delete $self->{xact_id};
+    delete $self->{xact};
+	return $stat;
+}
+
+
+# -----------------------------------------------------------------------------
+# Savepoint functions.  If no savepoint name is provided, the same name is used 
+# for each successive savepoint, in which case only the last savepoint set can 
+# be released or rolled back.
+# -----------------------------------------------------------------------------
+sub set_savepoint {
+    my $self = shift;
+    my $name = shift || 'savepoint';
+    return unless $self->{session} and $self->{xact_id};
+	$self->log(I, "setting savepoint '$name'");
+	my $stat = $self->request($self->app.".savepoint.set", $name)
+	    or $self->log(E, "error setting savepoint '$name'");
+    return $stat;
+}
+
+sub release_savepoint {
+    my $self = shift;
+    my $name = shift || 'savepoint';
+    return unless $self->{session} and $self->{xact_id};
+	$self->log(I, "releasing savepoint '$name'");
+	my $stat = $self->request($self->app.".savepoint.release", $name)
+        or $self->log(E, "error releasing savepoint '$name'");
+    return $stat;
+}
+
+sub rollback_savepoint {
+    my $self = shift;
+    my $name = shift || 'savepoint';
+    return unless $self->{session} and $self->{xact_id};
+	$self->log(I, "rollback savepoint '$name'");
+	my $stat = $self->request($self->app.".savepoint.rollback", $name)
+        or $self->log(E, "error rolling back savepoint '$name'");
+    return $stat;
+}
+
+
+# -----------------------------------------------------------------------------
+# Rolls back the transaction and disconnects
+# -----------------------------------------------------------------------------
+sub rollback {
+	my $self = shift;
+    my $err;
+    my $ret;
+	try {
+        $self->xact_rollback;
+    } catch Error with  {
+        $err = shift
+    } finally {
+        $ret = $self->disconnect
+    };
+    throw $err if ($err);
+    return $ret;
+}
+
+sub disconnect {
+	my $self = shift;
+	$self->session->disconnect if 
+        $self->{session} and 
+        $self->{session}->state == OpenSRF::AppSession::CONNECTED();
+    delete $self->{session};
+}
+
+
+# -----------------------------------------------------------------------------
+# commits the db session and destroys the session
+# returns the status of the commit call
+# -----------------------------------------------------------------------------
+sub commit {
+	my $self = shift;
+	return unless $self->{xact_id};
+	my $stat = $self->xact_commit;
+    $self->disconnect;
+    return $stat;
+}
+
+# -----------------------------------------------------------------------------
+# clears all object data. Does not commit the db transaction.
+# -----------------------------------------------------------------------------
+sub reset {
+	my $self = shift;
+	$self->disconnect;
+	$$self{$_} = undef for (keys %$self);
+}
+
+
+# -----------------------------------------------------------------------------
+# commits and resets
+# -----------------------------------------------------------------------------
+sub finish {
+	my $self = shift;
+    my $err;
+    my $ret;
+	try {
+        $self->commit;
+    } catch Error with  {
+        $err = shift
+    } finally {
+        $ret = $self->reset
+    };
+    throw $err if ($err);
+    return $ret;
+}
+
+
+
+# -----------------------------------------------------------------------------
+# Does a simple storage request
+# -----------------------------------------------------------------------------
+sub request {
+	my( $self, $method, @params ) = @_;
+
+    my $val;
+	my $err;
+	my $argstr = __arg_to_string( (scalar(@params)) == 1 ? $params[0] : \@params);
+	my $locale = $self->session->session_locale;
+
+	$self->log(I, "request $locale $method $argstr");
+
+	if( ($self->{xact} or $always_xact) and 
+			$self->session->state != OpenSRF::AppSession::CONNECTED() ) {
+		#$logger->error("CStoreEditor lost it's connection!!");
+		throw OpenSRF::EX::ERROR ("CStore connection timed out - transaction cannot continue");
+	}
+
+
+	try {
+
+        my $req = $self->session->request($method, @params);
+
+        if($self->substream) {
+            $self->log(D,"running in substream mode");
+            $val = [];
+            while( my $resp = $req->recv(timeout => $self->timeout) ) {
+                push(@$val, $resp->content) if $resp->content and not $self->discard;
+            }
+
+        } else {
+            my $resp = $req->recv(timeout => $self->timeout);
+            if($req->failed) {
+                $err = $resp;
+		        $self->log(E, "request error $method : $argstr : $err");
+            } else {
+                $val = $resp->content if $resp;
+            }
+        }
+
+        $req->finish;
+
+	} catch Error with {
+		$err = shift;
+		$self->log(E, "request error $method : $argstr : $err");
+	};
+
+	throw $err if $err;
+	return $val;
+}
+
+sub substream {
+   my( $self, $bool ) = @_;
+   $self->{substream} = $bool if defined $bool;
+   return $self->{substream};
+}
+
+# -----------------------------------------------------------------------------
+# discard response data instead of returning it to the caller.  currently only 
+# works in conjunction with substream mode.  
+# -----------------------------------------------------------------------------
+sub discard {
+   my( $self, $bool ) = @_;
+   $self->{discard} = $bool if defined $bool;
+   return $self->{discard};
+}
+
+
+# -----------------------------------------------------------------------------
+# Sets / Returns the requestor object.  This is set when checkauth succeeds.
+# -----------------------------------------------------------------------------
+sub requestor {
+	my($self, $requestor) = @_;
+	$self->{requestor} = $requestor if $requestor;
+	return $self->{requestor};
+}
+
+
+
+# -----------------------------------------------------------------------------
+# Holds the last data received from a storage call
+# -----------------------------------------------------------------------------
+sub data {
+	my( $self, $data ) = @_;
+	$self->{data} = $data if defined $data;
+	return $self->{data};
+}
+
+
+# -----------------------------------------------------------------------------
+# True if this perm has already been checked at this org
+# -----------------------------------------------------------------------------
+sub perm_checked {
+	my( $self, $perm, $org ) = @_;
+	$self->{checked_perms}->{$org} = {}
+		unless $self->{checked_perms}->{$org};
+	my $checked = $self->{checked_perms}->{$org}->{$perm};
+	if(!$checked) {
+		$self->{checked_perms}->{$org}->{$perm} = 1;
+		return 0;
+	}
+	return 1;
+}
+
+
+
+# -----------------------------------------------------------------------------
+# Returns true if the requested perm is allowed.  If the perm check fails,
+# $e->event is set and undef is returned
+# The perm user is $e->requestor->id and perm org defaults to the requestor's
+# ws_ou
+# if perm is an array of perms, method will return true at the first allowed
+# permission.  If none of the perms are allowed, the perm_failure event
+# is created with the last perm to fail
+# -----------------------------------------------------------------------------
+my $PERM_QUERY = {
+    select => {
+        au => [ {
+            transform => 'permission.usr_has_perm',
+            alias => 'has_perm',
+            column => 'id',
+            params => []
+        } ]
+    },
+    from => 'au',
+    where => {},
+};
+
+my $OBJECT_PERM_QUERY = {
+    select => {
+        au => [ {
+            transform => 'permission.usr_has_object_perm',
+            alias => 'has_perm',
+            column => 'id',
+            params => []
+        } ]
+    },
+    from => 'au',
+    where => {},
+};
+
+sub allowed {
+	my( $self, $perm, $org, $object, $hint ) = @_;
+	my $uid = $self->requestor->id;
+	$org ||= $self->requestor->ws_ou;
+
+    my $perms = (ref($perm) eq 'ARRAY') ? $perm : [$perm];
+
+    for $perm (@$perms) {
+	    $self->log(I, "checking perms user=$uid, org=$org, perm=$perm");
+    
+        if($object) {
+            my $params;
+            if(ref $object) {
+                # determine the ID field and json_hint from the object
+                my $id_field = $object->Identity;
+                $params = [$perm, $object->json_hint, $object->$id_field];
+            } else {
+                # we were passed an object-id and json_hint
+                $params = [$perm, $hint, $object];
+            }
+            push(@$params, $org) if $org;
+            $OBJECT_PERM_QUERY->{select}->{au}->[0]->{params} = $params;
+            $OBJECT_PERM_QUERY->{where}->{id} = $uid;
+            return 1 if $U->is_true($self->json_query($OBJECT_PERM_QUERY)->[0]->{has_perm});
+
+        } else {
+            $PERM_QUERY->{select}->{au}->[0]->{params} = [$perm, $org];
+            $PERM_QUERY->{where}->{id} = $uid;
+            return 1 if $U->is_true($self->json_query($PERM_QUERY)->[0]->{has_perm});
+        }
+    }
+
+    # set the perm failure event if the permission check returned false
+	my $e = OpenILS::Event->new('PERM_FAILURE', ilsperm => $perm, ilspermloc => $org);
+	$self->event($e);
+	return undef;
+}
+
+
+# -----------------------------------------------------------------------------
+# Returns the list of object IDs this user has object-specific permissions for
+# -----------------------------------------------------------------------------
+sub objects_allowed {
+    my($self, $perm, $obj_type) = @_;
+
+    my $perms = (ref($perm) eq 'ARRAY') ? $perm : [$perm];
+    my @ids;
+
+    for $perm (@$perms) {
+        my $query = {
+            select => {puopm => ['object_id']},
+            from => {
+                puopm => {
+                    ppl => {field => 'id',fkey => 'perm'}
+                }
+            },
+            where => {
+                '+puopm' => {usr => $self->requestor->id, object_type => $obj_type},
+                '+ppl' => {code => $perm}
+            }
+        };
+    
+        my $list = $self->json_query($query);
+        push(@ids, 0+$_->{object_id}) for @$list;
+    }
+
+   my %trim;
+   $trim{$_} = 1 for @ids;
+   return [ keys %trim ];
+}
+
+
+# -----------------------------------------------------------------------------
+# checks the appropriate perm for the operation
+# -----------------------------------------------------------------------------
+sub _checkperm {
+	my( $self, $ptype, $action, $org ) = @_;
+	$org ||= $self->requestor->ws_ou;
+	my $perm = $PERMS{$ptype}{$action};
+	if( $perm ) {
+		return undef if $self->perm_checked($perm, $org);
+		return $self->event unless $self->allowed($perm, $org);
+	} else {
+		$self->log(I, "no perm provided for $ptype.$action");
+	}
+	return undef;
+}
+
+
+
+# -----------------------------------------------------------------------------
+# Logs update actions to the activity log
+# -----------------------------------------------------------------------------
+sub log_activity {
+	my( $self, $type, $action, $arg ) = @_;
+	my $str = "$type.$action";
+	$str .= _prop_string($arg);
+	$self->log(A, $str);
+}
+
+
+
+sub _prop_string {
+	my $obj = shift;
+	my @props = $obj->properties;
+	my $str = "";
+	for(@props) {
+		my $prop = $obj->$_() || "";
+		$prop = substr($prop, 0, 128) . "..." if length $prop > 131;
+		$str .= " $_=$prop";
+	}
+	return $str;
+}
+
+
+sub __arg_to_string {
+	my $arg = shift;
+	return "" unless defined $arg;
+	if( UNIVERSAL::isa($arg, "Fieldmapper") ) {
+        my $idf = $arg->Identity;
+		return (defined $arg->$idf) ? $arg->$idf : '';
+	}
+	return OpenSRF::Utils::JSON->perl2JSON($arg);
+	return "";
+}
+
+
+# -----------------------------------------------------------------------------
+# This does the actual storage query.
+#
+# 'search' calls become search_where calls and $arg can be a search hash or
+# an array-ref of storage search options.  
+#
+# 'retrieve' expects an id
+# 'update' expects an object
+# 'create' expects an object
+# 'delete' expects an object
+#
+# All methods return true on success and undef on failure.  On failure, 
+# $e->event is set to the generated event.  
+# Note: this method assumes that updating a non-changed object and 
+# thereby receiving a 0 from storage, is a successful update.  
+#
+# The method will therefore return true so the caller can just do 
+# $e->update_blah($x) or return $e->event;
+# The true value returned from storage for all methods will be stored in 
+# $e->data, until the next method is called.
+#
+# not-found events are generated on retrieve and serach methods.
+# action=search methods will return [] (==true) if no data is found.  If the
+# caller is interested in the not found event, they can do:  
+# return $e->event unless @$results; 
+# -----------------------------------------------------------------------------
+sub runmethod {
+	my( $self, $action, $type, $arg, $options ) = @_;
+
+   $options ||= {};
+
+	if( $action eq 'retrieve' ) {
+		if(! defined($arg) ) {
+			$self->log(W,"$action $type called with no ID...");
+			$self->event(_mk_not_found($type, $arg));
+			return undef;
+		} elsif( ref($arg) =~ /Fieldmapper/ ) {
+			$self->log(D,"$action $type called with an object.. attempting Identity retrieval..");
+            my $idf = $arg->Identity;
+			$arg = $arg->$idf;
+		}
+	}
+
+	my @arg = ( ref($arg) eq 'ARRAY' ) ? @$arg : ($arg);
+	my $method = $self->app.".direct.$type.$action";
+
+	if( $action eq 'search' ) {
+		$method .= '.atomic';
+
+	} elsif( $action eq 'batch_retrieve' ) {
+		$action = 'search';
+		@arg = ( { id => $arg } );
+		$method =~ s/batch_retrieve/search/o;
+		$method .= '.atomic';
+
+	} elsif( $action eq 'retrieve_all' ) {
+		$action = 'search';
+		$method =~ s/retrieve_all/search/o;
+		my $tt = $type;
+		$tt =~ s/\./::/og;
+		my $fmobj = "Fieldmapper::$tt";
+		@arg = ( { $fmobj->Identity => { '!=' => undef } } );
+		$method .= '.atomic';
+	}
+
+	$method =~ s/search/id_list/o if $options->{idlist};
+
+    $method =~ s/\.atomic$//o if $self->substream($$options{substream} || 0);
+    $self->timeout($$options{timeout});
+    $self->discard($$options{discard});
+
+	# remove any stale events
+	$self->clear_event;
+
+	if( $action eq 'update' or $action eq 'delete' or $action eq 'create' ) {
+		if(!($self->{xact} or $always_xact)) {
+			$logger->error("Attempt to update DB while not in a transaction : $method");
+			throw OpenSRF::EX::ERROR ("Attempt to update DB while not in a transaction : $method");
+		}
+		$self->log_activity($type, $action, $arg);
+	}
+
+	if($$options{checkperm}) {
+		my $a = ($action eq 'search') ? 'retrieve' : $action;
+		my $e = $self->_checkperm($type, $a, $$options{permorg});
+		if($e) {
+			$self->event($e);
+			return undef;
+		}
+	}
+
+	my $obj; 
+	my $err = '';
+
+	try {
+		$obj = $self->request($method, @arg);
+	} catch Error with { $err = shift; };
+	
+
+	if(!defined $obj) {
+		$self->log(I, "request returned no data : $method");
+
+		if( $action eq 'retrieve' ) {
+			$self->event(_mk_not_found($type, $arg));
+
+		} elsif( $action eq 'update' or 
+				$action eq 'delete' or $action eq 'create' ) {
+			my $evt = OpenILS::Event->new(
+				'DATABASE_UPDATE_FAILED', payload => $arg, debug => "$err" );
+			$self->event($evt);
+		}
+
+		if( $err ) {
+			$self->event( 
+				OpenILS::Event->new( 'DATABASE_QUERY_FAILED', 
+					payload => $arg, debug => "$err" ));
+			return undef;
+		}
+
+		return undef;
+	}
+
+	if( $action eq 'create' and $obj == 0 ) {
+		my $evt = OpenILS::Event->new(
+			'DATABASE_UPDATE_FAILED', payload => $arg, debug => "$err" );
+		$self->event($evt);
+		return undef;
+	}
+
+	# If we havn't dealt with the error in a nice way, go ahead and throw it
+	if( $err ) {
+		$self->event( 
+			OpenILS::Event->new( 'DATABASE_QUERY_FAILED', 
+				payload => $arg, debug => "$err" ));
+		return undef;
+	}
+
+	if( $action eq 'search' ) {
+		$self->log(I, "$type.$action : returned ".scalar(@$obj). " result(s)");
+		$self->event(_mk_not_found($type, $arg)) unless @$obj;
+	}
+
+	if( $action eq 'create' ) {
+        my $idf = $obj->Identity;
+		$self->log(I, "created a new $type object with Identity " . $obj->$idf);
+		$arg->$idf($obj->$idf);
+	}
+
+	$self->data($obj); # cache the data for convenience
+
+	return ($obj) ? $obj : 1;
+}
+
+
+sub _mk_not_found {
+	my( $type, $arg ) = @_;
+	(my $t = $type) =~ s/\./_/og;
+	$t = uc($t);
+	return OpenILS::Event->new("${t}_NOT_FOUND", payload => $arg);
+}
+
+
+
+# utility method for loading
+sub __fm2meth { 
+	my $str = shift;
+	my $sep = shift;
+	$str =~ s/Fieldmapper:://o;
+	$str =~ s/::/$sep/g;
+	return $str;
+}
+
+
+# -------------------------------------------------------------
+# Load up the methods from the FM classes
+# -------------------------------------------------------------
+
+sub init {
+    no warnings;    #  Here we potentially redefine subs via eval
+    my $map = $Fieldmapper::fieldmap;
+    for my $object (keys %$map) {
+        my $obj  = __fm2meth($object, '_');
+        my $type = __fm2meth($object, '.');
+        foreach my $command (qw/ update retrieve search create delete batch_retrieve retrieve_all /) {
+            eval "sub ${command}_$obj {return shift()->runmethod('$command', '$type', \@_);}\n";
+        }
+        # TODO: performance test against concatenating a big string of all the subs and eval'ing only ONCE.
+    }
+}
+
+init();  # Add very many subs to this namespace
+
+sub json_query {
+    my( $self, $arg, $options ) = @_;
+    $options ||= {};
+	my @arg = ( ref($arg) eq 'ARRAY' ) ? @$arg : ($arg);
+    my $method = $self->app.'.json_query.atomic';
+    $method =~ s/\.atomic$//o if $self->substream($$options{substream} || 0);
+
+    $self->timeout($$options{timeout});
+    $self->discard($$options{discard});
+	$self->clear_event;
+    my $obj;
+    my $err;
+    
+    try {
+        $obj = $self->request($method, @arg);
+    } catch Error with { $err = shift; };
+
+    if( $err ) {
+        $self->event(
+            OpenILS::Event->new( 'DATABASE_QUERY_FAILED',
+            payload => $arg, debug => "$err" ));
+        return undef;
+    }
+
+    $self->log(I, "json_query : returned ".scalar(@$obj). " result(s)") if (ref($obj));
+    return $obj;
+}
+
+
+
+1;
+
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/Cronscript.pm.in b/Open-ILS/src/perlmods/lib/OpenILS/Utils/Cronscript.pm.in
new file mode 100644
index 0000000000..73281fbc60
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/Cronscript.pm.in
@@ -0,0 +1,371 @@
+package OpenILS::Utils::Cronscript;
+
+# ---------------------------------------------------------------
+# Copyright (C) 2010 Equinox Software, Inc
+# Author: Joe Atzberger 
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# ---------------------------------------------------------------
+
+# The purpose of this module is to consolidate the common aspects
+# of various cron tasks that all need the same things:
+#    ~ non-duplicative processing, i.e. lockfiles and lockfile checking
+#    ~ opensrf_core.xml file location 
+#    ~ common options like help and debug
+
+use strict;
+use warnings;
+
+use Getopt::Long qw(:DEFAULT GetOptionsFromArray);
+use OpenSRF::System;
+use OpenSRF::AppSession;
+use OpenSRF::Utils::JSON;
+use OpenSRF::EX qw(:try);
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Utils::Lockfile;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+
+use File::Basename qw/fileparse/;
+
+use Data::Dumper;
+use Carp;
+
+our @extra_opts = (     # additional keys are stored here
+    # 'addlopt'
+);
+
+our $debug = 0;
+
+sub _default_self {
+    return {
+    #   opts       => {},
+    #   opts_clean => {},
+    #   default_opts_clean => {},
+        default_opts       => {
+            'lock-file=s'   => OpenILS::Utils::Lockfile::default_filename,
+            'osrf-config=s' => '@sysconfdir@/opensrf_core.xml',
+            'debug'         => 0,
+            'verbose+'      => 0,
+            'help'          => 0,
+          # 'internal_var'  => 'XYZ',
+        },
+    #   lockfile => undef,
+    #   session => undef,
+    #   bootstrapped => 0,
+    #   got_options => 0,
+        auto_get_options_4_bootstrap => 1,
+    };
+}
+
+sub is_clean {
+    my $key = shift   or  return 1;
+    $key =~ /[=:].*$/ and return 0;
+    $key =~ /[+!]$/   and return 0;
+    return 1;
+}
+
+sub clean {
+    my $key = shift or return;
+    $key =~ s/[=:].*$//;
+    $key =~ s/[+!]$//;
+    return $key;
+}
+
+sub fuzzykey {                      # when you know the hash you want from, but not the exact key
+    my $self = shift or return;
+    my $key  = shift or return;
+    my $target = @_ ? shift : 'opts_clean';
+    foreach (map {clean($_)} keys %{$self->{default_opts}}) {  # TODO: cache
+        $key eq $_ and return $self->{$target}->{$_};
+    }
+}
+
+# MyGetOptions
+# A wrapper around GetOptions
+# {opts} does two things for GetOptions (see Getopt::Long)
+#  (1) maps command-line options to the *other* variables where values are stored (in opts_clean)
+#  (2) provides hashspace for the rest of the arbitrary options from the command-line
+#
+# TODO: allow more options to be passed here, maybe mimic Getopt::Long::GetOptions style
+#
+# If an arrayref argument is passed, then @ARGV will NOT be touched.
+# Instead, the array will be passed to GetOptionsFromArray.
+#
+
+sub MyGetOptions {
+    my $self = shift;
+    my $arrayref = @_ ? shift : undef;
+    if ($arrayref and ref($arrayref) ne 'ARRAY') {
+        carp "MyGetOptions argument is not an array ref.  Expect GetOptionsFromArray to explode";
+    }
+    $self->{got_options} and carp "MyGetOptions called after options were already retrieved previously";
+    my @keys = sort {is_clean($b) <=> is_clean($a)} keys %{$self->{default_opts}};
+    $debug and print "KEYS: ", join(", ", @keys), "\n";
+    foreach (@keys) {
+        my $clean = clean($_);
+        my $place = $self->{default_opts_clean}->{$clean};
+        $self->{opts_clean}->{$clean} = $place;  # prepopulate default
+        # $self->{opts}->{$_} = $self->{opts_clean}->{$clean};                 # pointer for GetOptions
+        $self->{opts}->{$_} = sub {
+            my $opt = shift;
+            my $val = shift;
+            ref ( $self->{opts_clean}->{$opt} ) and ref($self->{opts_clean}->{$opt}) eq 'SCALAR'
+            and ${$self->{opts_clean}->{$opt}} = $val;  # set the referent's value
+            $self->{opts_clean}->{$opt} = $val;     # burn the map, stick the value there
+        };                 # pointer for GetOptions
+    }
+    $arrayref  ? GetOptionsFromArray($arrayref, $self->{opts}, @keys)
+               : GetOptions(                    $self->{opts}, @keys) ;
+   
+    foreach (@keys) {
+        delete $self->{opts}->{$_};     # now remove the mappings from (1) so we just have (2)
+    }
+    $self->clean_mirror('opts');        # populate clean_opts w/ cleaned versions of (2), plus everything else
+
+    print $self->help() and exit if $self->{opts_clean}->{help};
+    $self->new_lockfile();
+    $self->{got_options}++;
+    return wantarray ? %{$self->{opts_clean}} : $self->{opts_clean};
+}
+
+sub new_lockfile {
+    my $self = shift;
+    $debug and $OpenILS::Utils::Lockfile::debug = $debug;
+    unless ($self->{opts_clean}->{nolockfile} || $self->{default_opts_clean}->{nolockfile}) {
+        $self->{lockfile_obj} = OpenILS::Utils::Lockfile->new($self->first_defined('lock-file'));
+        $self->{lockfile}     = $self->{lockfile_obj}->filename;
+    }
+}
+
+sub first_defined {
+    my $self = shift;
+    my $key  = shift or return;
+    foreach (qw(opts_clean opts default_opts_clean default_opts)) {
+        defined $self->{$_}->{$key} and return $self->{$_}->{$key};
+    }
+    return;
+}
+
+sub clean_mirror {
+    my $self  = shift;
+    my $dirty = @_ ? shift : 'default_opts';
+    foreach (keys %{$self->{$dirty}}) {
+        defined $self->{$dirty}->{$_} or next;
+        $self->{$dirty . '_clean'}->{clean($_)} = $self->{$dirty}->{$_};
+    }
+}
+
+sub new {
+    my $class = shift;
+    my $self  = _default_self;
+    bless ($self, $class);
+    $self->init(@_);
+    $debug and print "new ",  __PACKAGE__, " obj: ", Dumper($self);
+    return $self;
+}
+
+sub add_and_purge {
+    my $self = shift;
+    my $key  = shift;
+    my $val  = shift;
+    my $clean = clean($key);
+    my @others = grep {/$clean/ and $_ ne $key} keys %{$self->{default_opts}};
+    unless (@others) {
+        $debug and print "unique key $key => $val\n";
+        $self->{default_opts}->{$key} = $val;   # no purge, just add
+        return;
+    }
+    foreach (@others) {
+        $debug and print "variant of $key => $_\n";
+        if ($key ne $clean) {    # if it is a dirtier key, delete the clean one
+            delete $self->{default_opts}->{$_};
+            $self->{default_opts}->{$key} = $val;
+        } else {                 # else update the dirty one
+            $self->{default_opts}->{$_} = $val;
+        }
+    }
+}
+
+sub init {      # not INIT
+    my $self = shift;
+    my $opts  = @_ ? shift : {};    # user can specify more default options to constructor
+# TODO: check $opts is hashref; then check verbose/debug first.  maybe check negations e.g. "no-verbose" ?
+    @extra_opts = keys %$opts;
+    foreach (@extra_opts) {        # add any other keys w/ default values
+        $debug and print "init() adding option $_, default value: $opts->{$_}\n";
+        $self->add_and_purge($_, $opts->{$_});
+    }
+    $self->clean_mirror;
+    return $self;
+}
+
+sub usage {
+    # my $self = shift;
+    return "\nUSAGE: $0 [OPTIONS]";
+}
+
+sub options_help {
+    my $self = shift;
+    my $chunk = @_ ? shift : '';
+    return <  Default: $self->{default_opts_clean}->{'osrf-config'}
+                 Specify OpenSRF core config file.
+
+    --lock-file       Default: $self->{default_opts_clean}->{'lock-file'}
+                 Specify lock file.     
+
+HELP
+    . $chunk . <usage() . "\n" . $self->options_help(@_) . $self->example();
+}
+
+sub example {
+    return "\n\nEXAMPLES:\n\n    $0 --osrf-config /my/other/opensrf_core.xml\n";
+}
+
+# the proper order is: MyGetOptions, bootstrap, session.
+# But the latter subs will check to see if they need to call the preceeding one(s).  
+
+sub session {
+    my $self = shift or return;
+    $self->{bootstrapped} or $self->bootstrap();
+    @_ or croak "session() called without required argument (app_name, e.g. 'open-ils.acq')";
+    return ($self->{session} ||= OpenSRF::AppSession->create(@_));
+}
+
+sub bootstrap {
+    my $self = shift or return;
+    if ($self->{auto_get_options_4_bootstrap} and not $self->{got_options}) {
+        $debug and print "Automatically calling MyGetOptions before bootstrap\n";
+        $self->MyGetOptions();
+    }
+    try {
+        $debug and print "bootstrap lock-file  : ", $self->first_defined('lock-file'), "\n";
+        $debug and print "bootstrap osrf-config: ", $self->first_defined('osrf-config'), "\n";
+        OpenSRF::System->bootstrap_client(config_file => $self->first_defined('osrf-config'));
+        Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL"));
+        $self->{bootstrapped} = 1;
+    } otherwise {
+        $self->{bootstrapped} = 0;
+        warn shift;
+    };
+}
+
+sub editor_init {
+    my $self = shift or return;
+    OpenILS::Utils::CStoreEditor::init();   # no return value to check
+    $self->{editor_inited} = 1;
+}
+
+sub editor {
+    my $self = shift or return;
+    $self->{bootstrapped}  or $self->bootstrap();
+    $self->{editor_inited} or $self->editor_init();
+    return new_editor(@_);
+}
+
+1;
+__END__
+
+=pod
+
+=head1 NAME
+
+OpenILS::Utils::Cronscript - Consolidated options handling for any script (not just cron, really)
+
+=head1 SYNOPSIS
+
+    use OpenILS::Utils::Cronscript;
+
+    my %defaults = (
+        'min=i'      => 0,          # keys are Getopt::Long style options
+        'max=i'      => 999,        # values are default values
+        'user=s'     => 'admin',
+        'password=s' => '',
+        'nolockfile' => 1,
+    };
+
+    my $core = OpenILS::Utils::Cronscript->new(\%defaults);
+    my $opts = $core->MyGetOptions();   # options now in, e.g.: $opts->{max}
+    $core->bootstrap;
+
+Or if you don't need any additional options and just want to get a session going:
+    
+    use OpenILS::Utils::Cronscript;
+    my $session = OpenILS::Utils::Cronscript->new()->session('open-ils.acq');
+
+=head1 DESCRIPTION
+
+There are a few main problems when writing a new script for Evergreen. 
+
+=head2 Initialization
+
+The runtime 
+environment for the application requires a lot of initialization, but during normal operation it
+has already occured (when Evergreen was started).  So most of the EG code never has to deal with 
+this problem, but standalone scripts do.  The timing and sequence of requisite events is important and not obvious.
+
+=head2 Common Options, Consistent Options
+
+We need several common options for each script that accesses the database or
+uses EG data objects and methods.  Logically, these options often deal with initialization.  They
+should take the B same form(s) for each script and should not be 
+dependent on the local author to copy and paste them from some reference source.  We really don't want to encourage (let alone force)
+admins to use C<--config>, C<--osrf-confg>, C<-c>, and C<@ARGV[2]> for the same purpose in different scripts, with different
+default handling, help descriptions and error messages (or lack thereof).
+
+This suggests broader problem of UI consistency and uniformity, also partially addressed by this module.
+
+=head2 Lockfiles
+
+A lockfile is necessary for a script that wants to prevent possible simultaneous execution.  For example, consider a script 
+that is scheduled to run frequently, but that experiences occasional high load: you wouldn't want crontab to start running
+it again if the first instance had not yet finished.  
+
+But the code for creating, writing to, checking for, reading and cleaning up a lockfile for the script bloats what might otherwise be a terse 
+method call.  Conscript handles lockfile generation and removal automatically.
+
+=head1 OPTIONS
+
+The common options (and default values) are:
+
+    'lock-file=s'   => OpenILS::Utils::Lockfile::default_filename,
+    'osrf-config=s' => '/openils/conf/opensrf_core.xml',
+    'debug'         => 0,
+    'verbose+'      => 0,
+    'help'          => 0,
+
+=head1 TODO 
+
+More docs here.
+
+=head1 SEE ALSO
+
+    Getopt::Long
+    OpenILS::Utils::Lockfile
+    oils_header.pl
+
+=head1 AUTHOR
+
+Joe Atzberger 
+
+=cut
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/Editor.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/Editor.pm
new file mode 100644
index 0000000000..801faff550
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/Editor.pm
@@ -0,0 +1,532 @@
+use strict; use warnings;
+package OpenILS::Utils::Editor;
+use OpenILS::Application::AppUtils;
+use OpenSRF::AppSession;
+use OpenSRF::EX qw(:try);
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Event;
+use Data::Dumper;
+use OpenSRF::Utils::JSON;
+use OpenSRF::Utils::Logger qw($logger);
+my $U = "OpenILS::Application::AppUtils";
+
+
+# -----------------------------------------------------------------------------
+# Export some useful functions
+# -----------------------------------------------------------------------------
+use vars qw(@EXPORT_OK %EXPORT_TAGS);
+use Exporter;
+use base qw/Exporter/;
+push @EXPORT_OK, 'new_editor';
+%EXPORT_TAGS = ( funcs => [ qw/ new_editor / ] );
+
+sub new_editor { return OpenILS::Utils::Editor->new(@_); }
+
+
+# -----------------------------------------------------------------------------
+# These need to be auto-generated
+# -----------------------------------------------------------------------------
+my %PERMS = (
+    'biblio.record_entry' => { update   => 'UPDATE_MARC'       },
+    'asset.copy'          => { update   => 'UPDATE_COPY'       },
+    'asset.call_number'   => { update   => 'UPDATE_VOLUME'     },
+    'action.circulation'  => { retrieve => 'VIEW_CIRCULATIONS' },
+);
+
+use constant E => 'error';
+use constant W => 'warn';
+use constant I => 'info';
+use constant D => 'debug';
+use constant A => 'activity';
+
+
+
+# -----------------------------------------------------------------------------
+# Params include:
+#	xact=> : creates a storage transaction
+#	authtoken=>$token : the login session key
+# -----------------------------------------------------------------------------
+sub new {
+	my( $class, %params ) = @_;
+	$class = ref($class) || $class;
+	my $self = bless( \%params, $class );
+	$self->{checked_perms} = {};
+	return $self;
+}
+
+# -----------------------------------------------------------------------------
+# Log the editor metadata along with the log string
+# -----------------------------------------------------------------------------
+sub log {
+	my( $self, $lev, $str ) = @_;
+	my $s = "editor[";
+	$s .= "0|" unless $self->{xact};
+	$s .= "1|" if $self->{xact};
+	$s .= "0" unless $self->requestor;
+	$s .= $self->requestor->id if $self->requestor;
+	$s .= "]";
+	$logger->$lev("$s $str");
+}
+
+# -----------------------------------------------------------------------------
+# Verifies the auth token and fetches the requestor object
+# -----------------------------------------------------------------------------
+sub checkauth {
+	my $self = shift;
+	$self->log(D, "checking auth token ".$self->authtoken);
+	my ($reqr, $evt) = $U->checkses($self->authtoken);
+	$self->event($evt) if $evt;
+	return $self->{requestor} = $reqr;
+}
+
+
+# -----------------------------------------------------------------------------
+# Returns the last generated event
+# -----------------------------------------------------------------------------
+sub event {
+	my( $self, $evt ) = @_;
+	$self->{event} = $evt if $evt;
+	return $self->{event};
+}
+
+# -----------------------------------------------------------------------------
+# Clears the last caught event
+# -----------------------------------------------------------------------------
+sub clear_event {
+	my $self = shift;
+	$self->{event} = undef;
+}
+
+sub authtoken {
+	my( $self, $auth ) = @_;
+	$self->{authtoken} = $auth if $auth;
+	return $self->{authtoken};
+}
+
+# -----------------------------------------------------------------------------
+# fetches the session, creating if necessary.  If 'xact' is true on this
+# object, a db session is created
+# -----------------------------------------------------------------------------
+sub session {
+	my( $self, $session ) = @_;
+	$self->{session} = $session if $session;
+
+	if(!$self->{session}) {
+		$self->{session} = OpenSRF::AppSession->create('open-ils.storage');
+
+		if( ! $self->{session} ) {
+			my $str = "Error creating storage session with OpenSRF::AppSession->create()!";
+			$self->log(E, $str);
+			throw OpenSRF::EX::ERROR ($str);
+		}
+
+		$self->{session}->connect if $self->{xact} or $self->{connect};
+		$self->xact_start if $self->{xact};
+	}
+	return $self->{session};
+}
+
+
+# -----------------------------------------------------------------------------
+# Starts a storage transaction
+# -----------------------------------------------------------------------------
+sub xact_start {
+	my $self = shift;
+	$self->log(D, "starting new db session");
+	my $stat = $self->request('open-ils.storage.transaction.begin');
+	$self->log(E, "error starting database transaction") unless $stat;
+	return $stat;
+}
+
+# -----------------------------------------------------------------------------
+# Commits a storage transaction
+# -----------------------------------------------------------------------------
+sub xact_commit {
+	my $self = shift;
+	$self->log(D, "comitting db session");
+	my $stat = $self->request('open-ils.storage.transaction.commit');
+	$self->log(E, "error comitting database transaction") unless $stat;
+	return $stat;
+}
+
+# -----------------------------------------------------------------------------
+# Rolls back a storage stransaction
+# -----------------------------------------------------------------------------
+sub xact_rollback {
+	my $self = shift;
+	$self->log(I, "rolling back db session");
+	return $self->request("open-ils.storage.transaction.rollback");
+}
+
+
+# -----------------------------------------------------------------------------
+# commits the db session and destroys the session
+# -----------------------------------------------------------------------------
+sub commit {
+	my $self = shift;
+	return unless $self->{xact};
+	$self->xact_commit;
+	$self->session->disconnect;
+	$self->{session} = undef;
+}
+
+# -----------------------------------------------------------------------------
+# clears all object data. Does not commit the db transaction.
+# -----------------------------------------------------------------------------
+sub reset {
+	my $self = shift;
+	$self->session->disconnect if $self->{session};
+	$$self{$_} = undef for (keys %$self);
+}
+
+
+# -----------------------------------------------------------------------------
+# commits and resets
+# -----------------------------------------------------------------------------
+sub finish {
+	my $self = shift;
+	$self->commit;
+	$self->reset;
+}
+
+
+
+# -----------------------------------------------------------------------------
+# Does a simple storage request
+# -----------------------------------------------------------------------------
+sub request {
+	my( $self, $method, @params ) = @_;
+
+	my $val;
+	my $err;
+	my $argstr = __arg_to_string( (scalar(@params)) == 1 ? $params[0] : \@params);
+
+	$self->log(I, "request $method : $argstr");
+	
+	try {
+		$val = $self->session->request($method, @params)->gather(1);
+
+	} catch Error with {
+		$err = shift;
+		$self->log(E, "request error $method : $argstr : $err");
+	};
+
+	throw $err if $err;
+	return $val;
+}
+
+
+# -----------------------------------------------------------------------------
+# Sets / Returns the requstor object.  This is set when checkauth succeeds.
+# -----------------------------------------------------------------------------
+sub requestor {
+	my($self, $requestor) = @_;
+	$self->{requestor} = $requestor if $requestor;
+	return $self->{requestor};
+}
+
+
+
+# -----------------------------------------------------------------------------
+# Holds the last data received from a storage call
+# -----------------------------------------------------------------------------
+sub data {
+	my( $self, $data ) = @_;
+	$self->{data} = $data if defined $data;
+	return $self->{data};
+}
+
+
+# -----------------------------------------------------------------------------
+# True if this perm has already been checked at this org
+# -----------------------------------------------------------------------------
+sub perm_checked {
+	my( $self, $perm, $org ) = @_;
+	$self->{checked_perms}->{$org} = {}
+		unless $self->{checked_perms}->{$org};
+	my $checked = $self->{checked_perms}->{$org}->{$perm};
+	if(!$checked) {
+		$self->{checked_perms}->{$org}->{$perm} = 1;
+		return 0;
+	}
+	return 1;
+}
+
+
+
+# -----------------------------------------------------------------------------
+# Returns true if the requested perm is allowed.  If the perm check fails,
+# $e->event is set and undef is returned
+# The perm user is $e->requestor->id and perm org defaults to the requestor's
+# ws_ou
+# If this perm at the given org has already been verified, true is returned
+# and the perm is not re-checked
+# -----------------------------------------------------------------------------
+sub allowed {
+	my( $self, $perm, $org ) = @_;
+	my $uid = $self->requestor->id;
+	$org ||= $self->requestor->ws_ou;
+	$self->log(I, "checking perms user=$uid, org=$org, perm=$perm");
+	return 1 if $self->perm_checked($perm, $org); 
+	return $self->checkperm($uid, $org, $perm);
+}
+
+sub checkperm {
+	my($self, $userid, $org, $perm) = @_;
+	my $s = $self->request(
+		"open-ils.storage.permission.user_has_perm", $userid, $perm, $org );
+
+	if(!$s) {
+		my $e = OpenILS::Event->new('PERM_FAILURE', ilsperm => $perm, ilspermloc => $org);
+		$self->event($e);
+		return undef;
+	}
+
+	return 1;
+}
+
+
+
+# -----------------------------------------------------------------------------
+# checks the appropriate perm for the operation
+# -----------------------------------------------------------------------------
+sub _checkperm {
+	my( $self, $ptype, $action, $org ) = @_;
+	$org ||= $self->requestor->ws_ou;
+	my $perm = $PERMS{$ptype}{$action};
+	if( $perm ) {
+		return undef if $self->perm_checked($perm, $org);
+		return $self->event unless $self->allowed($perm, $org);
+	} else {
+		$self->log(E, "no perm provided for $ptype.$action");
+	}
+	return undef;
+}
+
+
+
+# -----------------------------------------------------------------------------
+# Logs update actions to the activity log
+# -----------------------------------------------------------------------------
+sub log_activity {
+	my( $self, $type, $action, $arg ) = @_;
+	my $str = "$type.$action";
+	$str .= _prop_string($arg);
+	$self->log(A, $str);
+}
+
+
+
+sub _prop_string {
+	my $obj = shift;
+	my @props = $obj->properties;
+	my $str = "";
+	for(@props) {
+		my $prop = $obj->$_() || "";
+		$prop = substr($prop, 0, 128) . "..." if length $prop > 131;
+		$str .= " $_=$prop";
+	}
+	return $str;
+}
+
+
+sub __arg_to_string {
+	my $arg = shift;
+	return "" unless defined $arg;
+	return $arg->id if UNIVERSAL::isa($arg, "Fieldmapper");
+	return OpenSRF::Utils::JSON->perl2JSON($arg);
+}
+
+
+# -----------------------------------------------------------------------------
+# This does the actual storage query.
+#
+# 'search' calls become search_where calls and $arg can be a search hash or
+# an array-ref of storage search options.  
+#
+# 'retrieve' expects an id
+# 'update' expects an object
+# 'create' expects an object
+# 'delete' expects an object
+#
+# All methods return true on success and undef on failure.  On failure, 
+# $e->event is set to the generated event.  
+# Note: this method assumes that updating a non-changed object and 
+# thereby receiving a 0 from storage, is a successful update.  
+#
+# The method will therefore return true so the caller can just do 
+# $e->update_blah($x) or return $e->event;
+# The true value returned from storage for all methods will be stored in 
+# $e->data, until the next method is called.
+#
+# not-found events are generated on retrieve and serach methods.
+# action=search methods will return [] (==true) if no data is found.  If the
+# caller is interested in the not found event, they can do:  
+# return $e->event unless @$results; 
+# -----------------------------------------------------------------------------
+sub runmethod {
+	my( $self, $action, $type, $arg, $options ) = @_;
+
+	my @arg = ($arg);
+	my $method = "open-ils.storage.direct.$type.$action";
+
+	if( $action eq 'search' ) {
+		$method =~ s/search/search_where/o;
+		$method =~ s/direct/id_list/o if $options->{idlist};
+		$method = "$method.atomic";
+		@arg = @$arg if ref($arg) eq 'ARRAY';
+
+	} elsif( $action eq 'batch_retrieve' ) {
+		$method =~ s/batch_retrieve/batch.retrieve/o;
+		$method = "$method.atomic";
+		@arg = @$arg if ref($arg) eq 'ARRAY';
+
+	} elsif( $action eq 'retrieve_all' ) {
+		$method =~ s/retrieve_all/retrieve.all.atomic/o;
+	}
+
+	# remove any stale events
+	$self->clear_event;
+
+	if( $action eq 'update' or $action eq 'delete' or $action eq 'create' ) {
+		$self->log_activity($type, $action, $arg);
+	}
+
+	if($$options{checkperm}) {
+		my $a = ($action eq 'search' or 
+			$action eq 'batch_retrieve' or $action eq 'retrieve_all') ? 'retrieve' : $action;
+		my $e = $self->_checkperm($type, $a, $$options{permorg});
+		if($e) {
+			$self->event($e);
+			return undef;
+		}
+	}
+
+	my $obj; 
+	my $err;
+
+	try {
+		$obj = $self->request($method, @arg);
+	} catch Error with { $err = shift; };
+	
+
+	if(!defined $obj) {
+		$self->log(I, "request returned no data");
+
+		if( $action eq 'retrieve' ) {
+			$self->event(_mk_not_found($type, $arg));
+
+		} elsif( $action eq 'update' or 
+				$action eq 'delete' or $action eq 'create' ) {
+			my $evt = OpenILS::Event->new(
+				'DATABASE_UPDATE_FAILED', payload => $arg, debug => "$err" );
+			$self->event($evt);
+		}
+
+		if( $err ) {
+			$self->event( 
+				OpenILS::Event->new( 'DATABASE_QUERY_FAILED', 
+					payload => $arg, debug => "$err" ));
+			return undef;
+		}
+
+		return undef;
+	}
+
+	if( $action eq 'create' and $obj == 0 ) {
+		my $evt = OpenILS::Event->new(
+			'DATABASE_UPDATE_FAILED', payload => $arg, debug => "$err" );
+		$self->event($evt);
+		return undef;
+	}
+
+	# If we havn't dealt with the error in a nice way, go ahead and throw it
+	if( $err ) {
+		$self->event( 
+			OpenILS::Event->new( 'DATABASE_QUERY_FAILED', 
+				payload => $arg, debug => "$err" ));
+		return undef;
+	}
+
+	if( $action eq 'search' or $action eq 'batch_retrieve' or $action eq 'retrieve_all') {
+		$self->log(I, "$type.$action : returned ".scalar(@$obj). " result(s)");
+		$self->event(_mk_not_found($type, $arg)) unless @$obj;
+	}
+
+	$arg->id($obj) if $action eq 'create'; # grabs the id on create
+	$self->data($obj); # cache the data for convenience
+
+	return ($obj) ? $obj : 1;
+}
+
+
+sub _mk_not_found {
+	my( $type, $arg ) = @_;
+	(my $t = $type) =~ s/\./_/og;
+	$t = uc($t);
+	return OpenILS::Event->new("${t}_NOT_FOUND", payload => $arg);
+}
+
+
+
+# utility method for loading
+sub __fm2meth { 
+	my $str = shift;
+	my $sep = shift;
+	$str =~ s/Fieldmapper:://o;
+	$str =~ s/::/$sep/g;
+	return $str;
+}
+
+
+# -------------------------------------------------------------
+# Load up the methods from the FM classes
+# -------------------------------------------------------------
+my $map = $Fieldmapper::fieldmap;
+for my $object (keys %$map) {
+	my $obj = __fm2meth($object,'_');
+	my $type = __fm2meth($object, '.');
+
+	my $update = "update_$obj";
+	my $updatef = 
+		"sub $update {return shift()->runmethod('update', '$type', \@_);}";
+	eval $updatef;
+
+	my $retrieve = "retrieve_$obj";
+	my $retrievef = 
+		"sub $retrieve {return shift()->runmethod('retrieve', '$type', \@_);}";
+	eval $retrievef;
+
+	my $search = "search_$obj";
+	my $searchf = 
+		"sub $search {return shift()->runmethod('search', '$type', \@_);}";
+	eval $searchf;
+
+	my $create = "create_$obj";
+	my $createf = 
+		"sub $create {return shift()->runmethod('create', '$type', \@_);}";
+	eval $createf;
+
+	my $delete = "delete_$obj";
+	my $deletef = 
+		"sub $delete {return shift()->runmethod('delete', '$type', \@_);}";
+	eval $deletef;
+
+	my $bretrieve = "batch_retrieve_$obj";
+	my $bretrievef = 
+		"sub $bretrieve {return shift()->runmethod('batch_retrieve', '$type', \@_);}";
+	eval $bretrievef;
+
+	my $retrieveall = "retrieve_all_$obj";
+	my $retrieveallf = 
+		"sub $retrieveall {return shift()->runmethod('retrieve_all', '$type', \@_);}";
+	eval $retrieveallf;
+
+
+}
+
+
+
+1;
+
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/Fieldmapper.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/Fieldmapper.pm
new file mode 100644
index 0000000000..bb582dcfdb
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/Fieldmapper.pm
@@ -0,0 +1,407 @@
+package Fieldmapper;
+use OpenSRF::Utils::JSON;
+use Data::Dumper;
+use base 'OpenSRF::Application';
+use OpenSRF::Utils::Logger;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::System;
+use XML::LibXML;
+
+my $log = 'OpenSRF::Utils::Logger';
+
+use vars qw/$fieldmap $VERSION/;
+
+sub publish_fieldmapper {
+	my ($self,$client,$class) = @_;
+
+	return $fieldmap unless (defined $class);
+	return undef unless (exists($$fieldmap{$class}));
+	return {$class => $$fieldmap{$class}};
+}
+__PACKAGE__->register_method(
+	api_name	=> 'opensrf.open-ils.system.fieldmapper',
+	api_level	=> 1,
+	method		=> 'publish_fieldmapper',
+);
+
+#
+# To dump the Javascript version of the fieldmapper struct use the command:
+#
+#	PERL5LIB=:~/vcs/ILS/Open-ILS/src/perlmods/lib/ GEN_JS=1 perl -MOpenILS::Utils::Fieldmapper -e 'print "\n";'
+#
+# ... adjusted for your VCS sandbox of choice, of course.
+#
+
+sub classes {
+	return () unless (defined $fieldmap);
+	return keys %$fieldmap;
+}
+
+sub get_attribute {
+	my $attr_list = shift;
+	my $attr_name = shift;
+
+	my $attr = $attr_list->getNamedItem( $attr_name );
+	if( defined( $attr ) ) {
+		return $attr->getValue();
+	}
+	return undef;
+}
+
+sub load_fields {
+	my $field_list = shift;
+	my $fm = shift;
+
+	# Get attributes of the field list.  Since there is only one
+	#  per class, these attributes logically belong to the
+	# enclosing class, and that's where we load them.
+
+	my $field_attr_list = $field_list->attributes();
+
+	my $sequence  = get_attribute( $field_attr_list, 'oils_persist:sequence' );
+	if( ! defined( $sequence ) ) {
+		$sequence = '';
+	}
+	my $primary   = get_attribute( $field_attr_list, 'oils_persist:primary' );
+
+	# Load attributes into the Fieldmapper ----------------------
+
+	$$fieldmap{$fm}{ sequence } = $sequence;
+	$$fieldmap{$fm}{ identity } = $primary;
+
+	# Load each field -------------------------------------------
+
+	my $array_position = 0;
+	for my $field ( $field_list->childNodes() ) {    # For each 
+		if( $field->nodeName eq 'field' ) {
+	
+			my $attribute_list = $field->attributes();
+			
+			my $name     = get_attribute( $attribute_list, 'name' );
+			next if( $name eq 'isnew' || $name eq 'ischanged' || $name eq 'isdeleted' );
+			my $required  = get_attribute( $attribute_list, 'oils_obj:required' );
+			my $validate  = get_attribute( $attribute_list, 'oils_obj:validate' );
+			my $virtual  = get_attribute( $attribute_list, 'oils_persist:virtual' );
+			if( ! defined( $virtual ) ) {
+				$virtual = "false";
+			}
+			my $selector = get_attribute( $attribute_list, 'reporter:selector' );
+
+			$$fieldmap{$fm}{fields}{ $name } =
+				{ virtual => ( $virtual eq 'true' ) ? 1 : 0,
+				  required => ( $required eq 'true' ) ? 1 : 0,
+				  position => $array_position,
+				};
+
+			$$fieldmap{$fm}{fields}{ $name }{validate} = qr/$validate/ if (defined($validate));
+
+			# The selector attribute, if present at all, attaches to only one
+			# of the fields in a given class.  So if we see it, we store it at
+			# the level of the enclosing class.
+
+			if( defined( $selector ) ) {
+				$$fieldmap{$fm}{selector} = $selector;
+			}
+
+			++$array_position;
+		}
+	}
+
+	# Load the standard 3 virtual fields ------------------------
+
+	for my $vfield ( qw/isnew ischanged isdeleted/ ) {
+		$$fieldmap{$fm}{fields}{ $vfield } =
+			{ position => $array_position,
+			  virtual => 1
+			};
+		++$array_position;
+	}
+}
+
+sub load_links {
+	my $link_list = shift;
+	my $fm = shift;
+
+	for my $link ( $link_list->childNodes() ) {    # For each 
+		if( $link->nodeName eq 'link' ) {
+			my $attribute_list = $link->attributes();
+			
+			my $field   = get_attribute( $attribute_list, 'field' );
+			my $reltype = get_attribute( $attribute_list, 'reltype' );
+			my $key     = get_attribute( $attribute_list, 'key' );
+			my $class   = get_attribute( $attribute_list, 'class' );
+
+			$$fieldmap{$fm}{links}{ $field } =
+				{ class   => $class,
+				  reltype => $reltype,
+				  key     => $key,
+				};
+		}
+	}
+}
+
+sub load_class {
+	my $class_node = shift;
+
+	# Get attributes ---------------------------------------------
+
+	my $attribute_list = $class_node->attributes();
+
+	my $fm               = get_attribute( $attribute_list, 'oils_obj:fieldmapper' );
+	$fm                  = 'Fieldmapper::' . $fm;
+	my $id               = get_attribute( $attribute_list, 'id' );
+	my $controller       = get_attribute( $attribute_list, 'controller' );
+	my $virtual          = get_attribute( $attribute_list, 'virtual' );
+	if( ! defined( $virtual ) ) {
+		$virtual = 'false';
+	}
+	my $tablename        = get_attribute( $attribute_list, 'oils_persist:tablename' );
+	if( ! defined( $tablename ) ) {
+		$tablename = '';
+	}
+	my $restrict_primary = get_attribute( $attribute_list, 'oils_persist:restrict_primary' );
+
+	# Load the attributes into the Fieldmapper --------------------
+
+	$log->debug("Building Fieldmapper class for [$fm] from IDL");
+
+	$$fieldmap{$fm}{ hint }             = $id;
+	$$fieldmap{$fm}{ virtual }          = ( $virtual eq 'true' ) ? 1 : 0;
+	$$fieldmap{$fm}{ table }            = $tablename;
+	$$fieldmap{$fm}{ controller }       = [ split ' ', $controller ];
+	$$fieldmap{$fm}{ restrict_primary } = $restrict_primary;
+
+	# Load fields and links
+
+	for my $child ( $class_node->childNodes() ) {
+		my $nodeName = $child->nodeName;
+		if( $nodeName eq 'fields' ) {
+			load_fields( $child, $fm );
+		} elsif( $nodeName eq 'links' ) {
+			load_links( $child, $fm );
+		}
+	}
+}
+
+import();
+sub import {
+	my $class = shift;
+	my %args = @_;
+
+	return if (keys %$fieldmap);
+	return if (!OpenSRF::System->connected && !$args{IDL});
+
+	# parse the IDL ...
+	my $parser = XML::LibXML->new();
+	my $file = $args{IDL} || OpenSRF::Utils::SettingsClient->new->config_value( 'IDL' );
+	my $fmdoc = $parser->parse_file( $file );
+	my $rootnode = $fmdoc->documentElement();
+
+	for my $child ( $rootnode->childNodes() ) {    # For each 
+		my $nodeName = $child->nodeName;
+		if( $nodeName eq 'class' ) {
+			load_class( $child );
+		}
+	}
+
+	#-------------------------------------------------------------------------------
+	# Now comes the evil!  Generate classes
+
+	for my $pkg ( __PACKAGE__->classes ) {
+		(my $cdbi = $pkg) =~ s/^Fieldmapper:://o;
+
+		eval <<"		PERL";
+			package $pkg;
+			use base 'Fieldmapper';
+		PERL
+
+		if (exists $$fieldmap{$pkg}{proto_fields}) {
+			for my $pfield ( sort keys %{ $$fieldmap{$pkg}{proto_fields} } ) {
+				$$fieldmap{$pkg}{fields}{$pfield} = { position => $pos, virtual => $$fieldmap{$pkg}{proto_fields}{$pfield} };
+				$pos++;
+			}
+		}
+
+		OpenSRF::Utils::JSON->register_class_hint(
+			hint => $pkg->json_hint,
+			name => $pkg,
+			type => 'array',
+		);
+
+	}
+}
+
+sub new {
+	my $self = shift;
+	my $value = shift;
+	$value = [] unless (defined $value);
+	return bless $value => $self->class_name;
+}
+
+sub decast {
+	my $self = shift;
+	return [ @$self ];
+}
+
+sub DESTROY {}
+
+sub AUTOLOAD {
+	my $obj = shift;
+	my $value = shift;
+	(my $field = $AUTOLOAD) =~ s/^.*://o;
+	my $class_name = $obj->class_name;
+
+	my $fpos = $field;
+	$fpos  =~ s/^clear_//og ;
+
+	my $pos = $$fieldmap{$class_name}{fields}{$fpos}{position};
+
+	if ($field =~ /^clear_/o) {
+		{	no strict 'subs';
+			*{$obj->class_name."::$field"} = sub {
+				my $self = shift;
+				$self->[$pos] = undef;
+				return 1;
+			};
+		}
+		return $obj->$field();
+	}
+
+	die "No field by the name $field in $class_name!"
+		unless (exists $$fieldmap{$class_name}{fields}{$field} && defined($pos));
+
+
+	{	no strict 'subs';
+		*{$obj->class_name."::$field"} = sub {
+			my $self = shift;
+			my $new_val = shift;
+			$self->[$pos] = $new_val if (defined $new_val);
+			return $self->[$pos];
+		};
+	}
+	return $obj->$field($value);
+}
+
+sub Selector {
+	my $self = shift;
+	return $$fieldmap{$self->class_name}{selector};
+}
+
+sub Identity {
+	my $self = shift;
+	return $$fieldmap{$self->class_name}{identity};
+}
+
+sub RestrictPrimary {
+	my $self = shift;
+	return $$fieldmap{$self->class_name}{restrict_primary};
+}
+
+sub Sequence {
+	my $self = shift;
+	return $$fieldmap{$self->class_name}{sequence};
+}
+
+sub Table {
+	my $self = shift;
+	return $$fieldmap{$self->class_name}{table};
+}
+
+sub Controller {
+	my $self = shift;
+	return $$fieldmap{$self->class_name}{controller};
+}
+
+sub RequiredField {
+	my $self = shift;
+	my $f = shift;
+    return undef unless ($f);
+	return $$fieldmap{$self->class_name}{fields}{$f}{required};
+}
+
+sub ValidateField {
+	my $self = shift;
+	my $f = shift;
+    return undef unless ($f);
+	return 1 if (!exists($$fieldmap{$self->class_name}{fields}{$f}{validate}));
+	return $self->$f =~ $$fieldmap{$self->class_name}{fields}{$f}{validate};
+}
+
+sub class_name {
+	my $class_name = shift;
+	return ref($class_name) || $class_name;
+}
+
+sub real_fields {
+	my $self = shift;
+	my $class_name = $self->class_name;
+	my $fields = $$fieldmap{$class_name}{fields};
+
+	my @f = grep {
+			!$$fields{$_}{virtual}
+		} sort {$$fields{$a}{position} <=> $$fields{$b}{position}} keys %$fields;
+
+	return @f;
+}
+
+sub has_field {
+	my $self = shift;
+	my $field = shift;
+	my $class_name = $self->class_name;
+	return 1 if grep { $_ eq $field } keys %{$$fieldmap{$class_name}{fields}};
+	return 0;
+}
+
+sub properties {
+	my $self = shift;
+	my $class_name = $self->class_name;
+	return keys %{$$fieldmap{$class_name}{fields}};
+}
+
+sub to_bare_hash {
+	my $self = shift;
+
+	my %hash = ();
+	for my $f ($self->properties) {
+		my $val = $self->$f;
+		$hash{$f} = $val;
+	}
+
+	return \%hash;
+}
+
+sub clone {
+	my $self = shift;
+	return $self->new( [@$self] );
+}
+
+sub api_level {
+	my $self = shift;
+	return $fieldmap->{$self->class_name}->{api_level};
+}
+
+sub cdbi {
+	my $self = shift;
+	return $fieldmap->{$self->class_name}->{cdbi};
+}
+
+sub is_virtual {
+	my $self = shift;
+	my $field = shift;
+	return $fieldmap->{$self->class_name}->{proto_fields}->{$field} if ($field);
+	return $fieldmap->{$self->class_name}->{virtual};
+}
+
+sub is_readonly {
+	my $self = shift;
+	my $field = shift;
+	return $fieldmap->{$self->class_name}->{readonly};
+}
+
+sub json_hint {
+	my $self = shift;
+	return $fieldmap->{$self->class_name}->{hint};
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/ISBN.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/ISBN.pm
new file mode 100644
index 0000000000..34eed663a8
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/ISBN.pm
@@ -0,0 +1,96 @@
+package OpenILS::Utils::ISBN;
+
+# ---------------------------------------------------------------
+# Copyright (C) 2010 Equinox Software, Inc
+# Author: Joe Atzberger 
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# ---------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use Business::ISBN;
+
+use base qw/Exporter/;
+our $VERSION = '0.01';
+our @EXPORT_OK = qw/isbn_upconvert/;
+
+# Jason Stephenson  at Merrimack Valley Library Consortium
+# Dan Scott  at Laurentian University
+
+sub isbn_upconvert {
+    my $in     = @_ ? shift : return;
+    my $pretty = @_ ? shift : 0;
+    $in =~ s/\s*//g;
+    $in =~ s/-//g;
+    length($in) or return;
+    my $isbn = Business::ISBN->new($in) or return;
+    $isbn->fix_checksum() if $isbn->is_valid_checksum() == Business::ISBN::BAD_CHECKSUM;
+    $isbn->is_valid() or return;
+    return $pretty ? $isbn->as_isbn13->as_string : $isbn->as_isbn13->isbn;
+}
+
+1;
+__END__
+
+For example, if you have a file isbns.txt with these lines:
+
+1598884093
+ 1598884093
+ 15  988  840 93     
+0446357197
+  0 446 3 5  7 1 9        7
+  0 446 3 5  7 1 9        1
+0596526857
+0786222735
+0446360015
+0446350109
+0446314129
+0439139597
+0743294394
+159143047X
+1590203097
+075480965X
+0393048799
+0446831832
+0446310069
+1598883275
+0446313033
+0446360279
+
+And you run:
+    perl -pe 'use OpenILS::Utils::ISBN qw/isbn_upconvert/; $_ = isbn_upconvert($_) . "\n";' 
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# ---------------------------------------------------------------
+
+# The purpose of this module is to consolidate 
+# non-duplicative processing, i.e. lockfiles and lockfile checking
+
+use strict;
+use warnings;
+use Carp;
+
+use File::Basename qw/fileparse/;
+
+sub _tempdir {
+    return $ENV{TEMP} || $ENV{TMP} || '/tmp';
+}
+
+our $debug =  0;
+
+sub default_filename {
+   my $tempdir = _tempdir;
+   my $filename = fileparse($0, '.pl');
+   return "$tempdir/$filename-LOCK";
+}
+
+sub new {
+    my $class    = shift;
+    my $lockfile = @_ ? shift : default_filename;
+ 
+    croak "Script already running with lockfile $lockfile" if -e $lockfile;
+    $debug and print "Writing lockfile $lockfile (PID: $$)\n";
+
+    open (F, ">$lockfile") or croak "Cannot write to lockfile '$lockfile': $!";
+    print F $$;
+    close F;
+
+    my $self = {
+        filename => $lockfile,
+        contents => $$,
+    };
+    return bless ($self, $class);
+}
+
+sub filename {
+    my $self = shift;
+    return $self->{filename};
+}
+sub contents {
+    my $self = shift;
+    return $self->{contents};
+}
+
+DESTROY {
+    my $self = shift;
+    # lockfile cleanup 
+    if (-e $self->{filename}) {
+        open LF, $self->{filename};
+        my $contents = ;
+        close LF;
+        $debug and print "deleting lockfile $self->{filename}\n";
+        if ($contents == $self->{contents}) { 
+            unlink $self->{filename} or carp "Failed to remove lockfile '$self->{filename}'";
+        } else {
+            carp "Lockfile contents '$contents' no longer match '$self->{contents}'.  Cannot remove $self->{filename}";
+        }
+        
+    }
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD.pm
new file mode 100644
index 0000000000..48f00cb1a7
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD.pm
@@ -0,0 +1,610 @@
+package MFHD;
+use strict;
+use warnings;
+use integer;
+use Carp;
+use DateTime::Format::Strptime;
+use Data::Dumper;
+
+# for inherited methods to work properly, we need to force a
+# MARC::Record version greater than 2.0.0
+use MARC::Record "2.0.1";
+use base 'MARC::Record';
+
+use OpenILS::Utils::MFHD::Caption;
+use OpenILS::Utils::MFHD::Holding;
+
+sub new {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my $self  = shift;
+
+    $self->{_strp_date} = new DateTime::Format::Strptime(pattern => '%F');
+
+    $self->{_mfhd_CAPTIONS} = {};
+    $self->{_mfhd_COMPRESSIBLE} = (substr($self->leader, 17, 1) =~ /[45]/);
+
+    foreach my $field ('853', '854', '855') {
+        my $captions = {};
+        foreach my $caption ($self->field($field)) {
+            my $cap_id;
+
+            $cap_id = $caption->subfield('8') || '0';
+
+            if (exists $captions->{$cap_id}) {
+                carp "Multiple MFHD captions with label '$cap_id'";
+            }
+
+            $captions->{$cap_id} = new MFHD::Caption($caption);
+            if ($self->{_mfhd_COMPRESSIBLE}) {
+                $self->{_mfhd_COMPRESSIBLE} &&=
+                  $captions->{$cap_id}->compressible;
+            }
+        }
+        $self->{_mfhd_CAPTIONS}->{$field} = $captions;
+    }
+
+    foreach my $field ('863', '864', '865') {
+        my $holdings = {};
+        my $cap_field;
+
+        ($cap_field = $field) =~ s/6/5/;
+
+        foreach my $hfield ($self->field($field)) {
+            my ($linkage, $link_id, $seqno);
+            my $holding;
+
+            $linkage = $hfield->subfield('8');
+            ($link_id, $seqno) = split(/\./, $linkage);
+
+            if (!exists $holdings->{$link_id}) {
+                $holdings->{$link_id} = {};
+            }
+            $holding =
+              new MFHD::Holding($seqno, $hfield,
+                $self->{_mfhd_CAPTIONS}->{$cap_field}->{$link_id});
+            $holdings->{$link_id}->{$seqno} = $holding;
+
+            if ($self->{_mfhd_COMPRESSIBLE}) {
+                $self->{_mfhd_COMPRESSIBLE} &&= $holding->validate;
+            }
+        }
+        $self->{_mfhd_HOLDINGS}->{$field} = $holdings;
+    }
+
+    bless($self, $class);
+    return $self;
+}
+
+sub compressible {
+    my $self = shift;
+
+    return $self->{_mfhd_COMPRESSIBLE};
+}
+
+sub caption_link_ids {
+    my $self  = shift;
+    my $field = shift;
+
+    return sort keys %{$self->{_mfhd_CAPTIONS}->{$field}};
+}
+
+# optional argument to get back a 'hashref' or an 'array' (default)
+sub captions {
+    my $self  = shift;
+    my $tag = shift;
+    my $return_type = shift;
+
+    # TODO: add support for caption types as argument? (base, index, supplement)
+    my @sorted_ids = $self->caption_link_ids($tag);
+
+    if (defined($return_type) and $return_type eq 'hashref') {
+        my %captions;
+        foreach my $link_id (@sorted_ids) {
+            $captions{$link_id} = $self->{_mfhd_CAPTIONS}{$tag}{$link_id};
+        }
+        return \%captions;
+    } else {
+        my @captions;
+        foreach my $link_id (@sorted_ids) {
+            push(@captions, $self->{_mfhd_CAPTIONS}{$tag}{$link_id});
+        }
+        return @captions;
+    }
+}
+
+sub append_fields {
+    my $self = shift;
+
+    my $field_count = $self->SUPER::append_fields(@_);
+    if ($field_count) {
+        foreach my $field (@_) {
+            $self->_avoid_link_collision($field);
+            my $field_type = ref $field;
+            if ($field_type eq 'MFHD::Holding') {
+                $self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno} = $field;
+            } elsif ($field_type eq 'MFHD::Caption') {
+                $self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id} = $field;
+            }
+        }
+        return $field_count;
+    } else {
+        return;
+    }   
+}
+
+sub delete_field {
+    my $self = shift;
+    my $field = shift;
+
+    my $field_count = $self->SUPER::delete_field($field);
+    if ($field_count) {
+        my $field_type = ref($field);
+        if ($field_type eq 'MFHD::Holding') {
+            delete($self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno});
+        } elsif ($field_type eq 'MFHD::Caption') {
+            delete($self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id});
+        }
+        return $field_count;
+    } else {
+        return;
+    }
+}
+
+sub insert_fields_before {
+    my $self = shift;
+    my $before = shift;
+
+    my $field_count = $self->SUPER::insert_fields_before($before, @_);
+    if ($field_count) {
+        foreach my $field (@_) {
+            $self->_avoid_link_collision($field);
+            my $field_type = ref $field;
+            if ($field_type eq 'MFHD::Holding') {
+                $self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno} = $field;
+            } elsif ($field_type eq 'MFHD::Caption') {
+                $self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id} = $field;
+            }
+        }
+        return $field_count;
+    } else {
+        return;
+    }
+}
+
+sub insert_fields_after {
+    my $self = shift;
+    my $after = shift;
+
+    my $field_count = $self->SUPER::insert_fields_after($after, @_);
+    if ($field_count) {
+        foreach my $field (@_) {
+            $self->_avoid_link_collision($field);
+            my $field_type = ref $field;
+            if ($field_type eq 'MFHD::Holding') {
+                $self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno} = $field;
+            } elsif ($field_type eq 'MFHD::Caption') {
+                $self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id} = $field;
+            }
+        }
+        return $field_count;
+    } else {
+        return;
+    }
+}
+
+sub _avoid_link_collision {
+    my $self = shift;
+    my $field = shift;
+
+    my $fieldref = ref($field);
+    if ($fieldref eq 'MFHD::Holding') {
+        my $seqno = $field->seqno;
+        my $changed_seqno = 0;
+        if (exists($self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$seqno})) {
+            $changed_seqno = 1;
+            do {
+                $seqno++;
+            } while (exists($self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$seqno}));
+        }
+        $field->seqno($seqno) if $changed_seqno;
+    } elsif ($fieldref eq 'MFHD::Caption') {
+        my $link_id = $field->link_id;
+        my $changed_link_id = 0;
+        if (exists($self->{_mfhd_CAPTIONS}{$field->tag}{$link_id})) {
+            $link_id++;
+            $changed_link_id = 1;
+            do {
+                $link_id++;
+            } while (exists($self->{_mfhd_CAPTIONS}{$field->tag}{$link_id}));
+        }
+        $field->link_id($link_id) if $changed_link_id;
+    }
+}
+
+sub active_captions {
+    my $self  = shift;
+    my $tag = shift;
+
+    # TODO: add support for caption types as argument? (basic, index, supplement)
+    my @captions;
+    my @active_captions;
+
+    @captions = $self->captions($tag);
+
+    # TODO: for now, we will assume the last 85X field is active
+    # and the rest are historical.  The standard is hazy about
+    # how multiple active patterns of the same 85X type should be
+    # handled.  We will, however, return as an array for future
+    # use.
+    push(@active_captions, $captions[-1]);
+
+    return @active_captions;
+}
+
+sub holdings {
+    my $self  = shift;
+    my $field = shift;
+    my $capid = shift;
+
+    return
+      sort { $a->seqno <=> $b->seqno }
+      values %{$self->{_mfhd_HOLDINGS}->{$field}->{$capid}};
+}
+
+sub _holding_date {
+    my $self = shift;
+    my $holding = shift;
+
+    return $self->{_strp_date}->parse_datetime($holding->chron_to_date);
+}
+
+#
+# generate_predictions()
+# Accepts a hash ref of options initially defined as:
+# base_holding : reference to the holding field to predict from
+# num_to_predict : the number of issues you wish to predict
+# OR
+# end_holding : holding field ref, keep predicting until you meet or exceed it
+# OR
+# end_date : keep predicting until you exceed this
+#
+# The basic method is to first convert to a single holding if compressed, then
+# increment the holding and save the resulting values to @predictions.
+# 
+# returns @predictions, an array of holding field refs (including end_holding
+# if applicable but NOT base_holding)
+# 
+sub generate_predictions {
+    my ($self, $options) = @_;
+
+    my $base_holding   = $options->{base_holding};
+    my $num_to_predict = $options->{num_to_predict};
+    my $end_holding    = $options->{end_holding};
+    my $end_date       = $options->{end_date};
+    my $max_to_predict = $options->{max_to_predict} || 10000; # fail-safe
+
+    if (!defined($base_holding)) {
+        carp("Base holding not defined in generate_predictions, returning empty set");
+        return ();
+    }
+    if ($base_holding->is_compressed) {
+        carp("Ambiguous compressed base holding in generate_predictions, returning empty set");
+        return ();
+    }
+    my $curr_holding = $base_holding->clone; # prevent side-effects
+    
+    my @predictions;
+        
+    if ($num_to_predict) {
+        for (my $i = 0; $i < $num_to_predict; $i++) {
+            push(@predictions, $curr_holding->increment->clone);
+        }
+    } elsif (defined($end_holding)) {
+        $end_holding = $end_holding->clone; # prevent side-effects
+        my $next_holding = $curr_holding->increment->clone;
+        my $num_predicted = 0;
+        while ($next_holding le $end_holding) {
+            push(@predictions, $next_holding);
+            $num_predicted++;
+            if ($num_predicted >= $max_to_predict) {
+                carp("Maximum prediction count exceeded");
+                last;
+            }
+            $next_holding = $curr_holding->increment->clone;
+        }
+    } elsif (defined($end_date)) {
+        my $next_holding = $curr_holding->increment->clone;
+        my $num_predicted = 0;
+        while ($self->_holding_date($next_holding) <= $end_date) {
+            push(@predictions, $next_holding);
+            $num_predicted++;
+            if ($num_predicted >= $max_to_predict) {
+                carp("Maximum prediction count exceeded");
+                last;
+            }
+            $next_holding = $curr_holding->increment->clone;
+        }
+    }
+
+    return @predictions;
+}
+
+#
+# create an array of compressed holdings from all holdings for a given caption,
+# compressing as needed
+#
+# Optionally you can skip sorting, but the resulting compression will be compromised
+# if the current holdings are out of order
+#
+# TODO: gap marking, gap preservation
+#
+# TODO: some of this could be moved to the Caption object to allow for 
+# decompression in the absense of an overarching MFHD object
+#
+sub get_compressed_holdings {
+    my $self = shift;
+    my $caption = shift;
+    my $opts = shift;
+    my $skip_sort = $opts->{'skip_sort'};
+
+    # make sure none are compressed
+    my @decomp_holdings;
+    if ($skip_sort) {
+        @decomp_holdings = $self->get_decompressed_holdings($caption, {'skip_sort' => 1});
+    } else {
+        # sort for best algorithm
+        @decomp_holdings = $self->get_decompressed_holdings($caption, {'dedupe' => 1});
+    }
+
+    my $runner = $decomp_holdings[0]->clone->increment;   
+    my $curr_holding = shift(@decomp_holdings);
+    $curr_holding = $curr_holding->clone;
+    my $seqno = 1;
+    $curr_holding->seqno($seqno);
+    my @comp_holdings;
+#    my $last_holding;
+    foreach my $holding (@decomp_holdings) {
+        if ($runner eq $holding) {
+            $curr_holding->extend;
+            $runner->increment;
+#        } elsif ($holding eq $last_holding) {
+#            carp("Found duplicate holding in compression set, skipping");
+        } elsif ($runner gt $holding) { # should not happen unless holding is not in series
+            carp("Found unexpected holding, skipping");
+        } else {
+            push(@comp_holdings, $curr_holding);
+            while ($runner le $holding) {
+                $runner->increment;
+            }
+            $curr_holding = $holding->clone;
+            $seqno++;
+            $curr_holding->seqno($seqno);
+        }
+#        $last_holding = $holding;
+    }
+    push(@comp_holdings, $curr_holding);
+
+    return @comp_holdings;
+}
+
+#
+# create an array of single holdings from all holdings for a given caption,
+# decompressing as needed
+#
+# resulting array is returned as they come in the record, unsorted
+#
+# optional argument will reorder and renumber the holdings before returning
+# 
+# TODO: some of this could be moved to the Caption (and/or Holding) object to
+# allow for decompression in the absense of an overarching MFHD object
+#
+sub get_decompressed_holdings {
+    my $self = shift;
+    my $caption = shift;
+    my $opts = shift;
+    my $skip_sort = $opts->{'skip_sort'};
+    my $dedupe = $opts->{'dedupe'};
+
+    if ($dedupe and $skip_sort) {
+        carp("Attempted deduplication without sorting, failure likely");
+    }
+
+    my $htag    = $caption->tag;
+    my $link_id = $caption->link_id;
+    $htag =~ s/^85/86/;
+    my @holdings = $self->holdings($htag, $link_id);
+    my @decomp_holdings;
+
+    foreach my $holding (@holdings) {
+        if (!$holding->is_compressed) {
+            push(@decomp_holdings, $holding->clone);
+        } else {
+            my $base_holding = $holding->clone->compressed_to_first;
+            my @new_holdings = $self->generate_predictions(
+                {'base_holding' => $base_holding,
+                 'end_holding' => $holding->clone->compressed_to_last});
+            push(@decomp_holdings, $base_holding, @new_holdings);
+        }
+    }
+
+    unless ($skip_sort) {
+        my @temp_holdings = sort {$a cmp $b} @decomp_holdings;
+        @decomp_holdings = @temp_holdings;
+    }
+
+    my @return_holdings = (shift(@decomp_holdings));
+    $return_holdings[0]->seqno(1);
+    my $seqno = 2;
+    foreach my $holding (@decomp_holdings) { # renumber sequence
+        if ($holding eq $return_holdings[-1] and $dedupe) {
+            carp("Found duplicate holding in decompression set, discarding");
+            next;
+        }
+        $holding->seqno($seqno);
+        $seqno++;
+        push(@return_holdings, $holding);
+    }
+
+    return @return_holdings;
+}
+
+#
+# format_holdings(): Generate textual display of all holdings in record
+# for given type of caption (853--855) taking into account all the
+# captions, holdings statements, and textual
+# holdings.
+#
+# returns string formatted holdings as one very long line.
+# Caller must provide any label (such as "library has:" and insert
+# line breaks as appropriate.
+
+# Translate caption field labels to the corresponding textual holdings
+# statement labels. That is, convert 853 "Basic bib unit" caption to
+# 866 "basic bib unit" text holdings label.
+
+my %cap_to_txt = (
+                  '853' => '866',
+                  '854' => '867',
+                  '855' => '868',
+                 );
+
+sub format_holdings {
+    my $self = shift;
+    my $field = shift;
+    my $holdings_field;
+    my @txt_holdings;
+    my %txt_link_ids;
+    my $holdings_stmt = '';
+    my ($l, $start);
+
+    # convert caption field id to holdings field id
+    ($holdings_field = $field) =~ s/5/6/;
+
+    # Textual holdings statements complicate the basic algorithm for
+    # formatting the holdings: If there's a textual holdings statement
+    # with the subfield "$80", then that overrides ALL the MFHD holdings
+    # information and is all that is displayed. Otherwise, the textual
+    # holdings statements will either replace some of the MFHD holdings
+    # information, or supplement it, depending on the value of the
+    # $8 linkage subfield.
+
+    if (defined $self->field($cap_to_txt{$field})) {
+        @txt_holdings = $self->field($cap_to_txt{$field});
+
+        foreach my $txt (@txt_holdings) {
+
+            # if there's a $80 subfield, then we're done, it's
+            # all the formatted holdings
+            if ($txt->subfield('8') eq '0') {
+                # textual holdings statement that completely
+                # replaces MFHD holdings in 853/863, etc.
+                $holdings_stmt = $txt->subfield('a');
+
+                if (defined $txt->subfield('z')) {
+                    $holdings_stmt .= ' -- ' . $txt->subfield('z');
+                }
+
+                printf("# format_holdings() returning %s txt holdings\n",
+                       $cap_to_txt{$field});
+                return $holdings_stmt;
+            }
+
+            # If there are non-$80 subfields in the textual holdings
+            # then we need to keep track of the subfields, so we can
+            # intersperse the textual holdings in with the the calculated
+            # holdings from the 853/863 fields.
+            foreach my $linkid ($txt->subfield('8')) {
+                $txt_link_ids{$linkid} = $txt;
+            }
+        }
+    }
+
+    # Now loop through all the captions, finding the corresponding
+    # holdings statements (either MFHD or textual), and build up the
+    # complete formatted holdings statement. The textual holdings statements
+    # have either the same link id field as a caption, which means that
+    # the text holdings win, or they have ids that are interfiled with
+    # the captions, which mean they go into the middle.
+
+    my @ids = sort($self->caption_link_ids($field), keys %txt_link_ids);
+    foreach my $cap_id (@ids) {
+        my $last_txt = undef;
+
+        if (exists $txt_link_ids{$cap_id}) {
+            # there's a textual holding statement with this caption ID,
+            # so just use that. This covers both the "replaces" and
+            # the "supplements" holdings information options.
+
+            # a single textual holdings statement can replace multiple
+            # captions. If the _last_ caption we saw had a textual
+            # holdings statement, and this caption has the same one, then
+            # we don't add the holdings again.
+            if (!defined $last_txt || ($last_txt != $txt_link_ids{$cap_id})) {
+                my $txt = $txt_link_ids{$cap_id};
+                $holdings_stmt .= ',' if $holdings_stmt;
+                $holdings_stmt .= $txt->subfield('a');
+                if (defined $txt->subfield('z')) {
+                    $holdings_stmt .= ' -- ' . $txt->subfield('z');
+                }
+
+                $last_txt = $txt;
+            }
+            next;
+        }
+
+        # We found a caption that doesn't have a corresponding textual
+        # holdings statement, so reset $last_txt to undef.
+        $last_txt = undef;
+
+        my @holdings = $self->holdings($holdings_field, $cap_id);
+
+        next unless scalar @holdings;
+
+        # XXX Need to format compressed holdings. see code in test.pl
+        # for example. Try to do it without indexing?
+        $holdings_stmt .= ',' if $holdings_stmt;
+
+        if ($self->compressible) {
+            $start = $l = shift @holdings;
+            $holdings_stmt .= $l->format;
+
+            while (my $h = shift @holdings) {
+                if (!$h->matches($l->next)) {
+                    # this item is not part of the current run,
+                    # close out the run and record this item
+                    if ($l != $start) {
+                        $holdings_stmt .= '-' . $l->format;
+                    }
+
+                    $holdings_stmt .= ',' . $h->format;
+                    $start = $h
+                } elsif (!scalar(@holdings) || defined($h->subfield('z'))) {
+                    # This is the end of the holdings for this caption
+                    # or this item has a public note that we want
+                    # to display
+                    $holdings_stmt .= '-' . $h->format;
+                }
+
+                if (defined $h->subfield('z')) {
+                    $holdings_stmt .= ' -- ' . $h->subfield('z');
+                }
+
+                $l = $h;
+            }
+        } else {
+            $holdings_stmt .= ',' if $holdings_stmt;
+            $holdings_stmt .= (shift @holdings)->format;
+            foreach my $h (@holdings) {
+                $holdings_stmt .= ',' . $h->format;
+                if (defined $h->subfield('z')) {
+                    $holdings_stmt .= ' -- ' . $h->subfield('z');
+                }
+            }
+        }
+    }
+
+    return $holdings_stmt;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Caption.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Caption.pm
new file mode 100644
index 0000000000..55e6df9d86
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Caption.pm
@@ -0,0 +1,739 @@
+package MFHD::Caption;
+use strict;
+use integer;
+use Carp;
+
+use Data::Dumper;
+
+use OpenILS::Utils::MFHD::Date;
+
+use base 'MARC::Field';
+
+sub new {
+    my $proto     = shift;
+    my $class     = ref($proto) || $proto;
+    my $self      = shift;
+    my $last_enum = undef;
+
+    $self->{_mfhdc_ENUMS}        = {};
+    $self->{_mfhdc_CHRONS}       = {};
+    $self->{_mfhdc_PATTERN}      = {};
+    $self->{_mfhdc_COPY}         = undef;
+    $self->{_mfhdc_UNIT}         = undef;
+    $self->{_mfhdc_LINK_ID}      = undef;
+    $self->{_mfhdc_COMPRESSIBLE} = 1;       # until proven otherwise
+
+    foreach my $subfield ($self->subfields) {
+        my ($key, $val) = @$subfield;
+        if ($key eq '8') {
+            $self->{_mfhdc_LINK_ID} = $val;
+        } elsif ($key =~ /[a-h]/) {
+            # Enumeration Captions
+            $self->{_mfhdc_ENUMS}->{$key} = {
+                CAPTION => $val,
+                COUNT   => undef,
+                RESTART => undef
+            };
+            if ($key =~ /[ag]/) {
+                $last_enum = undef;
+            } else {
+                $last_enum = $key;
+            }
+        } elsif ($key =~ /[i-m]/) {
+            # Chronology captions
+            $self->{_mfhdc_CHRONS}->{$key} = $val;
+        } elsif ($key eq 'u') {
+            # Bib units per next higher enumeration level
+
+	    # Some files seem to have "empty" $u subfields,
+	    # especially for top level of enumeration. Just drop them
+	    next if (!defined($val) || !$val);
+
+            carp('$u specified for top-level enumeration')
+              unless defined($last_enum);
+            $self->{_mfhdc_ENUMS}->{$last_enum}->{COUNT} = $val;
+        } elsif ($key eq 'v') {
+	    # Is this level of enumeration continuous, or does it restart?
+
+	    # Some files seem to have "empty" $v subfields,
+	    # especially for top level of enumeration. Just drop them
+	    next if (!defined($val) || !$val);
+
+            carp '$v specified for top-level enumeration'
+              unless defined($last_enum);
+            $self->{_mfhdc_ENUMS}->{$last_enum}->{RESTART} = ($val eq 'r');
+        } elsif ($key =~ /[npwz]/) {
+            # Publication Pattern info ('o' == type of unit, 'q'..'t' undefined)
+            $self->{_mfhdc_PATTERN}->{$key} = $val;
+        } elsif ($key =~ /x/) {
+            # Calendar change can have multiple comma-separated values
+            $self->{_mfhdc_PATTERN}->{x} = [split /,/, $val];
+        } elsif ($key eq 'y') {
+            $self->{_mfhdc_PATTERN}->{y} = {}
+              unless exists $self->{_mfhdc_PATTERN}->{y};
+            update_pattern($self, $val);
+        } elsif ($key eq 'o') {
+            # Type of unit
+            $self->{_mfhdc_UNIT} = $val;
+        } elsif ($key eq 't') {
+            $self->{_mfhdc_COPY} = $val;
+        } else {
+            carp "Unknown caption subfield '$key'";
+        }
+    }
+
+    # subsequent levels of enumeration (primary and alternate)
+    # If an enumeration level doesn't document the number
+    # of "issues" per "volume", or whether numbering of issues
+    # restarts, then we can't compress.
+    foreach my $key ('b', 'c', 'd', 'e', 'f', 'h') {
+        if (exists $self->{_mfhdc_ENUMS}->{$key}) {
+            my $pattern = $self->{_mfhdc_ENUMS}->{$key};
+            if (   !$pattern->{RESTART}
+                || !$pattern->{COUNT}
+                || ($pattern->{COUNT} eq 'var')
+                || ($pattern->{COUNT} eq 'und')) {
+                $self->{_mfhdc_COMPRESSIBLE} = 0;
+                last;
+            }
+        }
+    }
+
+    my $pat = $self->{_mfhdc_PATTERN};
+
+    # Sanity check publication frequency vs publication pattern:
+    # if the frequency is a number, then the pattern better
+    # have that number of values associated with it.
+    if (   exists($pat->{w})
+        && ($pat->{w} =~ /^\d+$/)
+        && ($pat->{w} != scalar(@{$pat->{y}->{p}}))) {
+        carp(
+"Caption::new: publication frequency '$pat->{w}' != publication pattern @{$pat->{y}->{p}}"
+        );
+    }
+
+    # If there's a $x subfield and a $j, then it's compressible
+    if (exists $pat->{x} && exists $self->{_mfhdc_CHRONS}->{'j'}) {
+        $self->{_mfhdc_COMPRESSIBLE} = 1;
+    }
+
+    bless($self, $class);
+
+    return $self;
+}
+
+sub update_pattern {
+    my $self    = shift;
+    my $val     = shift;
+    my $pathash = $self->{_mfhdc_PATTERN}->{y};
+    my ($pubcode, $pat) = unpack("a1a*", $val);
+
+    $pathash->{$pubcode} = [] unless exists $pathash->{$pubcode};
+    push @{$pathash->{$pubcode}}, $pat;
+}
+
+sub decode_pattern {
+    my $self    = shift;
+    my $pattern = $self->{_mfhdc_PATTERN}->{y};
+
+    # XXX WRITE ME (?)
+}
+
+sub compressible {
+    my $self = shift;
+
+    return $self->{_mfhdc_COMPRESSIBLE};
+}
+
+sub chrons {
+    my $self = shift;
+    my $key  = shift;
+
+    if (exists $self->{_mfhdc_CHRONS}->{$key}) {
+        return $self->{_mfhdc_CHRONS}->{$key};
+    } else {
+        return undef;
+    }
+}
+
+sub capfield {
+    my $self = shift;
+    my $key  = shift;
+
+    if (exists $self->{_mfhdc_ENUMS}->{$key}) {
+        return $self->{_mfhdc_ENUMS}->{$key};
+    } elsif (exists $self->{_mfhdc_CHRONS}->{$key}) {
+        return $self->{_mfhdc_CHRONS}->{$key};
+    } else {
+        return undef;
+    }
+}
+
+sub capstr {
+    my $self = shift;
+    my $key  = shift;
+    my $val  = $self->capfield($key);
+
+    if (ref $val) {
+        return $val->{CAPTION};
+    } else {
+        return $val;
+    }
+}
+
+sub type_of_unit {
+    my $self = shift;
+
+    return $self->{_mfhdc_UNIT};
+}
+
+sub link_id {
+    my $self = shift;
+
+    return $self->{_mfhdc_LINK_ID};
+}
+
+sub calendar_change {
+    my $self = shift;
+
+    return $self->{_mfhdc_PATTERN}->{x};
+}
+
+# If items are identified by chronology only, with no separate
+# enumeration (eg, a newspaper issue), then the chronology is
+# recorded in the enumeration subfields $a - $f.  We can tell
+# that this is the case if there are $a - $f subfields and no
+# chronology subfields ($i-$k), and none of the $a-$f subfields
+# have associated $u or $v subfields, but there's a $w and no $x
+
+sub enumeration_is_chronology {
+    my $self = shift;
+
+    # There is always a '$a' subfield in well-formed fields.
+    return 0
+      if exists $self->{_mfhdc_CHRONS}->{i}
+          || exists $self->{_mfhdc_PATTERN}->{x};
+
+    foreach my $key ('a'..'f') {
+        my $enum;
+
+        last if !exists $self->{_mfhdc_ENUMS}->{$key};
+
+        $enum = $self->{_mfhdc_ENUMS}->{$key};
+        return 0 if defined $enum->{COUNT} || defined $enum->{RESTART};
+    }
+
+    return (exists $self->{_mfhdc_PATTERN}->{w});
+}
+
+sub regularity_match {
+    my $self    = shift;
+    my $pubcode = shift;
+    my @date    = @_;
+
+    # we can't match something that doesn't exist.
+    return 0 if !exists $self->{_mfhdc_PATTERN}->{y}->{$pubcode};
+
+    foreach my $regularity (@{$self->{_mfhdc_PATTERN}->{y}->{$pubcode}}) {
+        my $chroncode = substr($regularity, 0, 1);
+        my $matchfunc = MFHD::Date::dispatch($chroncode);
+        my @pats      = split(/,/, substr($regularity, 1));
+
+        if (!defined $matchfunc) {
+            carp "Unrecognized chroncode '$chroncode'";
+            return 0;
+        }
+
+        # XXX WRITE ME
+        foreach my $pat (@pats) {
+            $pat =~ s|/.+||;    # If it's a combined date, match the start
+            if ($matchfunc->($pat, @date)) {
+                return 1;
+            }
+        }
+    }
+
+    return 0;
+}
+
+sub is_omitted {
+    my $self = shift;
+    my @date = @_;
+
+    #     printf("# is_omitted: testing date %s: %d\n", join('/', @date),
+    # 	   $self->regularity_match('o', @date));
+    return $self->regularity_match('o', @date);
+}
+
+sub is_published {
+    my $self = shift;
+    my @date = @_;
+
+    return $self->regularity_match('p', @date);
+}
+
+sub is_combined {
+    my $self = shift;
+    my @date = @_;
+
+    return $self->regularity_match('c', @date);
+}
+
+sub enum_is_combined {
+    my $self     = shift;
+    my $subfield = shift;
+    my $iss      = shift;
+    my $level    = ord($subfield) - ord('a') + 1;
+
+    return 0 if !exists $self->{_mfhdc_PATTERN}->{y}->{c};
+
+    foreach my $regularity (@{$self->{_mfhdc_PATTERN}->{y}->{c}}) {
+        next unless $regularity =~ m/^e$level/o;
+
+        my @pats = split(/,/, substr($regularity, 2));
+
+        foreach my $pat (@pats) {
+            $pat =~ s|/.+||;    # if it's a combined issue, match the start
+            return 1 if ($iss eq $pat);
+        }
+    }
+
+    return 0;
+}
+
+# Test to see if $dt1 is on or after $dt2
+# if length(@{$dt2} == 2, then just month/day are compared
+# if length(@{$dt2} == 1, then just the months are compared
+sub on_or_after {
+    my $dt1 = shift;
+    my $dt2 = shift;
+
+#     printf("# on_or_after(%s, %s): ", join('/', @{$dt1}), join('/', @{$dt2}));
+
+    foreach my $i (0..(scalar(@{$dt2}) - 1)) {
+        if ($dt1->[$i] > $dt2->[$i]) {
+            # 	    printf("after - pass\n");
+            # $dt1 occurs AFTER $dt2
+            return 1;
+        } elsif ($dt1->[$i] < $dt2->[$i]) {
+            # 	    printf("before - fail\n");
+            # $dt1 occurs BEFORE $dt2
+            return 0;
+        }
+        # both are still equal, keep going
+    }
+
+    # We fell out of the loop with them being equal, so it's 'on'
+    #     printf("on - pass\n");
+    return 1;
+}
+
+sub calendar_increment {
+    my $self       = shift;
+    my $cur        = shift;
+    my $new        = shift;
+    my $cal_change = $self->calendar_change;
+    my $month;
+    my $day;
+    my $cur_before;
+    my $new_on_or_after;
+
+    # A calendar change is defined, need to check if it applies
+    if (scalar(@{$new}) == 1) {
+        carp "Can't calculate date change for ", $self->as_string;
+        return 0;
+    }
+
+    foreach my $change (@{$cal_change}) {
+        my $incr;
+
+        if (length($change) == 2) {
+            $month = $change;
+        } elsif (length($change) == 4) {
+            ($month, $day) = unpack("a2a2", $change);
+        }
+
+        # 	printf("# calendar_increment('%s', '%s'): change on '%s/%s'\n",
+        # 	       join('/', @{$cur}), join('/', @{$new}),
+        # 	       $month, defined($day) ? $day : 'UNDEF');
+
+        if ($cur->[0] == $new->[0]) {
+            # Same year, so a 'simple' month/day comparison will be fine
+            $incr =
+              (     !on_or_after([$cur->[1], $cur->[2]], [$month, $day])
+                  && on_or_after([$new->[1], $new->[2]], [$month, $day]));
+        } else {
+            # @cur is in the year before @new. There are
+            # two possible cases for the calendar change date that
+            # indicate that it's time to change the volume:
+            # (1) the change date is AFTER @cur in the year, or
+            # (2) the change date is BEFORE @new in the year.
+            #
+            #  -------|------|------X------|------|
+            #       @cur    (1)   Jan 1   (2)   @new
+
+            $incr =
+              (on_or_after([$new->[1], $new->[2]], [$month, $day])
+                  || !on_or_after([$cur->[1], $cur->[2]], [$month, $day]));
+        }
+        return $incr if $incr;
+    }
+
+    return 0;
+}
+
+sub next_chron {
+    my $self  = shift;
+    my $next  = shift;
+    my $carry = shift;
+    my @keys  = @_;
+    my @cur;
+    my @new;
+    my @newend;    # only used for combined issues
+    my $incr;
+
+    my $reg     = $self->{_mfhdc_REGULARITY};
+    my $pattern = $self->{_mfhdc_PATTERN};
+    my $freq    = $pattern->{w};
+
+    foreach my $i (0..$#keys) {
+        $cur[$i] = $next->{$keys[$i]} if exists $next->{$keys[$i]};
+    }
+
+    # If the current issue has a combined date (eg, May/June)
+    # get rid of the first date and base the calculation
+    # on the final date in the combined issue.
+    $cur[-1] =~ s|^[^/]+/||;
+
+    if (defined $pattern->{y}->{p}) {
+        # There is a $y publication pattern defined in the record:
+        # use it to calculate the next issue date.
+
+        foreach my $pubpat (@{$pattern->{y}->{p}}, @{$pattern->{y}->{c}}) {
+            my $chroncode = substr($pubpat, 0, 1);
+            my $genfunc   = MFHD::Date::generator($chroncode);
+            my @pats      = split(/,/, substr($pubpat, 1));
+
+            next if $chroncode eq 'e';
+
+            if (!defined $genfunc) {
+                carp "Unrecognized chroncode '$chroncode'";
+                return undef;
+            }
+
+            foreach my $pat (@pats) {
+                my $combined = $pat =~ m|/|;
+                my ($start, $end);
+                my @candidate;
+
+                # 		printf("# next_date: generating with pattern '%s'\n", $pat);
+
+                if ($combined) {
+                    ($start, $end) = split('/', $pat, 2);
+                } else {
+                    ($start, $end) = (undef, undef);
+                }
+
+                @candidate = $genfunc->($start || $pat, @cur);
+
+                while ($self->is_omitted(@candidate)) {
+                    # 		    printf("# pubpat omitting date '%s'\n",
+                    # 			   join('/', @candidate));
+                    @candidate = $genfunc->($start || $pat, @candidate);
+                }
+
+                # 		printf("# testing new candidate '%s' against '%s'\n",
+                # 		       join('/', @candidate), join('/', @new));
+
+                if (!defined($new[0]) || !on_or_after(\@candidate, \@new)) {
+                    # first time through the loop
+                    # or @candidate is before @new =>
+                    # @candidate is the next issue.
+                    @new = @candidate;
+                    if (defined $end) {
+                        @newend = $genfunc->($end, @cur);
+                    } else {
+                        $newend[0] = undef;
+                    }
+
+           # 		    printf("# selecting candidate date '%s'\n", join('/', @new));
+                }
+            }
+        }
+
+        if (defined($newend[0])) {
+            # The best match was a combined issue
+            foreach my $i (0..$#new) {
+                # don't combine identical fields
+                next if $new[$i] eq $newend[$i];
+                $new[$i] .= '/' . $newend[$i];
+            }
+        }
+    }
+
+    if (scalar @new == 0) {
+        # There was no suitable publication pattern defined,
+        # so use the $w frequency to figure out the next date
+        if (!defined($freq)) {
+            carp "Undefined frequency in next_chron!";
+        } elsif (!MFHD::Date::can_increment($freq)) {
+            carp "Don't know how to deal with frequency '$freq'!";
+        } else {
+            # One of the standard defined issue frequencies
+            @new = MFHD::Date::incr_date($freq, @cur);
+
+            while ($self->is_omitted(@new)) {
+                @new = MFHD::Date::incr_date($freq, @new);
+            }
+
+            if ($self->is_combined(@new)) {
+                my @second_date = MFHD::Date::incr_date($freq, @new);
+
+                # I am cheating: This code assumes that only the smallest
+                # time increment is combined. So, no "Apr 15/May 1" allowed.
+                $new[-1] = $new[-1] . '/' . $second_date[-1];
+            }
+        }
+    }
+
+    for my $i (0..$#new) {
+        $next->{$keys[$i]} = $new[$i];
+    }
+    # Figure out if we need to adjust volume number
+    # right now just use the $carry that was passed in.
+    # in long run, need to base this on ($carry or date_change)
+    if ($carry) {
+        # if $carry is set, the date doesn't matter: we're not
+        # going to increment the v. number twice at year-change.
+        $next->{a} += $carry;
+    } elsif (defined $pattern->{x}) {
+        $next->{a} += $self->calendar_increment(\@cur, \@new);
+    }
+}
+
+sub next_alt_enum {
+    my $self = shift;
+    my $next = shift;
+
+    # First handle any "alternative enumeration", since they're
+    # a lot simpler, and don't depend on the the calendar
+    foreach my $key ('h', 'g') {
+        next if !exists $next->{$key};
+        if (!$self->capstr($key)) {
+            warn "Holding data exists for $key, but no caption specified";
+            $next->{$key} += 1;
+            last;
+        }
+
+        my $cap = $self->capfield($key);
+        if (   $cap->{RESTART}
+            && $cap->{COUNT}
+            && ($next->{$key} == $cap->{COUNT})) {
+            $next->{$key} = 1;
+        } else {
+            $next->{$key} += 1;
+            last;
+        }
+    }
+}
+
+# Check caption for $ype subfield, specifying that there's a
+# particular publication pattern for the given level of enumeration
+# returns the pattern string or undef
+sub enum_pubpat {
+    my $self  = shift;
+    my $level = shift;
+
+    return undef if !exists $self->{_mfhdc_PATTERN}->{y}->{p};
+
+    foreach my $reg (@{$self->{_mfhdc_PATTERN}->{y}->{p}}) {
+        if ($reg =~ m/^e$level/o) {
+            return substr($reg, 2);
+        }
+    }
+    return undef;
+}
+
+sub next_enum {
+    my $self = shift;
+    my $next = shift;
+    my $carry;
+
+    # $carry keeps track of whether we need to carry into the next
+    # higher level of enumeration. It's not actually necessary except
+    # for when the loop ends: if we need to carry from $b into $a
+    # then $carry will be set when the loop ends.
+    #
+    # We need to keep track of this because there are two different
+    # reasons why we might increment the highest level of enumeration ($a)
+    # 1) we hit the correct number of items in $b (ie, 5th iss of quarterly)
+    # 2) it's the right time of the year.
+    #
+
+    # If there's a subfield b, then we will go through the loop at
+    # least once. If there's no subfield b, then there's only a single
+    # level of enumeration, so we just add one to it and we're done.
+    if (exists $next->{b}) {
+        $carry = 0;
+    } else {
+        $carry = 1;
+    }
+    foreach my $key (reverse('b'..'f')) {
+        my $level;
+        my $pubpat;
+
+        next if !exists $next->{$key};
+
+        # If the current issue has a combined issue number (eg, 2/3)
+        # get rid of the first issue number and base the calculation
+        # on the final issue number in the combined issue.
+        if ($next->{$key} =~ m|/|) {
+            $next->{$key} =~ s|^[^/]+/||;
+        }
+
+        $level = ord($key) - ord('a') + 1;    # enumeration level
+
+        $pubpat = $self->enum_pubpat($level);
+
+        if ($pubpat) {
+            # 	    printf("# next_enum: found pubpat '%s' for subfield '%s'\n",
+            # 		   $pubpat, $key);
+            my @pats = split(/,/, $pubpat);
+
+            # If we fall out the bottom of the loop, then $carry
+            # will still be 1, and we will reset the current
+            # level to the first value in @pats and increment
+            # then next higher level.
+            $carry = 1;
+
+            foreach my $pat (@pats) {
+                my $combined = $pat =~ m|/|;
+                my $end;
+
+             # 		printf("# next_enum: checking current '%s' against pat '%s'\n",
+             # 		       $next->{$key}, $pat);
+
+                if ($combined) {
+                    ($pat, $end) = split('/', $pat, 2);
+                } else {
+                    $end = undef;
+                }
+
+                if ($pat > $next->{$key}) {
+                    $carry = 0;
+                    $next->{$key} = $pat;
+                    $next->{$key} .= '/' . $end if $end;
+     # 		    printf("# next_enum: selecting new issue no. %s\n", $next->{$key});
+                    last;    # We've found the correct next issue number
+                }
+            }
+            if ($carry) {
+                $next->{$key} = $pats[0];
+            } else {
+                last;        # exit the top level loop because we're done
+            }
+
+        } else {
+            # No enumeration publication pattern specified for this level,
+            # just keep adding one.
+
+            if (!$self->capstr($key)) {
+                # Just assume that it increments continuously and give up
+                warn "Holding data exists for $key, but no caption specified";
+                $next->{$key} += 1;
+                $carry = 0;
+                last;
+            }
+
+        # 	    printf("# next_enum: no publication pattern, using frequency\n");
+
+            my $cap = $self->capfield($key);
+            if (   $cap->{RESTART}
+                && $cap->{COUNT}
+                && ($next->{$key} eq $cap->{COUNT})) {
+                $next->{$key} = 1;
+                $carry = 1;
+            } else {
+                # If I don't need to "carry" beyond here, then I just increment
+                # this level of the enumeration and stop looping, since the
+                # "next" hash has been initialized with the current values
+
+                $next->{$key} += 1;
+                $carry = 0;
+            }
+
+            # You can't have a combined issue that spans two volumes: no.12/1
+            # is forbidden
+            if ($self->enum_is_combined($key, $next->{$key})) {
+                $next->{$key} .= '/' . ($next->{$key} + 1);
+            }
+
+            last if !$carry;
+        }
+    }
+
+    # The easy part is done. There are two things left to do:
+    # 1) Calculate the date of the next issue, if necessary
+    # 2) Increment the highest level of enumeration (either by date
+    #    or because $carry is set because of the above loop
+
+    if (!$self->subfield('i') || !$next->{i}) {
+        # The simple case: if there is no chronology specified
+        # then just check $carry and return
+        $next->{'a'} += $carry;
+    } else {
+        # Figure out date of next issue, then decide if we need
+        # to adjust top level enumeration based on that
+        $self->next_chron($next, $carry, ('i'..'m'));
+    }
+}
+
+sub next {
+    my $self    = shift;
+    my $holding = shift;
+    my $next    = {};
+
+    # If the holding is compressed and not open ended, base next() on the
+    # closing date.  If the holding is open-ended, next() is undefined
+    my $index;
+    if ($holding->is_compressed) {
+        return undef if $holding->is_open_ended;
+        # TODO: error on next for open-ended holdings?
+        $index = 1;
+    } else {
+        $index = 0;
+    }
+
+    # Initialize $next with current enumeration & chronology, then
+    # we can just operate on $next, based on the contents of the caption
+    foreach my $key ('a'..'m') {
+        my $holding_values = $holding->field_values($key);
+        $next->{$key} = ${$holding_values}[$index] if defined $holding_values;
+    }
+
+    if ($self->enumeration_is_chronology) {
+        $self->next_chron($next, 0, ('a'..'h'));
+        return $next;
+    }
+
+    if (exists $next->{'h'}) {
+        $self->next_alt_enum($next);
+    }
+
+    $self->next_enum($next);
+
+    return ($next);
+}
+
+# return a simple subfields list
+sub subfields_list {
+    my $self = shift;
+    my @subfields;
+
+    foreach my $subfield ($self->subfields) {
+        push(@subfields, $subfield->[0], $subfield->[1]);
+    }
+    return @subfields;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Date.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Date.pm
new file mode 100644
index 0000000000..34c85d9691
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Date.pm
@@ -0,0 +1,580 @@
+package MFHD::Date;
+use strict;
+use integer;
+use Carp;
+
+use Data::Dumper;
+use DateTime;
+
+use base 'Exporter';
+
+our @EXPORT_OK = qw(dispatch generator incr_date can_increment);
+
+my %daynames = (
+    'mo' => 1,
+    'tu' => 2,
+    'we' => 3,
+    'th' => 4,
+    'fr' => 5,
+    'sa' => 6,
+    'su' => 7,
+);
+
+my $daypat  = '(mo|tu|we|th|fr|sa|su)';
+my $weekpat = '(99|98|97|00|01|02|03|04|05)';
+my $weeknopat;
+my $monthpat  = '(01|02|03|04|05|06|07|08|09|10|11|12)';
+my $seasonpat = '(21|22|23|24)';
+
+# Initialize $weeknopat to be '(01|02|03|...|51|52|53)'
+$weeknopat = '(';
+foreach my $weekno (1..52) {
+    $weeknopat .= sprintf('%02d|', $weekno);
+}
+$weeknopat .= '53)';
+
+sub match_day {
+    my $pat  = shift;
+    my @date = @_;
+    # Translate daynames into day of week for DateTime
+    # also used to check if dayname is valid.
+
+    if (exists $daynames{$pat}) {
+        # dd
+        # figure out day of week for date and compare
+        my $dt = DateTime->new(
+            year  => $date[0],
+            month => $date[1],
+            day   => $date[2]
+        );
+        return ($dt->day_of_week == $daynames{$pat});
+    } elsif (length($pat) == 2) {
+        # DD
+        return $pat == $date[2];
+    } elsif (length($pat) == 4) {
+        # MMDD
+        my ($mon, $day) = unpack("a2a2", $pat);
+
+        return (($mon == $date[1]) && ($day == $date[2]));
+    } else {
+        carp "Invalid day pattern '$pat'";
+        return 0;
+    }
+}
+
+sub subsequent_day {
+    my $pat = shift;
+    my @cur = @_;
+    my $dt  = DateTime->new(
+        year  => $cur[0],
+        month => $cur[1],
+        day   => $cur[2]
+    );
+
+   #     printf("# subsequent_day: pat='%s' cur='%s'\n", $pat, join('/', @cur));
+
+    if (exists $daynames{$pat}) {
+        # dd: published on the given weekday
+        my $dow  = $dt->day_of_week;
+        my $corr = ($daynames{$pat} - $dow + 7) % 7;
+
+        if ($dow == $daynames{$pat}) {
+            # the next one is one week hence
+            $dt->add(days => 7);
+        } else {
+            # the next one is later this week,
+            # or it is next week (ie, on or after next Monday)
+            # $corr will take care of it.
+            $dt->add(days => $corr);
+        }
+        @cur = ($dt->year, $dt->month, $dt->day);
+    } elsif (length($pat) == 2) {
+        # DD: published on the give day of every month
+        if ($dt->day >= $pat) {
+            # current date is on or after $pat: next one is next month
+            $dt->set(day => $pat);
+            $dt->add(months => 1);
+            @cur = ($dt->year, $dt->month, $dt->day);
+        } else {
+            # current date is before $pat: set day to pattern
+            $cur[2] = $pat;
+        }
+    } elsif (length($pat) == 4) {
+        # MMDD: published on the given day of the given month
+        my ($mon, $day) = unpack("a2a2", $pat);
+
+        if (on_or_after($mon, $day, $cur[1], $cur[2])) {
+            # Current date is on or after pattern; next one is next year
+            $cur[0] += 1;
+        }
+        # Year is now right. Either it's next year (because of on_or_after)
+        # or it's this year, because the current date is NOT on or after
+        # the pattern. Just fix the month and day
+        $cur[1] = $mon;
+        $cur[2] = $day;
+    } else {
+        carp "Invalid day pattern '$pat'";
+        return undef;
+    }
+
+    foreach my $i (0..$#cur) {
+        $cur[$i] = '0' . (0 + $cur[$i]) if $cur[$i] < 10;
+    }
+
+    #     printf("subsequent_day: returning '%s'\n", join('/', @cur));
+
+    return @cur;
+}
+
+# Calculate date of 3rd Friday of the month (for example)
+# 1-5: count from beginning of month
+# 99-97: count back from end of month
+sub nth_week_of_month {
+    my $dt   = shift;
+    my $week = shift;
+    my $day  = shift;
+    my ($nth_day, $dow);
+
+    #     printf("# nth_week_of_month(dt, '%s', '%s')\n", $week, $day);
+
+    if (0 < $week && $week <= 5) {
+        $nth_day = $dt->clone->set(day => 1);
+    } elsif ($week >= 97) {
+        $nth_day = DateTime->last_day_of_month(
+            year  => $dt->year,
+            month => $dt->month
+        );
+    } else {
+        return undef;
+    }
+
+    $dow = $nth_day->day_of_week();
+
+    # If a particular day was passed in (eg, we want 3rd friday)
+    # then use that day for the calculations, otherwise, just use
+    # the day of the week of the original date (the date $dt).
+    if (defined($day)) {
+        $day = $daynames{$day};
+    } else {
+        $day = $dt->day_of_week;
+    }
+
+    if ($week <= 5) {
+        # count forwards
+        $nth_day->add(
+            days  => ($day - $dow + 7) % 7,
+            weeks => $week - 1
+        );
+    } else {
+        # count backwards
+        $nth_day->subtract(days => ($day - $dow + 7) % 7);
+
+        # 99: last week of month, 98: second last, etc.
+        for (my $i = 99 - $week; $i > 0; $i--) {
+            $nth_day->subtract(weeks => 1);
+        }
+    }
+
+    # There is no nth "day" in the month!
+    return undef if ($dt->month != $nth_day->month);
+
+    return $nth_day;
+}
+
+#
+# Internal utility function to match the various different patterns
+# of month, week, and day
+#
+sub check_date {
+    my $dt     = shift;
+    my $month  = shift;
+    my $weekno = shift;
+    my $day    = shift;
+
+    #     printf("check_date('%s', '%s', '%s')\n", $month, $weekno, $day || '');
+
+    if (!defined $day) {
+        # MMWW
+        return (
+            ($dt->month == $month)
+              && (
+                ($dt->week_of_month == $weekno)
+                || (
+                    $weekno >= 97
+                    && ($dt->week_of_month ==
+                        nth_week_of_month($dt, $weekno, $day)->week_of_month)
+                )
+              )
+        );
+    }
+
+    # simple cases first
+    if ($daynames{$day} != $dt->day_of_week) {
+        # if it's the wrong day of the week, rest doesn't matter
+        return 0;
+    }
+
+    if (!defined $month) {
+        # WWdd
+        return (
+            ($weekno == 0)    # Every week
+              || ($dt->weekday_of_month == $weekno)    # this week
+              || (
+                ($weekno >= 97)
+                && ($dt->weekday_of_month ==
+                    nth_week_of_month($dt, $weekno, $day)->weekday_of_month)
+              )
+        );
+    }
+
+    # MMWWdd
+    if ($month != $dt->month) {
+        # If it's the wrong month, then we're done
+        return 0;
+    }
+
+    # It's the right day of the week
+    # It's the right month
+
+    if (($weekno == 0) || ($weekno == $dt->weekday_of_month)) {
+        # If this matches, then we're counting from the beginning
+        # of the month and it matches and we're done.
+        return 1;
+    }
+
+    # only case left is that the week number is counting from
+    # the end of the month: eg, second last wednesday
+    return (
+        ($weekno >= 97)
+          && (nth_week_of_month($dt, $weekno, $day)->weekday_of_month ==
+            $dt->weekday_of_month)
+    );
+}
+
+sub match_week {
+    my $pat  = shift;
+    my @date = @_;
+    my $dt   = DateTime->new(
+        year  => $date[0],
+        month => $date[1],
+        day   => $date[2]
+    );
+
+    if ($pat =~ m/^$weekpat$daypat$/) {
+        # WWdd: 03we = Third Wednesday
+        return check_date($dt, undef, $1, $2);
+    } elsif ($pat =~ m/^$monthpat$weekpat$daypat$/) {
+        # MMWWdd: 0599tu Last Tuesday in May XXX WRITE ME
+        return check_date($dt, $1, $2, $3);
+    } elsif ($pat =~ m/^$monthpat$weekpat$/) {
+        # MMWW: 1204: Fourth week in December XXX WRITE ME
+        return check_date($dt, $1, $2, undef);
+    } else {
+        carp "invalid week pattern '$pat'";
+        return 0;
+    }
+}
+
+#
+# Use $pat to calcuate the date of the issue following $cur
+#
+sub subsequent_week {
+    my $pat = shift;
+    my @cur = @_;
+    my $candidate;
+    my $dt;
+
+    #     printf("# subsequent_week('%s', '%s', '%s', '%s')\n", $pat, @cur);
+
+    $dt = DateTime->new(
+        year  => $cur[0],
+        month => $cur[1],
+        day   => $cur[2]
+    );
+
+    if ($pat =~ m/^$weekpat$daypat$/o) {
+        # WWdd: published on given weekday of given week of every month
+        my ($week, $day) = ($1, $2);
+
+        # 	printf("# subsequent_week: matched /WWdd/: week='%s', day='%s'\n",
+        # 	       $week, $day);
+
+        if ($week eq '00') {
+            # Every week
+            $candidate = $dt->clone;
+
+            if ($dt->day_of_week == $daynames{$day}) {
+                # Current is right day, next one is a week hence
+                $candidate->add(days => 7);
+            } else {
+                $candidate->add(
+                    days => ($daynames{$day} - $dt->day_of_week + 7) % 7);
+            }
+        } else {
+            # 3rd Friday of the month (eg)
+            $candidate = nth_week_of_month($dt, $week, $day);
+        }
+
+        if ($candidate <= $dt) {
+# If the n'th week of the month happens on before the
+# current issue, then the next issue is published next
+# month, otherwise, it's published this month.
+# This will never happen for the "00: every week" pattern
+# 	    printf("# subsequent_week: candidate (%s) occurs on or before current date (%s)\n",
+# 		   join('/', $candidate->year, $candidate->month, $candidate->day),
+# 		   join('/', $dt->year, $dt->month, $dt->day));
+            $candidate->set(day => 1);
+            $candidate->add(months => 1);
+            $candidate = nth_week_of_month($candidate, $week, $day);
+        }
+    } elsif ($pat =~ m/^$monthpat$weekpat$daypat$/) {
+        # MMWWdd: published on given weekday of given week of given month
+        my ($month, $week, $day) = ($1, $2, $3);
+
+# 	printf("# subsequent_week: matched /MMWWdd/: month='%s', week='%s', day='%s'\n",
+# 	       $month, $week, $day);
+
+        $candidate = DateTime->new(
+            year  => $dt->year,
+            month => $month,
+            day   => 1
+        );
+        $candidate = nth_week_of_month($candidate, $week, $day);
+        if ($candidate <= $dt) {
+            # We've missed it for this year, next one that matches
+            # will be next year
+            $candidate->add(years => 1)->set(day => 1);
+            $candidate = nth_week_of_month($candidate, $week, $day);
+        }
+    } elsif ($pat =~ m/^$monthpat$weekpat$/) {
+        # MMWW: published during given week of given month
+        my ($month, $week) = ($1, $2);
+
+        $candidate = nth_week_of_month(
+            DateTime->new(
+                year  => $dt->year,
+                month => $month,
+                day   => 1
+            ),
+            $week, 'th'
+        );
+        if ($candidate <= $dt) {
+            # Already past the pattern date this year, move to next year
+            $candidate->add(years => 1)->set(day => 1);
+            $candidate = nth_week_of_month($candidate, $week, 'th');
+        }
+    } else {
+        carp "invalid week pattern '$pat'";
+        return undef;
+    }
+
+    $cur[0] = $candidate->year;
+    $cur[1] = $candidate->month;
+    $cur[2] = $candidate->day;
+
+    foreach my $i (0..$#cur) {
+        $cur[$i] = '0' . (0 + $cur[$i]) if $cur[$i] < 10;
+    }
+
+    return @cur;
+}
+
+sub match_month {
+    my $pat  = shift;
+    my @date = @_;
+
+    return ($pat eq $date[1]);
+}
+
+sub subsequent_month {
+    my $pat = shift;
+    my @cur = @_;
+
+    if ($cur[1] >= $pat) {
+        # Current date is on or after the patter date, so the next
+        # occurence is next year
+        $cur[0] += 1;
+    }
+
+    # The year is right, just set the month to the pattern date.
+    $cur[1] = $pat;
+
+    return @cur;
+}
+
+sub match_season {
+    my $pat  = shift;
+    my @date = @_;
+
+    return ($pat eq $date[1]);
+}
+
+sub subsequent_season {
+    my $pat = shift;
+    my @cur = @_;
+
+#     printf("# subsequent_season: pat='%s', cur='%s'\n", $pat, join('/',@cur));
+
+    if (($pat < 21) || ($pat > 24)) {
+        carp "Unexpected season '$pat'";
+        return undef;
+    }
+
+    if ($cur[1] >= $pat) {
+        # current season is on or past pattern season in this year,
+        # advance to next year
+        $cur[0] += 1;
+    }
+    # Either we've advanced to the next year or the current season
+    # is before the pattern season in the current year. Either way,
+    # all that remains is to set the season properly
+    $cur[1] = $pat;
+
+    return @cur;
+}
+
+sub match_year {
+    my $pat  = shift;
+    my @date = @_;
+
+    # XXX WRITE ME
+    return 0;
+}
+
+sub subsequent_year {
+    my $pat = shift;
+    my $cur = shift;
+
+    # XXX WRITE ME
+    return undef;
+}
+
+sub match_issue {
+    my $pat  = shift;
+    my @date = @_;
+
+    # We handle enumeration patterns separately. This just
+    # ensures that when we're processing chronological patterns
+    # we don't match an enumeration pattern.
+    return 0;
+}
+
+sub subsequent_issue {
+    my $pat = shift;
+    my $cur = shift;
+
+    # Issue generation is handled separately
+    return undef;
+}
+
+my %dispatch = (
+    d => \&match_day,
+    e => \&match_issue,    # not really a "chron" code
+    w => \&match_week,
+    m => \&match_month,
+    s => \&match_season,
+    y => \&match_year,
+);
+
+my %generators = (
+    d => \&subsequent_day,
+    e => \&subsequent_issue,    # not really a "chron" code
+    w => \&subsequent_week,
+    m => \&subsequent_month,
+    s => \&subsequent_season,
+    y => \&subsequent_year,
+);
+
+sub dispatch {
+    my $chroncode = shift;
+
+    return $dispatch{$chroncode};
+}
+
+sub generator {
+    my $chroncode = shift;
+
+    return $generators{$chroncode};
+}
+
+my %increments = (
+    a => {years  => 1},     # annual
+    b => {months => 2},     # bimonthly
+    c => {days   => 3},     # semiweekly
+    d => {days   => 1},     # daily
+    e => {weeks  => 2},     # biweekly
+    f => {months => 6},     # semiannual
+    g => {years  => 2},     # biennial
+    h => {years  => 3},     # triennial
+    i => {days   => 2},     # three times / week
+    j => {days   => 10},    # three times /month
+                            # k => continuous
+    m => {months => 1},     # monthly
+    q => {months => 3},     # quarterly
+    s => {days   => 15},    # semimonthly
+    t => {months => 4},     # three times / year
+    w => {weeks  => 1},     # weekly
+                            # x => completely irregular
+);
+
+sub can_increment {
+    my $freq = shift;
+
+    return exists $increments{$freq};
+}
+
+# TODO: add support for weeks as chron level?
+sub incr_date {
+    my $freq = shift;
+    my $incr = $increments{$freq};
+    my @new  = @_;
+
+    if (scalar(@new) == 1) {
+        # only a year is specified. Next date is easy
+        $new[0] += $incr->{years} || 1;
+    } elsif (scalar(@new) == 2) {
+        # Year and month or season
+        if ($new[1] > 20) {
+            # season
+            $new[1] += ($incr->{months} / 3) || 1;
+            if ($new[1] > 24) {
+                # carry
+                $new[0] += 1;
+                $new[1] -= 4;    # 25 - 4 == 21 == Spring after Winter
+            }
+        } else {
+            # month
+            $new[1] += $incr->{months} || 1;
+            if ($new[1] > 12) {
+                # carry
+                $new[0] += 1;
+                $new[1] -= 12;
+            }
+        }
+    } elsif (scalar(@new) == 3) {
+        # Year, Month, Day: now it gets complicated.
+
+        if ($new[2] =~ /^[0-9]+$/) {
+            # A single number for the day of month, relatively simple
+            my $dt = DateTime->new(
+                year  => $new[0],
+                month => $new[1],
+                day   => $new[2]
+            );
+            $dt->add(%{$incr});
+            $new[0] = $dt->year;
+            $new[1] = $dt->month;
+            $new[2] = $dt->day;
+        }
+    } else {
+        warn("Don't know how to cope with @new");
+    }
+
+    foreach my $i (0..$#new) {
+        $new[$i] = '0' . (0 + $new[$i]) if $new[$i] < 10;
+    }
+
+    return @new;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Holding.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Holding.pm
new file mode 100644
index 0000000000..efd6027ba2
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Holding.pm
@@ -0,0 +1,793 @@
+# MFHD::Holding provides some additional holdings logic to a MARC::Field
+# object.  In its current state it is primarily read-only, as direct changes
+# to the underlying MARC::Field are not reflected in the MFHD logic layer, and
+# only the 'increment', 'notes', and 'seqno' methods do updates to the
+# MARC::Field layer.
+
+package MFHD::Holding;
+use strict;
+use integer;
+
+use Carp;
+use DateTime;
+use Data::Dumper;
+
+use base 'MARC::Field';
+
+sub new {
+    my $proto     = shift;
+    my $class     = ref($proto) || $proto;
+    my $seqno     = shift;
+    my $self      = shift;
+    my $caption   = shift;
+    my $last_enum = undef;
+
+    $self->{_mfhdh_SEQNO}          = $seqno;
+    $self->{_mfhdh_CAPTION}        = $caption;
+    $self->{_mfhdh_DESCR}          = {};
+    $self->{_mfhdh_COPY}           = undef;
+    $self->{_mfhdh_BREAK}          = undef;
+    $self->{_mfhdh_NOTES}          = {};
+    $self->{_mfhdh_NOTES}{public}  = [];
+    $self->{_mfhdh_NOTES}{private} = [];
+    $self->{_mfhdh_COPYRIGHT}      = [];
+    $self->{_mfhdh_COMPRESSED}     = ($self->indicator(2) eq '0' || $self->indicator(2) eq '2') ? 1 : 0;
+    # TODO: full support for second indicators 2, 3, and 4
+    $self->{_mfhdh_OPEN_ENDED}     = 0;
+
+    foreach my $subfield ($self->subfields) {
+        my ($key, $val) = @$subfield;
+
+        if ($key =~ /[a-m]/) {
+            if (exists($self->{_mfhdh_FIELDS}->{$key})) {
+                carp("Duplicate, non-repeatable subfield '$key' found, ignoring");
+                next;
+            }
+            if ($self->{_mfhdh_COMPRESSED}) {
+                $self->{_mfhdh_FIELDS}->{$key}{HOLDINGS} = [split(/\-/, $val)];
+            } else {
+                $self->{_mfhdh_FIELDS}->{$key}{HOLDINGS} = [$val];
+            }
+            if ($key =~ /[a-h]/) {
+                # Enumeration specific details of holdings
+                $self->{_mfhdh_FIELDS}->{$key}{UNIT} = undef;
+                $last_enum = $key;
+            }
+        } elsif ($key eq 'o') {
+            warn '$o specified prior to first enumeration'
+              unless defined($last_enum);
+            $self->{_mfhdh_FIELDS}->{$last_enum}->{UNIT} = $val;
+            $last_enum = undef;
+        } elsif ($key =~ /[npq]/) {
+            $self->{_mfhdh_DESCR}->{$key} = $val;
+        } elsif ($key eq 's') {
+            push @{$self->{_mfhdh_COPYRIGHT}}, $val;
+        } elsif ($key eq 't') {
+            $self->{_mfhdh_COPY} = $val;
+        } elsif ($key eq 'w') {
+            carp "Unrecognized break indicator '$val'"
+              unless $val =~ /^[gn]$/;
+            $self->{_mfhdh_BREAK} = $val;
+        } elsif ($key eq 'x') {
+            push @{$self->{_mfhdh_NOTES}{private}}, $val;
+        } elsif ($key eq 'z') {
+            push @{$self->{_mfhdh_NOTES}{public}}, $val;
+        }
+    }
+
+    if (   $self->{_mfhdh_COMPRESSED}
+        && $self->{_mfhdh_FIELDS}{'a'}{HOLDINGS}[1] eq '') {
+        $self->{_mfhdh_OPEN_ENDED} = 1;
+    }
+    bless($self, $class);
+    return $self;
+}
+
+#
+# accessor to the object's field hash
+#
+# We are avoiding calling these elements 'subfields' because they are more
+# than simply the MARC subfields, although in the current implementation they
+# are indexed on the subfield key
+#
+# TODO: this accessor should probably be replaced with methods which hide the
+# underlying structure of {_mfhdh_FIELDS} (see field_values for a start)
+#
+sub fields {
+    my $self = shift;
+
+    return $self->{_mfhdh_FIELDS};
+}
+
+#
+# Given a field key, returns an array ref of one (for single statements)
+# or two (for compressed statements) values
+#
+# TODO: add setter functionality to replace direct {HOLDINGS} access in other
+# methods. It also makes sense to override some of the MARC::Field setter
+# methods (such as update()) to accomplish this level of encapsulation.
+#
+sub field_values {
+    my ($self, $key) = @_;
+
+    if (exists $self->fields->{$key}) {
+        my @values = @{$self->fields->{$key}{HOLDINGS}};
+        return \@values;
+    } else {
+        return undef;
+    }
+}
+
+sub seqno {
+    my $self = shift;
+
+    if (@_) {
+        $self->{_mfhdh_SEQNO} = $_[0];
+        $self->update(8 => $self->caption->link_id . '.' . $_[0]);
+    }
+
+    return $self->{_mfhdh_SEQNO};
+}
+
+#
+# Optionally accepts a true/false value to set the 'compressed' attribute
+# Returns 'compressed' attribute
+#
+sub is_compressed {
+    my $self = shift;
+    my $is_compressed = shift;
+
+    if (defined($is_compressed)) {
+        if ($is_compressed) {
+            $self->{_mfhdh_COMPRESSED} = 1;
+            $self->update(ind2 => '0');
+        } else {
+            $self->{_mfhdh_COMPRESSED} = 0;
+            $self->update(ind2 => '1');
+        }
+    }
+
+    return $self->{_mfhdh_COMPRESSED};
+}
+
+sub is_open_ended {
+    my $self = shift;
+
+    return $self->{_mfhdh_OPEN_ENDED};
+}
+
+sub caption {
+    my $self = shift;
+
+    return $self->{_mfhdh_CAPTION};
+}
+
+#
+# notes: If called with no arguments, returns the public notes array ref.
+# If called with a single argument, it returns either 'public' or
+# 'private' notes based on the passed string.
+#
+# If called with more than one argument, it sets the proper note field, with
+# type being the first argument and the note value(s) as the remaining
+# argument(s).
+#
+# It is also optional to pass in an array ref of note values as the third
+# argument rather than a list.
+#
+sub notes {
+    my $self  = shift;
+    my $type  = shift;
+    my @notes = @_;
+
+    if (!$type) {
+        $type = 'public';
+    } elsif ($type ne 'public' && $type ne 'private') {
+        carp("Notes being applied without specifying type");
+        unshift(@notes, $type);
+        $type = 'public';
+    }
+
+    if (ref($notes[0])) {
+        $self->{_mfhdh_NOTES}{$type} = $notes[0];
+        $self->_replace_note_subfields($type, @{$notes[0]});
+    } elsif (@notes) {
+        if ($notes[0]) {
+            $self->{_mfhdh_NOTES}{$type} = \@notes;
+        } else {
+            $self->{_mfhdh_NOTES}{$type} = [];
+        }
+        $self->_replace_note_subfields($type, @notes);
+    }
+
+    return $self->{_mfhdh_NOTES}{$type};
+}
+
+#
+# utility function for 'notes' method
+#
+sub _replace_note_subfields {
+    my $self              = shift;
+    my $type              = shift;
+    my @notes             = @_;
+    my %note_subfield_ids = ('public' => 'z', 'private' => 'x');
+
+    $self->delete_subfield(code => $note_subfield_ids{$type});
+
+    foreach my $note (@notes) {
+        $self->add_subfields($note_subfield_ids{$type} => $note);
+    }
+}
+
+#
+# return a simple subfields list (for easier revivification from database)
+#
+sub subfields_list {
+    my $self = shift;
+    my @subfields;
+
+    foreach my $subfield ($self->subfields) {
+        push(@subfields, $subfield->[0], $subfield->[1]);
+    }
+    return @subfields;
+}
+
+#
+# Called by method 'format_part' for formatting the chronology portion of
+# the holding statement
+#
+sub format_chron {
+    my $self     = shift;
+    my $holdings = shift;
+    my $caption  = $self->caption;
+    my @keys     = @_;
+    my $str      = '';
+    my %month    = (
+        '01' => 'Jan.',
+        '02' => 'Feb.',
+        '03' => 'Mar.',
+        '04' => 'Apr.',
+        '05' => 'May ',
+        '06' => 'Jun.',
+        '07' => 'Jul.',
+        '08' => 'Aug.',
+        '09' => 'Sep.',
+        '10' => 'Oct.',
+        '11' => 'Nov.',
+        '12' => 'Dec.',
+        '21' => 'Spring',
+        '22' => 'Summer',
+        '23' => 'Autumn',
+        '24' => 'Winter'
+    );
+
+    foreach my $i (0..@keys) {
+        my $key = $keys[$i];
+        my $capstr;
+        my $chron;
+        my $sep;
+
+        last if !defined $caption->capstr($key);
+
+        $capstr = $caption->capstr($key);
+        if (substr($capstr, 0, 1) eq '(') {
+            # a caption enclosed in parentheses is not displayed
+            $capstr = '';
+        }
+
+        # If this is the second level of chronology, then it's
+        # likely to be a month or season, so we should use the
+        # string name rather than the number given.
+        if (($i == 1)) {
+            # account for possible combined issue chronology
+            my @chron_parts = split('/', $holdings->{$key});
+            for (my $i = 0; $i < @chron_parts; $i++) {
+                $chron_parts[$i] = $month{$chron_parts[$i]} if exists $month{$chron_parts[$i]};
+            }
+            $chron = join('/', @chron_parts);
+        } else {
+            $chron = $holdings->{$key};
+        }
+
+        $str .= (($i == 0 || $str =~ /[. ]$/) ? '' : ':') . $capstr . $chron;
+    }
+
+    return $str;
+}
+
+#
+# Called by method 'format' for each member of a possibly compressed holding
+#
+sub format_part {
+    my $self           = shift;
+    my $holding_values = shift;
+    my $caption        = $self->caption;
+    my $str            = '';
+
+    if ($caption->type_of_unit) {
+        $str = $caption->type_of_unit . ' ';
+    }
+
+    if ($caption->enumeration_is_chronology) {
+        # if issues are identified by chronology only, then the
+        # chronology data is stored in the enumeration subfields,
+        # so format those fields as if they were chronological.
+        $str = $self->format_chron($holding_values, 'a'..'f');
+    } else {
+        # OK, there is enumeration data and maybe chronology
+        # data as well, format both parts appropriately
+
+        # Enumerations
+        foreach my $key ('a'..'f') {
+            my $capstr;
+            my $chron;
+            my $sep;
+
+            last if !defined $caption->capstr($key);
+
+            $capstr = $caption->capstr($key);
+            if (substr($capstr, 0, 1) eq '(') {
+                # a caption enclosed in parentheses is not displayed
+                $capstr = '';
+            }
+            $str .=
+              ($key eq 'a' ? '' : ':') . $capstr . $holding_values->{$key};
+        }
+
+        # Chronology
+        if (defined $caption->capstr('i')) {
+            $str .= '(';
+            $str .= $self->format_chron($holding_values, 'i'..'l');
+            $str .= ')';
+        }
+
+        if ($caption->capstr('g')) {
+            # There's at least one level of alternative enumeration
+            $str .= '=';
+            foreach my $key ('g', 'h') {
+                $str .=
+                    ($key eq 'g' ? '' : ':')
+                  . $caption->capstr($key)
+                  . $holding_values->{$key};
+            }
+
+            # This assumes that alternative chronology is only ever
+            # provided if there is an alternative enumeration.
+            if ($caption->capstr('m')) {
+                # Alternative Chronology
+                $str .= '(';
+                $str .= $caption->capstr('m') . $holding_values->{'m'};
+                $str .= ')';
+            }
+        }
+    }
+
+    # Breaks in the sequence
+    if (defined($self->{_mfhdh_BREAK})) {
+        if ($self->{_mfhdh_BREAK} eq 'n') {
+            $str .= ' non-gap break';
+        } elsif ($self->{_mfhdh_BREAK} eq 'g') {
+            $str .= ' gap';
+        } else {
+            warn "unrecognized break indicator '$self->{_mfhdh_BREAK}'";
+        }
+    }
+
+    return $str;
+}
+
+#
+# Create and return a string which conforms to display standard Z39.71
+#
+sub format {
+    my $self      = shift;
+    my $subfields = $self->fields;
+    my %holding_start;
+    my %holding_end;
+    my $formatted;
+
+    foreach my $key (keys %$subfields) {
+        ($holding_start{$key}, $holding_end{$key}) =
+          @{$self->field_values($key)};
+    }
+
+    if ($self->is_compressed) {
+        # deal with open-ended statements
+        my $formatted_end;
+        if ($self->is_open_ended) {
+            $formatted_end = '';
+        } else {
+            $formatted_end = $self->format_part(\%holding_end);
+        }
+        $formatted =
+          $self->format_part(\%holding_start) . ' - ' . $formatted_end;
+    } else {
+        $formatted = $self->format_part(\%holding_start);
+    }
+
+    # Public Note
+    if (@{$self->notes}) {
+        $formatted .= ' -- ' . join(', ', @{$self->notes});
+    }
+
+    return $formatted;
+}
+
+# next: Given a holding statement, return a hash containing the
+# enumeration values for the next issues, whether we hold it or not
+# Just pass through to Caption::next
+#
+sub next {
+    my $self    = shift;
+    my $caption = $self->caption;
+
+    return $caption->next($self);
+}
+
+#
+# matches($pat): check to see if $self matches the enumeration hashref passed
+# in as $pat, as returned by the 'next' method. e.g.:
+# $holding2->matches($holding1->next) # true if $holding2 directly follows
+# $holding1
+#
+# Always returns false if $self is compressed
+#
+sub matches {
+    my $self = shift;
+    my $pat  = shift;
+
+    return 0 if $self->is_compressed;
+
+    foreach my $key ('a'..'f') {
+        # If a subfield exists in $self but not in $pat, or vice versa
+        # or if the field has different values, then fail
+        if (
+            defined($self->field_values($key)) != exists($pat->{$key})
+            || (exists $pat->{$key}
+                && ($self->field_values($key)->[0] ne $pat->{$key}))
+          ) {
+            return 0;
+        }
+    }
+    return 1;
+}
+
+#
+# Check that all the fields in a holdings statement are
+# included in the corresponding caption.
+#
+sub validate {
+    my $self = shift;
+
+    foreach my $key (keys %{$self->fields}) {
+        if (!$self->caption || !$self->caption->capfield($key)) {
+            return 0;
+        }
+    }
+    return 1;
+}
+
+#
+# Replace a single holding with it's next prediction
+# and return itself
+#
+sub increment {
+    my $self = shift;
+
+    if ($self->is_open_ended) {
+        carp "Holding is open-ended, cannot increment";
+        return $self;
+    } elsif ($self->is_compressed) {
+        carp "Incrementing a compressed holding is deprecated, use extend instead";
+        return $self->extend;
+    }
+
+    my $next = $self->next();
+
+    foreach my $key (keys %{$next}) {
+        $self->fields->{$key}{HOLDINGS}[0] = $next->{$key};
+    }
+
+    $self->seqno($self->seqno + 1);
+    $self->update(%{$next});    # update underlying subfields
+    return $self;
+}
+
+#
+# Extends a holding (compressing if needed) to include the next
+# prediction and returns itself
+#
+sub extend {
+    my $self = shift;
+
+    if ($self->is_open_ended) {
+        carp "Holding is open-ended, cannot extend";
+        return $self;
+    }
+
+    my $next = $self->next();
+
+    if (!$self->is_compressed) {
+        $self->is_compressed(1);  # add compressed state
+    }
+
+    foreach my $key (keys %{$next}) {
+        my @values = @{$self->field_values($key)};
+        $values[1] = $next->{$key};
+        $self->fields->{$key}{HOLDINGS} = \@values;
+        $next->{$key} = join('-', @values);
+    }
+
+    $self->update(%{$next});    # update underlying subfields
+    return $self;
+}
+
+#
+# Turns a compressed holding into the singular form of the first member
+# in the range
+#
+sub compressed_to_first {
+    my $self = shift;
+
+    if (!$self->is_compressed) {
+        carp "Holding not compressed, cannot convert to first member";
+        return $self;
+    }
+
+    my %changes;
+    foreach my $key (keys %{$self->fields}) {
+        my @values = @{$self->field_values($key)};
+        $self->fields->{$key}{HOLDINGS} = [$values[0]];
+        $changes{$key} = $values[0];
+    }
+
+    $self->update(%changes);    # update underlying subfields
+    $self->is_compressed(0);    # remove compressed state
+
+    return $self;
+}
+
+#
+# Turns a compressed holding into the singular form of the last member
+# in the range
+#
+sub compressed_to_last {
+    my $self = shift;
+
+    if (!$self->is_compressed) {
+        carp "Holding not compressed, cannot convert to last member";
+        return $self;
+    } elsif ($self->is_open_ended) {
+        carp "Holding is open-ended, cannot convert to last member";
+        return $self;
+    }
+
+    my %changes;
+    foreach my $key (keys %{$self->fields}) {
+        my @values = @{$self->field_values($key)};
+        $self->fields->{$key}{HOLDINGS} = [$values[1]];
+        $changes{$key} = $values[1];
+    }
+
+    $self->update(%changes);    # update underlying subfields
+    $self->is_compressed(0);    # remove compressed state
+
+    return $self;
+}
+
+#
+# Basic, working, unoptimized clone operation
+#
+sub clone {
+    my $self = shift;
+
+    my $clone_field = $self->SUPER::clone();
+    return new MFHD::Holding($self->seqno, $clone_field, $self->caption);
+}
+
+#
+# Turn a chronology instance into date(s) in YYYY-MM-DD format
+#
+# In list context it returns a list of start and (possibly undefined)
+# end dates
+#
+# In scalar context, it returns a YYYY-MM-DD date string of either the
+# single date or the (possibly undefined) end date of a compressed holding
+#
+sub chron_to_date {
+    my $self    = shift;
+    my $caption = $self->caption;
+
+    my @keys;
+    if ($caption->enumeration_is_chronology) {
+        @keys = ('a'..'f');
+    } else {
+        @keys = ('i'..'m');
+    }
+
+    # @chron_start and @chron_end will hold the (year, month, day) values
+    # represented by the start and optional end of the chronology instance.
+    # Default to January 1 with a year of 0 as initial values.
+    my @chron_start = (0, 1, 1);
+    my @chron_end   = (0, 1, 1);
+    my @chrons = (\@chron_start, \@chron_end);
+    foreach my $key (@keys) {
+        my $capstr = $caption->capstr($key);
+        last if !defined($capstr);
+        if ($capstr =~ /year/) {
+            ($chron_start[0], $chron_end[0]) = @{$self->field_values($key)};
+        } elsif ($capstr =~ /month/) {
+            ($chron_start[1], $chron_end[1]) = @{$self->field_values($key)};
+        } elsif ($capstr =~ /day/) {
+            ($chron_start[2], $chron_end[2]) = @{$self->field_values($key)};
+        } elsif ($capstr =~ /season/) {
+            # chrons defined as season-only will use the astronomical season
+            # dates as a basic estimate.
+            my @seasons = @{$self->field_values($key)};
+            for (my $i = 0; $i < @seasons; $i++) {
+                $seasons[$i] = &_uncombine($seasons[$i], 0);
+                if ($seasons[$i] == 21) {
+                    $chrons[$i]->[1] = 3;
+                    $chrons[$i]->[2] = 20;
+                } elsif ($seasons[$i] == 22) {
+                    $chrons[$i]->[1] = 6;
+                    $chrons[$i]->[2] = 21;
+                } elsif ($seasons[$i] == 23) {
+                    $chrons[$i]->[1] = 9;
+                    $chrons[$i]->[2] = 22;
+                } elsif ($seasons[$i] == 24) {
+                    $chrons[$i]->[1] = 12;
+                    $chrons[$i]->[2] = 21;
+                }
+            }
+        }
+    }
+
+    my @dates;
+    foreach my $chron (@chrons) {
+        my $date = undef;
+        if ($chron->[0] != 0) {
+            $date =
+                &_uncombine($chron->[0], 0) . '-'
+              . sprintf('%02d', $chron->[1]) . '-'
+              . sprintf('%02d', $chron->[2]);
+        }
+        push(@dates, $date);
+    }
+
+    if (wantarray()) {
+        return @dates;
+    } elsif ($self->is_compressed) {
+        return $dates[1];
+    } else {
+        return $dates[0];
+    }
+}
+
+#
+# utility function for uncombining instance parts
+#
+sub _uncombine {
+    my ($combo, $pos) = @_;
+
+    if (ref($combo)) {
+        carp("Function '_uncombine' is not an instance method");
+        return;
+    }
+
+    my @parts = split('/', $combo);
+    return $parts[$pos];
+}
+
+#
+# Overload string comparison operators
+#
+# We are not overloading '<=>' because '==' is used liberally in MARC::Record
+# to compare field identity (i.e. is this the same exact Field object?), not value
+#
+# Other string operators are auto-generated from 'cmp'
+#
+# Please note that this comparison is based on what the holding represents,
+# not whether it is strictly identical (e.g. the seqno and link may vary)
+#
+use overload ('cmp' => \&_compare,
+              'fallback' => 1);
+sub _compare {
+    my ($holding_1, $holding_2) = @_;
+
+    # TODO: this needs some more consideration
+    # fall back to 'built-in' comparison
+    if (!UNIVERSAL::isa($holding_2, ref $holding_1)) {
+        if (defined $holding_2) {
+            carp("Use of non-holding in holding comparison operation");
+            return ( "$holding_1" cmp "$holding_2" );
+        } else {
+            carp("Use of undefined value in holding comparison operation");
+            return 1; # similar to built-in, something is "greater than" nothing
+        }
+    }
+
+    # special cases for compressed holdings
+    my ($holding_1_first, $holding_1_last, $holding_2_first, $holding_2_last, $found_compressed);
+    # 0 for no compressed, 1 for first compressed, 2 for second compressed, 3 for both compressed
+    $found_compressed = 0; 
+    if ($holding_1->is_compressed) {
+        $holding_1_last = $holding_1->clone->compressed_to_last;
+        $found_compressed += 1;
+    } else {
+        $holding_1_first = $holding_1;
+        $holding_1_last = $holding_1;
+    }
+    if ($holding_2->is_compressed) {
+        $holding_2_first = $holding_2->clone->compressed_to_first;
+        $found_compressed += 2;
+    } else {
+        $holding_2_first = $holding_2;
+        $holding_2_last = $holding_2;
+    }
+
+    if ($found_compressed) {
+        my $cmp = ($holding_1_last cmp $holding_2_first); # 1 ends before 2 starts
+        if ($cmp == -1) {
+            return -1; # 1 is fully lt
+        } elsif ($cmp == 0) {
+            carp("Overlapping holdings in comparison, lt and gt based on start value only");
+            return -1;
+        } else { # check the opposite, 2 ends before 1 starts
+            # clone is expensive, wait until we need it (here)
+            if (!defined($holding_2_last)) {
+                $holding_2_last = $holding_2->clone->compressed_to_last;
+            }
+            if (!defined($holding_1_first)) {
+                $holding_1_first = $holding_1->clone->compressed_to_first;
+            }
+            $cmp = ($holding_2_last cmp $holding_1_first);
+            if ($cmp == -1) {
+                return 1; # 1 is fully gt
+            } elsif ($cmp == 0) {
+                carp("Overlapping holdings in comparison, lt and gt based on start value only");
+                return 1;
+            } else {
+                $cmp = ($holding_1_first cmp $holding_2_first);
+                if (!$cmp) { # they are not equal
+                    carp("Overlapping holdings in comparison, lt and gt based on start value only");
+                    return $cmp;
+                } elsif ($found_compressed == 1) {
+                    carp("Compressed holding found with start equal to non-compressed holding");
+                    return 1; # compressed (first holding) is 'greater than' non-compressed
+                } elsif ($found_compressed == 2) {
+                    carp("Compressed holding found with start equal to non-compressed holding");
+                    return -1; # compressed (second holding) is 'greater than' non-compressed
+                } else { # both holdings compressed, check for full equality
+                    $cmp = ($holding_1_last cmp $holding_2_last);
+                    if (!$cmp) { # they are not equal
+                        carp("Compressed holdings in comparison have equal starts, lt and gt based on end value only");
+                        return $cmp;
+                    } else {
+                        return 0; # both are compressed, both ends are equal
+                    }
+                }
+            }
+        }
+    }
+
+    # start doing the actual comparison
+    my $result;
+    foreach my $key ('a'..'f') {
+        if (defined($holding_1->field_values($key))) {
+            if (!defined($holding_2->field_values($key))) {
+                return 1; # more details equals 'greater' (?)
+            } else {
+                $result = $holding_1->field_values($key)->[0] <=> $holding_2->field_values($key)->[0];
+            }
+        } elsif (defined($holding_2->field_values($key))) {
+            return -1; # more details equals 'greater' (?)
+        }
+
+        return $result if $result;
+    }
+
+    # got through, return 0 for equal
+    return 0;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/Makefile b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/Makefile
new file mode 100644
index 0000000000..47f47e6507
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/Makefile
@@ -0,0 +1,2 @@
+test:
+	perl -I../../../.. mfhd.t
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/mfhd.t b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/mfhd.t
new file mode 100644
index 0000000000..35d86cdecf
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/mfhd.t
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Data::Dumper;
+use Test::More 'no_plan';
+
+use MARC::Record;
+use OpenILS::Utils::MFHD;
+
+use testlib;
+
+my $testno = 1;
+
+sub right_answer {
+    my $holding = shift;
+    my $answer  = {};
+
+    foreach my $subfield (split(/\|/, $holding->subfield('x'))) {
+        next unless $subfield;
+
+        my ($key, $val) = unpack('aa*', $subfield);
+        $answer->{$key} = $val;
+    }
+
+    return $answer;
+}
+
+
+my $rec;
+my @captions;
+
+open(my $testdata, "new($rec);
+
+    foreach my $cap (sort { $a->tag <=> $b->tag } $rec->field('85.')) {
+        my $htag;
+        my @holdings;
+
+        ($htag = $cap->tag) =~ s/^85/86/;
+        @holdings = $rec->holdings($htag, $cap->subfield('8'));
+
+        if (!ok(scalar @holdings, "holdings defined " . $cap->subfield('8'))) {
+            next;
+        }
+
+        foreach my $field (@holdings) {
+          TODO: {
+                local $TODO = "unimplemented"
+                  if ($field->subfield('z') =~ /^TODO/);
+                is_deeply($field->next, right_answer($field),
+                    $field->subfield('8') . ': ' . $field->subfield('z'));
+            }
+        }
+    }
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/mfhddata.txt b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/mfhddata.txt
new file mode 100644
index 0000000000..e3b4e1e942
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/mfhddata.txt
@@ -0,0 +1,166 @@
+245 00 $aMonthly, issue no. restarts, calendar change: Jan
+853 20 $81$av.$bno.$u12$vr$i(year)$j(month)$wm$x01
+863 41 $81.1$a1$b6$i1990$j06$x|a1|b7|i1990|j07$zMiddle of year, middle of vol.
+863 41 $81.2$a1$b11$i1990$j11$x|a1|b12|i1990|j12$zEnd of year, end of vol.
+863 41 $81.3$a1$b12$i1990$j12$x|a2|b1|i1991|j01$zWrap at end of year/vol.
+
+245 00 $aMonthly, issue no. restarts, calendar change: Mar
+853 20 $82$av.$bno.$u12$vr$i(year)$j(month)$wm$x03
+863 41 $82.1$a1$b6$i1990$j08$x|a1|b7|i1990|j09$zMiddle of year, middle of vol.
+863 41 $82.2$a1$b10$i1990$j12$x|a1|b11|i1991|j01$zEnd of year, middle of vol.
+863 41 $82.3$a1$b11$i1991$j01$x|a1|b12|i1991|j02$zMiddle of year, end of vol.
+863 41 $82.3$a1$b12$i1991$j02$x|a2|b1|i1991|j03$zWrap vol in mid-year
+
+245 00 $aMonthly, issue no. continuous, calendar change: Jan
+853 20 $83$av.$bno.$u12$vc$i(year)$j(month)$wm$x01
+863 41 $83.1$a1$b6$i1990$j06$x|a1|b7|i1990|j07$zMiddle of year, middle of vol.
+863 41 $83.2$a1$b11$i1990$j11$x|a1|b12|i1990|j12$zEnd of year, end of vol.
+863 41 $83.3$a1$b12$i1990$j12$x|a2|b13|i1991|j01$zwrap vol @ end of year
+
+245 00 $aMonthly, issue no. continuous, calendar change: Mar
+853 20 $84$av.$bno.$u12$vc$i(year)$j(month)$wm$x03
+863 41 $84.1$a1$b6$i1990$j08$x|a1|b7|i1990|j09$zMiddle of year, middle of vol.
+863 41 $84.2$a1$b10$i1990$j12$x|a1|b11|i1991|j01$zEnd of year, middle of vol.
+863 41 $84.3$a1$b11$i1991$j01$x|a1|b12|i1991|j02$zMiddle of year, end of vol.
+863 41 $84.4$a1$b12$i1991$j02$x|a2|b13|i1991|j03$zwrap vol mid-year
+
+245 00 $aMonthly, issue no. restarts, Calendar change: Jan, Jul
+853 20 $85$av.$bno.$u6$vr$i(year)$j(month)$wm$x01,07
+863 41 $85.1$a1$b5$i1990$j05$x|a1|b6|i1990|j06$zMiddle of year, near end of vol.
+863 41 $85.2$a1$b6$i1990$j06$x|a2|b1|i1990|j07$zMiddle of year, end of vol.
+863 41 $85.3$a2$b6$i1990$j12$x|a3|b1|i1991|j01$zEnd of year, end of vol.
+
+245 00 $aMonthly, issue no. continuous, Calendar change: Jan, Jul
+853 20 $86$av.$bno.$u6$vc$i(year)$j(month)$wm$x01,07
+863 41 $86.1$a1$b5$i1990$j05$x|a1|b6|i1990|j06$zMiddle of year, end of vol.
+863 41 $86.2$a1$b6$i1990$j06$x|a2|b7|i1990|j07$zMiddle of year, end of vol.
+863 41 $86.3$a2$b12$i1990$j12$x|a3|b13|i1991|j01$zEnd of year, end of vol.
+
+245 00 $aMonthly, issue no. restarts, Calendar change: Jan, Combined issue: Jan/Feb
+853 20 $87$av.$bno.$u11$vr$i(year)$j(month)$wm$x01$ycm01/02
+863 41 $87.1$a1$b11$i1990$j12$x|a2|b1|i1991|j01/02$z End of year, end of vol.
+863 41 $87.2$a2$b1$i1991$j01/02$x|a2|b2|i1991|j03$z Beginning of year, beginning of vol.
+
+245 00 $aMonthly, iss no. restarts, Calendar change: Jan, Combined iss: Nov/Dec
+853 20 $88$av.$bno.$u11$vr$i(year)$j(month)$wm$x01$ycm11/12
+863 41 $88.1$a1$b10$i1990$j10$x|a1|b11|i1990|j11/12$z end of year, end of vol.
+863 41 $88.2$a1$b11$i1990$j11/12$x|a2|b1|i1991|j01$z wrap vol at year end
+
+245 00 $aMonthly, iss no. restarts, Cal. change: Jan, Combined iss: Jan/Feb, Nov/Dec
+853 20 $89$av.$bno.$u10$vr$i(year)$j(month)$wm$x01$ycm01/02,11/12
+863 41 $89.1$a1$b1$i1990$j01/02$x|a1|b2|i1990|j03$z beg. of year, beg. of vol.
+863 41 $89.2$a1$b9$i1990$j10$x|a1|b10|i1990|j11/12$z end of year, end of vol.
+863 41 $89.3$a1$b10$i1990$j11/12$x|a2|b1|i1991|j01/02$z zwrap vol at year end
+
+245 00 $aMonthly, iss no. restarts, Cal. change: Jan, Combined iss: May/Jun, Jul/Aug
+853 20 $810$av.$bno.$u10$vr$i(year)$j(month)$wm$x01$ycm05/06,07/08
+863 41 $810.1$a1$b4$i1990$j04$x|a1|b5|i1990|j05/06$z next iss is combined.
+863 41 $810.2$a1$b5$i1990$j05/06$x|a1|b6|i1990|j07/08$z combined to combined
+863 41 $810.3$a1$b6$i1990$j07/08$x|a1|b7|i1990|j09$z combined to reg
+
+245 00 $aMonthly, issue no. restarts, Calendar change: Jan, Combined issue: 1/2 Jan/Feb 
+853 20 $811$av.$bno.$u12$vr$i(year)$j(month)$wm$x01$ycm01/02$yce21/2
+863 41 $811.1$a1$b12$i1990$j12$x|a2|b1/2|i1991|j01/02$znew vol at year end regular iss to combined
+863 41 $811.2$a2$b1/2$i1991$j01/02$x|a2|b3|i1991|j03$zcombined iss to regular
+
+245 00 $aMonthly, iss no. restarts, Calendar change: Jan, Combined iss: 11/12 Nov/Dec
+853 20 $812$av.$bno.$u12$vr$i(year)$j(month)$wm$x01$ycm11/12$yce211/12
+863 41 $812.1$a1$b10$i1990$j10$x|a1|b11/12|i1990|j11/12$zregular to combined iss
+863 41 $812.2$a1$b11/12$i1990$j11/12$x|a2|b1|i1991|j01$zend of vol: combined to regular issue
+
+245 00 $aMonthly, iss no. restarts, Cal. change: Jan, Combined iss: 1/2 Jan/Feb, 11/12 Nov/Dec
+853 20 $813$av.$bno.$u12$vr$i(year)$j(month)$wm$x01$ycm01/02,11/12$yce21/2,11/12
+863 41 $813.1$a1$b10$i1990$j10$x|a1|b11/12|i1990|j11/12$zend of vol regular to combined iss
+863 41 $813.2$a1$b11/12$i1990$j11/12$x|a2|b1/2|i1991|j01/02$zwrap at volume end: combined to combined
+863 41 $813.3$a2$b1/2$i1991$j01/02$x|a2|b3|i1991|j03$zbeginning of vol: combined to regular
+
+245 00 $aMonthly, iss no. restarts, Cal. change: Jan, Combined iss: 5/6 May/Jun, 7/8 Jul/Aug 
+853 20 $814$av.$bno.$u12$vr$i(year)$j(month)$wm$x01$ycm05/06,07/08$yce25/6,7/8
+863 41 $814.1$a1$b4$i1990$j04$x|a1|b5/6|i1990|j05/06$zmid year: reg to combined
+863 41 $814.2$a1$b5/6$i1990$j05/06$x|a1|b7/8|i1990|j07/08$zmid year: combined to combined
+863 41 $814.3$a1$b7/8$i1990$j07/08$x|a1|b9|i1990|j09$zmid year: combined to regular
+
+245 00 $aMonthly, iss no. restarts, Cal change: Jan, July issue omitted
+853 20 $815$av.$bno.$u11$vr$i(year)$j(month)$wm$x01$yom07
+863 41 $815.1$a1$b6$i1990$j06$x|a1|b7|i1990|j08$zskip july issue
+
+245 00 $aQuarterly, chronology in enumeration fields
+853 20 $816$a(year)$b(season)$wq$yps21,22,23,24
+863 41 $816.1$a2007$b21$x|a2007|b22$zChron in enum: simple case: quarterly in mid-volume
+863 41 $816.2$a2007$b24$x|a2008|b21$zChron in enum: Roll over to new year
+
+245 00 $aFour issues a year, chronology in enum fields, combined Sum/Fall issue
+853 20 $817$a(year)$b(season)$wq$ycs22/23
+863 41 $817.1$a2007$b21$x|a2007|b22/23$zChron in enum: Spring to Summer/Fall
+863 41 $817.2$a2007$b22/23$x|a2007|b24$zChron in enum: Summer/Fall to Winter
+
+245 00 $aLibrary Journal: 20 times a year, semimonthly except Jan, Jul, Aug, Dec
+853 20 $818$av.$bno.$u20$vr$i(year)$j(month)$k(day)$ws$x01$ypd01,15$yod0115,0715,0815,1215
+863 41 $818.1$a132$b20$i2007$j12$k1$x|a133|b1|i2008|j01|k01$zSkipping over missed date to beginning of next year/volume.
+863 41 $818.2$a133$b1$i2008$j01$k01$x|a133|b2|i2008|j02|k01$zSkipping over missed date at beginning of year
+863 41 $818.3$a133$b2$i2008$j02$k01$x|a133|b3|i2008|j02|k15$zPublished semimonthly, going from 1st to 15th
+863 41 $818.4$a133$b3$i2008$j02$k15$x|a133|b4|i2008|j03|k01$zPublished semimonthly, going from 15th to 1st
+
+245 00 $aBimonthly: Feb, Apr, June, Aug, Oct, Dec
+853 20 $819$av.$bno.$u6$vr$i(year)$j(month)$wb$x02$ypm02,04,06,08,10,12
+863 41 $819.1$a1$b3$i1990$j06$x|a1|b4|i1990|j08$zMiddle of year, middle of vol.
+863 41 $819.2$a1$b5$i1990$j10$x|a1|b6|i1990|j12$zEnd of year, end of vol.
+863 41 $819.3$a1$b6$i1990$j12$x|a2|b1|i1991|j02$zWrap at end of year/vol.
+
+245 00 $aBimonthly, published 5 times with combined summer issue: Feb, Apr, June/Aug, Oct, Dec
+853 20 $820$av.$bno.$u5$vr$i(year)$j(month)$wb$x02$ypm02,04,10,12$ycm06/08
+863 41 $820.1$a1$b2$i1990$j04$x|a1|b3|i1990|j06/08$zFrom Apr to Jun/Aug
+863 41 $820.2$a1$b3$i1990$j06/08$x|a1|b4|i1990|j10$zFrom Jun/Aug to Oct
+863 41 $820.3$a1$b5$i1990$j12$x|a2|b1|i1991|j02$zWrap at end of year/vol.
+
+245 00 $aEconomist: pub. w on Sa, except combined iss on last two weeks of year
+853 20 $821$av.$bno.$u12$vc$i(year)$j(month)$k(day)$ww$x01,04,07,10$ypdsa$yow1299
+863 41 $821.1$a100$b1200$i2008$j12$k06$x|a100|b1201|i2008|j12|k13$zwithin vol.
+863 41 $821.2$a100$b1201$i2008$j12$k13$x|a100|b1202|i2008|j12|k20$zwithin vol. combined iss.
+863 41 $821.3$a100$b1202$i2008$j12$k20$x|a101|b1203|i2009|j01|k03$zvolume change over omitted iss.
+
+245 00 $aMFHD example: monthly, pub. 2nd Wed of month except in April: 2nd Thu; May:1st Wednesday.
+853 20 $822$av.$bno.$u12$vr$i(year)$j(month)$k(day)$wm$x01$ypw02we$ypw0402th,0501we$yow0402we,0502we
+863 41 $822.1$a1$b2$i2009$j02$k11$x|a1|b3|i2009|j03|k11$zpublished on 2nd Wed in Mar
+863 41 $822.2$a1$b3$i2009$j03$k11$x|a1|b4|i2009|j04|k09$zpublished on 2nd Thu in Apr
+863 41 $822.3$a1$b4$i2009$j04$k09$x|a1|b5|i2009|j05|k06$zpublished on 1st Wed in May
+863 41 $822.4$a2$b4$i2013$j04$k11$x|a2|b5|i2013|j05|k01$zpublished on Wed May 1st
+
+245 00 $aMFHD example: pub. every Mon, Thu, except on New Years, July 4, Labor Day, Thanksgiving, Christmas
+853 20 $823$av.$bno.$uvar$vr$i(year)$j(month)$k(day)$wc$x07$ypw00mo,00th$yod0101,0704,1225$yow0901mo,1104th
+863 41 $823.1$a1$b100$i2009$j02$k02$x|a1|b101|i2009|j02|k05$znormal: Mon to Thu
+863 41 $823.2$a1$b101$i2009$j02$k05$x|a1|b102|i2009|j02|k09$znormal: Thu to Mon
+863 41 $823.3$a1$b150$i2009$j06$k29$x|a2|b151|i2009|j07|k02$znormal: calendar change
+863 41 $823.4$a2$b180$i2009$j09$k03$x|a2|b181|i2009|j09|k10$zSkip Labor Day
+863 41 $823.5$a2$b200$i2009$j11$k23$x|a2|b201|i2009|j11|k30$zSkip (US) Thanksgiving
+
+#
+# According to the specification and the examples at
+# http://www.loc.gov/marc/chrono_patterns.html it is possible to
+# document a combined issue in a $yp publication regularity definition,
+# like this: $yps21,22/23,24
+245 00 $aCombined date documented in publication pattern rather than combined pattern
+853 20 $824$av.$bno.$u3$vr$i(year)$j(season)$wq$x21$yps21,22/23,24
+863 41 $824.1$a1$b1$i2009$j21$x|a1|b2|i2009|j22/23$zSpring to Summer/Fall
+863 41 $824.2$a1$b2$i2009$j22/23$x|a1|b3|i2009|j24$zSummer/Fall to Winter
+
+# Item is published 6 times/year whose enumeration "skips" numbers
+# at the second level using only odd numbers that restart
+# at the turn of the calendar year.
+# (From www.loc.gov/marc/chrono_patterns.html)
+245 00 $aFunky enumeration
+853 20 $825$av.$bno.$u6$vr$i(year)$j(month)$wb$ype21,3,5,7,9,11
+863 41 $825.1$a1$b1$i1990$j01$x|a1|b3|i1990|j03$zJan to Mar
+863 41 $825.2$a1$b11$i1990$j11$x|a2|b1|i1991|j01$zNov to Jan, year & vol wrap
+
+
+# Monthly, one volume per year, issue numbering restarts in January
+# Annual supplement published in September, annual index published in
+# February
+245 00 $aSupplements and Indexes: Oh My
+853 20 $826$av.$bno.$u12$vr$i(year)$j(month)$wm
+854 20 $827$av.$i(year)$j(month)$wa$ypm09$oSupplement
+855 20 $828$av.$i(year)$j(month)$ypm02$oIndex
+863 41 $826.1$a1$b1$i1990$j01$x|a1|b2|i1990|j02$znormal issue
+864 41 $827.1$a1$i1990$j09$x|a2|i1991|j09$zAnnual supplement
+865 41 $828.1$a1$i1990$j02$x|a2|i1991|j02$zAnnual Index
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/testlib.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/testlib.pm
new file mode 100644
index 0000000000..9953a569d1
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/testlib.pm
@@ -0,0 +1,69 @@
+package testlib;
+
+use strict;
+use warnings;
+
+use base 'Exporter';
+
+our @EXPORT_OK = qw(load_MARC_rec);
+
+use Data::Dumper;
+
+use MARC::Record;
+
+sub load_MARC_rec {
+    my $fh = shift;
+    my $testno = shift;
+    my $rec;
+    my $line;
+    my $marc = undef;
+
+    # skim to beginning of record (a non-blank, non comment line)
+    while ($line = <$fh>) {
+        chomp $line;
+        last if (!($line =~ /^\s*$/) && !($line =~ /^#/));
+    }
+
+    return undef if !$line;
+
+    $marc = MARC::Record->new();
+    carp('No record created!') unless $marc;
+
+    $marc->leader('01119nas  22003134a 4500');
+    $marc->append_fields(
+        MARC::Field->new('008', '970701c18439999enkwr p       0   a0eng  '));
+    $marc->append_fields(
+        MARC::Field->new('035', '', '', a => sprintf('%04d', $testno)));
+
+    while ($line) {
+        next if $line =~ /^#/;    # allow embedded comments
+
+        return $marc if $line =~ /^\s*$/;
+
+        my ($fieldno, $indicators, $rest) = split(/ /, $line, 3);
+        my @inds = unpack('aa', $indicators);
+        my $field;
+        my @subfields;
+
+        @subfields = ();
+        foreach my $subfield (split(/\$/, $rest)) {
+            next unless $subfield;
+
+            my ($key, $val) = unpack('aa*', $subfield);
+            push @subfields, $key, $val;
+        }
+
+        $field = MARC::Field->new(
+            $fieldno, $inds[0], $inds[1],
+            @subfields
+        );
+
+        $marc->append_fields($field);
+
+        $line = <$fh>;
+        chomp $line if $line;
+    }
+    return $marc;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHDParser.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHDParser.pm
new file mode 100644
index 0000000000..7a191dd3e0
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHDParser.pm
@@ -0,0 +1,306 @@
+package OpenILS::Utils::MFHDParser;
+use strict;
+use warnings;
+
+use OpenSRF::EX qw/:try/;
+use Time::HiRes qw(time);
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Logger qw/$logger/;
+
+use OpenILS::Utils::MFHD;
+use MARC::File::XML (BinaryEncoding => 'utf8');
+use Data::Dumper;
+
+sub new { return bless({}, shift()); }
+
+=head1 Subroutines
+
+=over
+
+=item * format_textual_holdings($field)
+
+=back
+
+Returns concatenated subfields $a with $z for textual holdings (866-868)
+
+=cut
+
+sub format_textual_holdings {
+    my ($self, $field) = @_;
+    my $holdings;
+    my $public_note;
+
+    $holdings = $field->subfield('a');
+    if (!$holdings) {
+        return undef;
+    }
+
+    $public_note = $field->subfield('z');
+    if ($public_note) {
+        return "$holdings -- $public_note";
+    }
+    return $holdings;
+}
+
+=over
+
+=item * mfhd_to_hash($mfhd_xml)
+
+=back
+
+Returns a Perl hash containing fields of interest from the MFHD record
+
+=cut
+
+sub mfhd_to_hash {
+    my ($self, $mfhd_xml) = @_;
+
+    my $marc;
+    my $mfhd;
+
+    my $location                = '';
+    my $basic_holdings          = [];
+    my $supplement_holdings     = [];
+    my $index_holdings          = [];
+    my $basic_holdings_add      = [];
+    my $supplement_holdings_add = [];
+    my $index_holdings_add      = [];
+    my $online                  = [];    # Laurentian extension to MFHD standard
+    my $missing                 = [];    # Laurentian extension to MFHD standard
+    my $incomplete              = [];    # Laurentian extension to MFHD standard
+
+    try {
+        $marc = MARC::Record->new_from_xml($mfhd_xml);
+    }
+    otherwise {
+        $logger->error("Failed to convert MFHD XML to MARC: " . shift());
+        $logger->error("Failed MFHD XML: $mfhd_xml");
+    };
+
+    if (!$marc) {
+        return undef;
+    }
+
+    try {
+        $mfhd = MFHD->new($marc);
+    }
+    otherwise {
+        $logger->error("Failed to parse MFHD: " . shift());
+        $logger->error("Failed MFHD XML: $mfhd_xml");
+    };
+
+    if (!$mfhd) {
+        return undef;
+    }
+
+    try {
+        foreach my $field ($marc->field('852')) {
+            foreach my $subfield_ref ($field->subfields) {
+                my ($subfield, $data) = @$subfield_ref;
+                $location .= $data . " -- ";
+            }
+        }
+    }
+    otherwise {
+        $logger->error("MFHD location parsing error: " . shift());
+    };
+
+    $location =~ s/ -- $//;
+
+    # TODO: for now, we will assume that textual holdings are in addition to the 
+    # computable holdings (that is, they have link IDs greater than the 85X fields)
+    # or that they fully replace the computable holdings (checking for link ID '0').
+    # Eventually this may be handled better by format_holdings() in MFHD.pm
+    my %skip_computable;
+    try {
+        foreach my $field ($marc->field('866')) {
+            my $textual_holdings = $self->format_textual_holdings($field);
+            if ($textual_holdings) {
+                push @$basic_holdings_add, $textual_holdings;
+                if ($field->subfield('8') eq '0') {
+                   $skip_computable{'basic'} = 1; # link ID 0 trumps computable fields
+                }
+            }
+        }
+        foreach my $field ($marc->field('867')) {
+            my $textual_holdings = $self->format_textual_holdings($field);
+            if ($textual_holdings) {
+                push @$supplement_holdings_add, $textual_holdings;
+                if ($field->subfield('8') eq '0') {
+                   $skip_computable{'supplement'} = 1; # link ID 0 trumps computable fields
+                }
+            }
+        }
+        foreach my $field ($marc->field('868')) {
+            my $textual_holdings = $self->format_textual_holdings($field);
+            if ($textual_holdings) {
+                push @$index_holdings_add, $textual_holdings;
+                if ($field->subfield('8') eq '0') {
+                   $skip_computable{'index'} = 1; # link ID 0 trumps computable fields
+                }
+            }
+        }
+
+        if (!exists($skip_computable{'basic'})) {
+            foreach my $cap_id ($mfhd->caption_link_ids('853')) {
+                my @holdings = $mfhd->holdings('863', $cap_id);
+                next unless scalar @holdings;
+                foreach (@holdings) {
+                    push @$basic_holdings, $_->format();
+                }
+            }
+            if (!@$basic_holdings) { # no computed holdings found
+                $basic_holdings = $basic_holdings_add;
+                $basic_holdings_add = [];
+            }
+        } else { # textual are non additional, but primary
+            $basic_holdings = $basic_holdings_add;
+            $basic_holdings_add = [];
+        }
+
+        if (!exists($skip_computable{'supplement'})) {
+            foreach my $cap_id ($mfhd->caption_link_ids('854')) {
+                my @supplements = $mfhd->holdings('864', $cap_id);
+                next unless scalar @supplements;
+                foreach (@supplements) {
+                    push @$supplement_holdings, $_->format();
+                }
+            }
+            if (!@$supplement_holdings) { # no computed holdings found
+                $supplement_holdings = $supplement_holdings_add;
+                $supplement_holdings_add = [];
+            }
+        } else { # textual are non additional, but primary
+            $supplement_holdings = $supplement_holdings_add;
+            $supplement_holdings_add = [];
+        }
+
+        if (!exists($skip_computable{'index'})) {
+            foreach my $cap_id ($mfhd->caption_link_ids('855')) {
+                my @indexes = $mfhd->holdings('865', $cap_id);
+                next unless scalar @indexes;
+                foreach (@indexes) {
+                    push @$index_holdings, $_->format();
+                }
+            }
+            if (!@$index_holdings) { # no computed holdings found
+                $index_holdings = $index_holdings_add;
+                $index_holdings_add = [];
+            }
+        } else { # textual are non additional, but primary
+            $index_holdings = $index_holdings_add;
+            $index_holdings_add = [];
+        }
+
+        # Laurentian extensions
+        foreach my $field ($marc->field('530')) {
+            my $online_stmt = $self->format_textual_holdings($field);
+            if ($online_stmt) {
+                push @$online, $online_stmt;
+            }
+        }
+
+        foreach my $field ($marc->field('590')) {
+            my $missing_stmt = $self->format_textual_holdings($field);
+            if ($missing_stmt) {
+                push @$missing, $missing_stmt;
+            }
+        }
+
+        foreach my $field ($marc->field('591')) {
+            my $incomplete_stmt = $self->format_textual_holdings($field);
+            if ($incomplete_stmt) {
+                push @$incomplete, $incomplete_stmt;
+            }
+        }
+    }
+    otherwise {
+        $logger->error("MFHD statement parsing error: " . shift());
+    };
+
+    return {
+        location                => $location,
+        basic_holdings          => $basic_holdings,
+        basic_holdings_add      => $basic_holdings_add,
+        supplement_holdings     => $supplement_holdings,
+        supplement_holdings_add => $supplement_holdings_add,
+        index_holdings          => $index_holdings,
+        index_holdings_add      => $index_holdings_add,
+        missing                 => $missing,
+        incomplete              => $incomplete,
+        online                  => $online
+    };
+}
+
+=over
+
+=item * init_holdings_virtual_record()
+
+=back
+
+Initialize the serial virtual record (svr) instance
+
+=cut
+
+sub init_holdings_virtual_record {
+    my $record = Fieldmapper::serial::virtual_record->new;
+    $record->sre_id();
+    $record->location();
+    $record->owning_lib();
+    $record->basic_holdings([]);
+    $record->basic_holdings_add([]);
+    $record->supplement_holdings([]);
+    $record->supplement_holdings_add([]);
+    $record->index_holdings([]);
+    $record->index_holdings_add([]);
+    $record->online([]);
+    $record->missing([]);
+    $record->incomplete([]);
+    return $record;
+}
+
+=over
+
+=item * init_holdings_virtual_record($mfhd)
+
+=back
+
+Given an MFHD record, return a populated svr instance
+
+=cut
+
+sub generate_svr {
+    my ($self, $id, $mfhd, $owning_lib) = @_;
+
+    if (!$mfhd) {
+        return undef;
+    }
+
+    my $record   = init_holdings_virtual_record();
+    my $holdings = $self->mfhd_to_hash($mfhd);
+
+    $record->sre_id($id);
+    $record->owning_lib($owning_lib);
+
+    if (!$holdings) {
+        return $record;
+    }
+
+    $record->location($holdings->{location});
+    $record->basic_holdings($holdings->{basic_holdings});
+    $record->basic_holdings_add($holdings->{basic_holdings_add});
+    $record->supplement_holdings($holdings->{supplement_holdings});
+    $record->supplement_holdings_add($holdings->{supplement_holdings_add});
+    $record->index_holdings($holdings->{index_holdings});
+    $record->index_holdings_add($holdings->{index_holdings_add});
+    $record->online($holdings->{online});
+    $record->missing($holdings->{missing});
+    $record->incomplete($holdings->{incomplete});
+
+    return $record;
+}
+
+1;
+
+# vim: ts=4:sw=4:noet
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/ModsParser.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/ModsParser.pm
new file mode 100644
index 0000000000..d77d07d579
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/ModsParser.pm
@@ -0,0 +1,478 @@
+package OpenILS::Utils::ModsParser;
+use strict; use warnings;
+
+use OpenSRF::EX qw/:try/;
+use XML::LibXML;
+use XML::LibXSLT;
+use Time::HiRes qw(time);
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Logger qw/$logger/;
+use Data::Dumper;
+
+my $parser		= XML::LibXML->new();
+my $xslt			= XML::LibXSLT->new();
+my $mods_sheet;
+
+# ----------------------------------------------------------------------------------------
+# XPATH for extracting info from a MODS doc
+my $isbn_xpath			= "//mods:mods/mods:identifier[\@type='isbn']";
+my $resource_xpath	= "//mods:mods/mods:typeOfResource";
+my $pub_xpath			= "//mods:mods/mods:originInfo//mods:dateIssued[\@encoding='marc']|" . 
+								"//mods:mods/mods:originInfo//mods:dateIssued[1]";
+my $tcn_xpath			= "//mods:mods/mods:recordInfo/mods:recordIdentifier";
+my $publisher_xpath	= "//mods:mods/mods:originInfo//mods:publisher[1]";
+my $edition_xpath		= "//mods:mods/mods:originInfo//mods:edition[1]";
+my $abstract_xpath	= "//mods:mods/mods:abstract";
+my $related_xpath		= "";
+my $online_loc_xpath = "//mods:location/mods:url";
+my $physical_desc		= "(//mods:mods/mods:physicalDescription/mods:form|//mods:mods/mods:physicalDescription/mods:extent|".
+	"//mods:mods/mods:physicalDescription/mods:reformattingQuality|//mods:mods/mods:physicalDescription/mods:internetMediaType|".
+	"//mods:mods/mods:physicalDescription/mods:digitalOrigin)";
+my $toc_xpath			= "//mods:tableOfContents";
+
+my $xpathset = {
+
+	title => {
+		abbreviated => 
+			"//mods:mods/mods:titleInfo[mods:title and (\@type='abbreviated')]",
+		translated =>
+			"//mods:mods/mods:titleInfo[mods:title and (\@type='translated')]",
+		uniform =>
+			"//mods:mods/mods:titleInfo[mods:title and (\@type='uniform')]",
+		proper =>
+			"//mods:mods/mods:titleInfo[mods:title and not (\@type)]",
+		any =>
+			"//mods:mods/mods:titleInfo",
+	},
+
+	author => {
+		corporate => 
+			"//mods:mods/mods:name[\@type='corporate']/*[local-name()='namePart']".
+				"[../mods:role/mods:text[text()='creator']".
+				" or ../mods:role/mods:roleTerm[".
+				"        \@type='text'".
+				"        and \@authority='marcrelator'".
+				"        and text()='creator']".
+				"][1]",
+		personal => 
+			"//mods:mods/mods:name[\@type='personal']/*[local-name()='namePart']".
+				"[../mods:role/mods:text[text()='creator']".
+				" or ../mods:role/mods:roleTerm[".
+				"        \@type='text'".
+				"        and \@authority='marcrelator'".
+				"        and text()='creator']".
+				"][1]",
+		conference => 
+			"//mods:mods/mods:name[\@type='conference']/*[local-name()='namePart']".
+				"[../mods:role/mods:text[text()='creator']".
+				" or ../mods:role/mods:roleTerm[".
+				"        \@type='text'".
+				"        and \@authority='marcrelator'".
+				"        and text()='creator']".
+				"][1]",
+		other => 
+			"//mods:mods/mods:name[\@type='personal']/*[local-name()='namePart']",
+		any => 
+			"//mods:mods/mods:name/*[local-name()='namePart'][1]",
+	},
+
+	subject => {
+
+		topic => 
+			"//mods:mods/mods:subject/*[".
+			"   local-name()='geographic'".
+			"   or local-name()='name'".
+			"   or local-name()='temporal'".
+			"   or local-name()='topic'".
+			"]/parent::mods:subject",
+
+#		geographic => 
+#			"//mods:mods/*[local-name()='subject']/*[local-name()='geographic']",
+#		name => 
+#			"//mods:mods/*[local-name()='subject']/*[local-name()='name']",
+#		temporal => 
+#			"//mods:mods/*[local-name()='subject']/*[local-name()='temporal']",
+#		topic => 
+#			"//mods:mods/*[local-name()='subject']/*[local-name()='topic']",
+	},
+	#keyword => { keyword => "//mods:mods/*[not(local-name()='originInfo')]", },
+
+	series => {
+		series => "//mods:mods/mods:relatedItem[\@type='series']/mods:titleInfo"
+	}
+};
+# ----------------------------------------------------------------------------------------
+
+
+
+sub new { return bless( {}, shift() ); }
+
+sub get_field_value {
+
+	my( $self, $mods, $xpath, $type) = @_;
+
+	my @string;
+
+	my $root = $mods->documentElement;
+	$root->setNamespace( "http://www.loc.gov/mods/v3", "mods", 1 );
+
+	try {
+		# grab the set of matching nodes
+		my @nodes = $root->findnodes( $xpath );
+		for my $value (@nodes) {
+
+			# grab all children of the node
+			my @children = $value->childNodes();
+			my @child_text;
+			for my $child (@children) {
+				# MODS strips the punctuation from 245abc, which often
+				# results in "title subtitle" rather than "title : subtitle";
+				# this hack gets it back for us
+				if ($type && $type eq 'title' && $child->nodeName =~ m/subTitle/) {
+					push(@child_text, " : "); 
+				}
+				next unless( $child->nodeType != 3 );
+
+				if($child->childNodes) {
+					my @a;
+					for my $c (@{$child->childNodes}){
+						push @a, $c->textContent;
+					}
+					push(@child_text, join(' ', @a));
+
+				} else {
+					push(@child_text, $child->textContent); 
+				}
+
+			}
+			if(@child_text) {
+				push(@string, \@child_text);
+			}
+
+			if( !@child_text  ) {
+				push(@string, $value->textContent );
+			}
+		}
+	} otherwise {
+		$logger->info("MODS-izing failure: ".shift());
+		$logger->info("Failed MODS xml: ".$root->toString);
+		$logger->info("Failed MODS xpath: $xpath");
+	};
+	return @string;
+}
+
+=head
+sub _modsdoc_to_values {
+	my( $self, $mods ) = @_;
+	my $data = {};
+	for my $class (keys %$xpathset) {
+		$data->{$class} = {};
+		for my $type(keys %{$xpathset->{$class}}) {
+			my @value = $self->get_field_value( $mods, $xpathset->{$class}->{$type} );
+			if( $class eq "subject" ) {
+				push( @{$data->{$class}->{$type}},  @value );
+			} else {
+				$data->{$class}->{$type} = $value[0];
+			}
+		}
+	}
+	return $data;
+}
+=cut
+
+sub modsdoc_to_values {
+	my( $self, $mods ) = @_;
+	my $data = {};
+
+	{
+		my $class = "subject";
+		$data->{$class} = {};
+		for my $type(keys %{$xpathset->{$class}}) {
+			my @value = $self->get_field_value( $mods, $xpathset->{$class}->{$type} );
+			for my $arr (@value) {
+				push( @{$data->{$class}->{$type}},  $arr);
+			}
+		}
+	}
+
+	{
+		my $class = "title";
+		$data->{$class} = {};
+		for my $type(keys %{$xpathset->{$class}}) {
+			my @value = $self->get_field_value( $mods, $xpathset->{$class}->{$type}, "title" );
+			for my $arr (@value) {
+				if( ref($arr) ) {
+					$data->{$class}->{$type} = shift @$arr;
+
+					my $t = lc($data->{$class}->{$type});
+					if($t and $t =~ /^l[eoa]s|l[ae]|el|the|un[ae]?|an?\s?$/o ) {
+						my $val = shift @$arr || "";
+						$data->{$class}->{$type} .= " $val" if $data->{$class}->{$type};
+						$data->{$class}->{$type} = " $val" unless $data->{$class}->{$type};
+					}
+
+					for my $t (@$arr) {
+						$data->{$class}->{$type} .= " $t";
+					}
+				} else {
+					$data->{$class}->{$type} = $arr;
+				}
+			}
+			$data->{$class}->{$type} =~ s/\s+/ /go if ($data->{$class}->{$type});
+		}
+	}
+
+	{
+		my $class = "author";
+		$data->{$class} = {};
+		for my $type(keys %{$xpathset->{$class}}) {
+			my @value = $self->get_field_value( $mods, $xpathset->{$class}->{$type} );
+			$data->{$class}->{$type} = $value[0];
+		}
+	}
+
+	{
+		my $class = "series";
+		$data->{$class} = {};
+		for my $type(keys %{$xpathset->{$class}}) {
+			my @value = $self->get_field_value( $mods, $xpathset->{$class}->{$type} );
+			for my $arr (@value) {
+				if( ref($arr) ) {
+					push(@{$data->{$class}->{$type}}, join(" ", @$arr));
+				} else {
+					push( @{$data->{$class}->{$type}}, $arr );
+				}
+			}
+		}
+
+	}
+
+	return $data;
+}
+
+
+
+
+# ---------------------------------------------------------------------------
+# Grabs the data 'we want' from the MODS doc and returns it in hash form
+# ---------------------------------------------------------------------------
+sub mods_values_to_mods_slim {
+	my( $self, $modsperl ) = @_;
+
+	my $title = "";
+	my $author = "";
+	my $subject = [];
+	my $series	= [];
+
+	my $tmp = $modsperl->{title};
+
+
+	if(!$tmp) { $title = ""; }
+	else {
+		($title = $tmp->{proper}) ||
+		($title = $tmp->{translated}) ||
+		($title = $tmp->{abbreviated}) ||
+		($title = $tmp->{uniform}) ||
+		($title = $tmp->{any});
+	}
+
+	$tmp = $modsperl->{author};
+	if(!$tmp) { $author = ""; }
+	else {
+		($author = $tmp->{personal}) ||
+		($author = $tmp->{corporate}) ||
+		($author = $tmp->{conference}) ||
+		($author = $tmp->{other}) ||
+		($author = $tmp->{any}); 
+	}
+
+	$tmp = $modsperl->{subject};
+	if(!$tmp) { $subject = {}; } 
+	else {
+		for my $key( keys %{$tmp}) {
+			push(@$subject, @{$tmp->{$key}}) if ($tmp->{$key});
+		}
+		my $subh = {};
+		for my $s (@$subject) {
+			if(defined($subh->{$s})) { $subh->{$s->[0]}++ } else { $subh->{$s->[0]} = 1;}
+		}
+		$subject = $subh
+	}
+
+	$tmp = $modsperl->{'series'};
+	if(!$tmp) { $series = []; }
+	else { $series = $tmp->{'series'}; }
+
+
+	return { series => $series, title => $title, 
+			author => $author, subject => $subject };
+}
+
+
+
+# ---------------------------------------------------------------------------
+# Initializes a MARC -> Unified MODS batch process
+# ---------------------------------------------------------------------------
+
+sub start_mods_batch {
+
+	my( $self, $master_doc ) = @_;
+
+	if(!$master_doc) {
+		$self->{master_doc} = undef;
+		return;
+	}
+
+	if(!$mods_sheet) {
+		 my $xslt_doc = $parser->parse_file(
+			OpenSRF::Utils::SettingsClient->new->config_value(dirs => 'xsl') .  "/MARC21slim2MODS32.xsl");
+		$mods_sheet = $xslt->parse_stylesheet( $xslt_doc );
+	}
+
+
+	my $xmldoc = $parser->parse_string($master_doc);
+	my $mods = $mods_sheet->transform($xmldoc);
+
+	$self->{master_doc} = $self->modsdoc_to_values( $mods );
+	$self->{master_doc} = $self->mods_values_to_mods_slim( $self->{master_doc} );
+
+	($self->{master_doc}->{isbn}) = 
+		$self->get_field_value( $mods, $isbn_xpath );
+
+	$self->{master_doc}->{type_of_resource} = 
+		[ $self->get_field_value( $mods, $resource_xpath ) ];
+
+	($self->{master_doc}->{tcn}) = 
+		$self->get_field_value( $mods, $tcn_xpath );
+
+	($self->{master_doc}->{pubdate}) = 
+		$self->get_field_value( $mods, $pub_xpath );
+
+	($self->{master_doc}->{publisher}) = 
+		$self->get_field_value( $mods, $publisher_xpath );
+
+	($self->{master_doc}->{edition}) =
+		$self->get_field_value( $mods, $edition_xpath );
+
+
+
+# ------------------------------
+	# holds an array of [ link, title, link, title, ... ]
+	$self->{master_doc}->{online_loc} = [];
+	for my $url ($mods->findnodes($online_loc_xpath)) {
+		push(@{$self->{master_doc}->{online_loc}}, $url->textContent);
+		push(@{$self->{master_doc}->{online_loc}}, $url->getAttribute('displayLabel') || '');
+		push(@{$self->{master_doc}->{online_loc}}, $url->getAttribute('note') || '');
+	}
+
+	($self->{master_doc}->{synopsis}) = 
+		$self->get_field_value( $mods, $abstract_xpath );
+
+	$self->{master_doc}->{physical_description} = [];
+	push(@{$self->{master_doc}->{physical_description}},
+		$self->get_field_value( $mods, $physical_desc ) );
+	$self->{master_doc}->{physical_description} = 
+		join( ' ', @{$self->{master_doc}->{physical_description}});
+
+	($self->{master_doc}->{toc}) = $self->get_field_value($mods, $toc_xpath);
+
+}
+
+
+
+# ---------------------------------------------------------------------------
+# Takes a MARCXML string and adds it to the growing MODS doc
+# ---------------------------------------------------------------------------
+sub push_mods_batch {
+	my( $self, $marcxml ) = @_;
+
+	my $xmldoc = $parser->parse_string($marcxml);
+	my $mods = $mods_sheet->transform($xmldoc);
+
+	my $xmlperl = $self->modsdoc_to_values( $mods );
+	$xmlperl = $self->mods_values_to_mods_slim( $xmlperl );
+
+	# for backwards compatibility, remove the array part when all is decided
+	if(ref($xmlperl->{subject}) eq 'ARRAY' ) {
+		for my $subject( @{$xmlperl->{subject}} ) {
+			push @{$self->{master_doc}->{subject}}, $subject;
+		}
+	} else {
+		for my $subject ( keys %{$xmlperl->{subject}} ) {
+			my $s = $self->{master_doc}->{subject};
+			if(defined($s->{$subject})) { $s->{$subject}++; } else { $s->{$subject} = 1; }
+		}
+	}
+
+	push( @{$self->{master_doc}->{type_of_resource}}, 
+		$self->get_field_value( $mods, $resource_xpath ));
+
+	if(!($self->{master_doc}->{isbn}) ) {
+		($self->{master_doc}->{isbn}) = 
+			$self->get_field_value( $mods, $isbn_xpath );
+	}
+}
+
+
+# ---------------------------------------------------------------------------
+# Completes a MARC -> Unified MODS batch process and returns the perl hash
+# ---------------------------------------------------------------------------
+sub init_virtual_record {
+	my $record = Fieldmapper::metabib::virtual_record->new;
+	$record->subject([]);
+	$record->types_of_resource([]);
+	$record->call_numbers([]);
+	return $record;
+}
+
+sub finish_mods_batch {
+	my $self = shift;
+
+	return undef unless $self->{master_doc};
+
+	my $perl = $self->{master_doc};
+	my $record = init_virtual_record();
+
+	# turn the hash into a fieldmapper object
+	#(my $title = $perl->{title}) =~ s/\[.*?\]//og;
+	#(my $author = $perl->{author}) =~ s/\(.*?\)//og;
+	my $title = $perl->{title};
+	my $author = $perl->{author};
+
+	my @series;
+	for my $s (@{$perl->{series}}) {
+		push @series, (split( /\s*;/, $s ))[0];
+	}
+
+	# uniquify the types of resource
+	my $rtypes = $perl->{type_of_resource};
+	my %hash = map { ($_ => 1) } @$rtypes;
+	$rtypes = [ keys %hash ];
+
+	$record->title($title);
+	$record->author($author);
+
+	$record->doc_id($perl->{doc_id});
+	$record->isbn($perl->{isbn});
+	$record->pubdate($perl->{pubdate});
+	$record->publisher($perl->{publisher});
+	$record->tcn($perl->{tcn});
+
+	$record->edition($perl->{edition});
+
+	$record->subject($perl->{subject});
+	$record->types_of_resource($rtypes);
+	$record->series(\@series);
+
+	$record->online_loc($perl->{online_loc});
+	$record->synopsis($perl->{synopsis});
+	$record->physical_description($perl->{physical_description});
+	$record->toc($perl->{toc});
+
+	$self->{master_doc} = undef;
+	return $record;
+}
+
+
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/Normalize.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/Normalize.pm
new file mode 100644
index 0000000000..d71503c5e1
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/Normalize.pm
@@ -0,0 +1,70 @@
+package OpenILS::Utils::Normalize;
+use strict;
+use warnings;
+use Unicode::Normalize;
+use Encode;
+
+use Exporter 'import';
+our @EXPORT_OK = qw( naco_normalize );
+
+sub naco_normalize {
+
+    my $str = decode_utf8(shift);
+    my $sf = shift;
+
+    # Apply NACO normalization to input string; based on
+    # http://www.loc.gov/catdir/pcc/naco/SCA_PccNormalization_Final_revised.pdf
+    #
+    # Note that unlike a strict reading of the NACO normalization rules,
+    # output is returned as lowercase instead of uppercase for compatibility
+    # with previous versions of the Evergreen naco_normalize routine.
+
+    # Convert to upper-case first; even though final output will be lowercase, doing this will
+    # ensure that the German eszett (ß) and certain ligatures (ff, fi, ffl, etc.) will be handled correctly.
+    # If there are any bugs in Perl's implementation of upcasing, they will be passed through here.
+    $str = uc $str;
+
+    # remove non-filing strings
+    $str =~ s/\x{0098}.*?\x{009C}//g;
+
+    $str = NFKD($str);
+
+    # additional substitutions - 3.6.
+    $str =~ s/\x{00C6}/AE/g;
+    $str =~ s/\x{00DE}/TH/g;
+    $str =~ s/\x{0152}/OE/g;
+    $str =~ tr/\x{0110}\x{00D0}\x{00D8}\x{0141}\x{2113}\x{02BB}\x{02BC}]['/DDOLl/d;
+
+    # transformations based on Unicode category codes
+    $str =~ s/[\p{Cc}\p{Cf}\p{Co}\p{Cs}\p{Lm}\p{Mc}\p{Me}\p{Mn}]//g;
+
+	if ($sf && $sf =~ /^a/o) {
+		my $commapos = index($str, ',');
+		if ($commapos > -1) {
+			if ($commapos != length($str) - 1) {
+                $str =~ s/,/\x07/; # preserve first comma
+			}
+		}
+	}
+
+    # since we've stripped out the control characters, we can now
+    # use a few as placeholders temporarily
+    $str =~ tr/+&@\x{266D}\x{266F}#/\x01\x02\x03\x04\x05\x06/;
+    $str =~ s/[\p{Pc}\p{Pd}\p{Pe}\p{Pf}\p{Pi}\p{Po}\p{Ps}\p{Sk}\p{Sm}\p{So}\p{Zl}\p{Zp}\p{Zs}]/ /g;
+    $str =~ tr/\x01\x02\x03\x04\x05\x06\x07/+&@\x{266D}\x{266F}#,/;
+
+    # decimal digits
+    $str =~ tr/\x{0660}-\x{0669}\x{06F0}-\x{06F9}\x{07C0}-\x{07C9}\x{0966}-\x{096F}\x{09E6}-\x{09EF}\x{0A66}-\x{0A6F}\x{0AE6}-\x{0AEF}\x{0B66}-\x{0B6F}\x{0BE6}-\x{0BEF}\x{0C66}-\x{0C6F}\x{0CE6}-\x{0CEF}\x{0D66}-\x{0D6F}\x{0E50}-\x{0E59}\x{0ED0}-\x{0ED9}\x{0F20}-\x{0F29}\x{1040}-\x{1049}\x{1090}-\x{1099}\x{17E0}-\x{17E9}\x{1810}-\x{1819}\x{1946}-\x{194F}\x{19D0}-\x{19D9}\x{1A80}-\x{1A89}\x{1A90}-\x{1A99}\x{1B50}-\x{1B59}\x{1BB0}-\x{1BB9}\x{1C40}-\x{1C49}\x{1C50}-\x{1C59}\x{A620}-\x{A629}\x{A8D0}-\x{A8D9}\x{A900}-\x{A909}\x{A9D0}-\x{A9D9}\x{AA50}-\x{AA59}\x{ABF0}-\x{ABF9}\x{FF10}-\x{FF19}/0-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-90-9/;
+
+    # intentionally skipping step 8 of the NACO algorithm; if the string
+    # gets normalized away, that's fine.
+
+    # leading and trailing spaces
+    $str =~ s/\s+/ /g;
+    $str =~ s/^\s+//;
+    $str =~ s/\s+$//g;
+
+    return lc $str;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/OfflineStore.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/OfflineStore.pm
new file mode 100644
index 0000000000..5bf0141cdb
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/OfflineStore.pm
@@ -0,0 +1,114 @@
+package OpenILS::Utils::OfflineStore;
+use strict; use warnings;
+
+use UNIVERSAL::require;
+if ('Class::DBI::Frozen::301'->use) {
+	use parent 'Class::DBI::Frozen::301';
+} elsif ('Class::DBI'->use) {
+	use parent 'Class::DBI';
+} else {
+	die $@;
+}
+
+use DBI;
+use OpenSRF::Utils::Config;
+
+our ($_dsn,$_u,$_p);
+sub DBFile {
+	my $class = shift;
+	my $dsn = shift;
+	my $u = shift;
+	my $p = shift;
+	if ($dsn) {
+		$_dsn = $dsn;
+		$_u = $u;
+		$_p = $p;
+	}
+	return $_dsn;
+}
+
+our $_dbh;
+sub db_Main {
+	my $self = shift;
+	return $_dbh if ($_dbh);
+
+	$_dbh = DBI->connect($_dsn,$_u,$_p,
+		{
+			RootClass => 'DBIx::ContextualFetch' 
+		}
+	);
+
+	return $_dbh;
+}
+
+
+sub disconnect {
+	$_dbh->disconnect;
+	$_dbh = undef;
+}
+
+
+package OpenILS::Utils::OfflineStore::Session;
+use parent 'OpenILS::Utils::OfflineStore';
+
+sub _create_table {
+	my $self = shift;
+	$self->db_Main->do( <<"	SQL" );
+
+CREATE TABLE session (
+	key				TEXT	UNIQUE PRIMARY KEY,
+	org				INTEGER	NOT NULL,
+	description		TEXT,
+	creator			INTEGER NOT NULL,
+	create_time		INTEGER NOT NULL,
+	in_process		INTEGER NOT NULL DEFAULT 0,
+	start_time		INTEGER,
+	end_time			INTEGER,
+	num_complete	INTEGER NOT NULL DEFAULT 0
+);
+CREATE INDEX IF NOT EXISTS session_pkey ON session (key);
+CREATE INDEX IF NOT EXISTS session_org ON session (org);
+CREATE INDEX IF NOT EXISTS session_creation ON session (create_time);
+
+	SQL
+}
+
+__PACKAGE__->table('offline.session');
+__PACKAGE__->columns( Essential => qw/key org description 
+		creator create_time in_process start_time end_time num_complete/);
+__PACKAGE__->has_many(scripts => 'OpenILS::Utils::OfflineStore::Script');
+
+
+package OpenILS::Utils::OfflineStore::Script;
+use parent 'OpenILS::Utils::OfflineStore';
+
+sub _create_table {
+	my $self = shift;
+	$self->db_Main->do( <<"	SQL" );
+
+CREATE TABLE script (
+	id		INTEGER	UNIQUE PRIMARY KEY AUTOINCREMENT,
+	session		TEXT	NOT NULL,
+	requestor	INTEGER	NOT NULL,
+	create_time	INTEGER	NOT NULL,
+	workstation	TEXT	NOT NULL,
+	logfile		TEXT	NOT NULL,
+	time_delta	INTEGER	NOT NULL DEFAULT 0,
+	count			INTEGER	NOT NULL DEFAULT 0
+);
+CREATE INDEX IF NOT EXISTS script_pkey ON script (id);
+CREATE INDEX IF NOT EXISTS script_ws ON script (workstation);
+CREATE INDEX IF NOT EXISTS script_session ON script (session);
+
+	SQL
+}
+
+__PACKAGE__->table('offline.script');
+__PACKAGE__->columns( Essential => qw/id session requestor create_time workstation logfile time_delta count/);
+__PACKAGE__->has_a(session => 'OpenILS::Utils::OfflineStore::Session');
+__PACKAGE__->sequence(qw/offline.script_id_seq/);
+
+
+
+
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/Penalty.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/Penalty.pm
new file mode 100644
index 0000000000..f259345da4
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/Penalty.pm
@@ -0,0 +1,124 @@
+package OpenILS::Utils::Penalty;
+use strict; use warnings;
+use DateTime;
+use Data::Dumper;
+use OpenSRF::EX qw(:try);
+use OpenSRF::Utils::Cache;
+use OpenSRF::Utils qw/:datetime/;
+use OpenILS::Application::AppUtils;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Const qw/:const/;
+my $U = "OpenILS::Application::AppUtils";
+
+
+# calculate and update the well-known penalties
+sub calculate_penalties {
+    my($class, $e, $user_id, $context_org) = @_;
+
+    my $commit = 0;
+    unless($e) {
+        $e = new_editor(xact =>1);
+        $commit = 1;
+    }
+
+    my $penalties = $e->json_query({from => ['actor.calculate_system_penalties',$user_id, $context_org]});
+
+    my $user = $e->retrieve_actor_user( $user_id );
+    my @existing_penalties = grep { defined $_->{id} } @$penalties;
+    my @wanted_penalties = grep { !defined $_->{id} } @$penalties;
+    my @trigger_events;
+
+    my %csp;
+    for my $pen_obj (@wanted_penalties) {
+
+        my $pen = Fieldmapper::actor::user_standing_penalty->new;
+        $pen->$_($pen_obj->{$_}) for keys %$pen_obj;
+
+        # let's see if this penalty is accounted for already
+        my ($existing) = grep { 
+                $_->{org_unit} == $pen_obj->{org_unit} and
+                $_->{standing_penalty} == $pen_obj->{standing_penalty}
+            } @existing_penalties;
+
+        if($existing) { 
+            # we have one of these already.  Leave it be, but remove it from the 
+            # existing set so it's not deleted in the subsequent loop
+            @existing_penalties = grep { $_->{id} ne $existing->{id} }  @existing_penalties;
+
+        } else {
+
+            # this is a new penalty
+            $e->create_actor_user_standing_penalty($pen) or return $e->die_event;
+
+            my $csp_obj = $csp{$pen->standing_penalty} || 
+                $e->retrieve_config_standing_penalty( $pen->standing_penalty );
+
+            # cache for later
+            $csp{$pen->standing_penalty} = $csp_obj;
+
+            push(@trigger_events, ['penalty.' . $csp_obj->name, $pen, $pen->org_unit]);
+        }
+    }
+
+    # at this point, any penalties remaining in the existing 
+    # penalty set are unaccounted for and should be removed
+    for my $pen_obj (@existing_penalties) {
+        my $pen = Fieldmapper::actor::user_standing_penalty->new;
+        $pen->$_($pen_obj->{$_}) for keys %$pen_obj;
+        $e->delete_actor_user_standing_penalty($pen) or return $e->die_event;
+    }
+
+    $e->commit if $commit;
+
+    $U->create_events_for_hook($$_[0], $$_[1], $$_[2]) for @trigger_events;
+    return undef;
+}
+
+# any penalties whose block_list has an item from @fatal_mask will be sorted
+# into the fatal_penalties set.  Others will be sorted into the info_penalties set
+sub retrieve_penalties {
+    my($class, $e, $user_id, $context_org, @fatal_mask) = @_;
+
+    my(@info, @fatal);
+    my $penalties = $class->retrieve_usr_penalties($e, $user_id, $context_org);
+
+    for my $p (@$penalties) {
+        my $pushed = 0;
+        if($p->standing_penalty->block_list) {
+            for my $m (@fatal_mask) {
+                if($p->standing_penalty->block_list =~ /$m/) {
+                    push(@fatal, $p->standing_penalty);
+                    $pushed = 1;
+                    last;
+                }
+            }
+        }
+        push(@info, $p->standing_penalty) unless $pushed;
+    }
+
+    return {fatal_penalties => \@fatal, info_penalties => \@info};
+}
+
+
+# Returns a list of actor_user_standing_penalty objects
+sub retrieve_usr_penalties {
+    my($class, $e, $user_id, $context_org) = @_;
+
+    return $e->search_actor_user_standing_penalty([
+        {
+            usr => $user_id, 
+            org_unit => $U->get_org_ancestors($context_org),
+            '-or' => [
+                {stop_date => undef},
+                {stop_date => {'>' => 'now'}}
+            ],
+        },
+        {flesh => 1, flesh_fields => {ausp => ['standing_penalty']}}
+    ]);
+}
+
+1;
+
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/PermitHold.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/PermitHold.pm
new file mode 100644
index 0000000000..47a561aea8
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/PermitHold.pm
@@ -0,0 +1,254 @@
+package OpenILS::Utils::PermitHold;
+use strict; use warnings;
+use Data::Dumper;
+use OpenSRF::Utils;
+use OpenSRF::Utils::SettingsClient;
+use OpenILS::Utils::ScriptRunner;
+use OpenILS::Application::AppUtils;
+use DateTime::Format::ISO8601;
+use OpenILS::Application::Circ::ScriptBuilder;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenILS::Event;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+my $U	= "OpenILS::Application::AppUtils";
+
+my $script;			# - the permit script
+my $script_libs;	# - extra script libs
+my $legacy_script_support;
+
+# mental note:  open-ils.storage.biblio.record_entry.ranged_tree
+
+
+# params within a hash are: copy, patron, 
+# requestor, request_lib, title, title_descriptor
+sub permit_copy_hold {
+	my $params	= shift;
+	my @allevents;
+
+    unless(defined $legacy_script_support) {
+        my $conf = OpenSRF::Utils::SettingsClient->new;
+        $legacy_script_support = $conf->config_value(
+            apps => 'open-ils.circ' => app_settings => 'legacy_script_support');
+        $legacy_script_support = ($legacy_script_support and 
+            $legacy_script_support =~ /true/i) ? 1 : 0;
+    }
+
+    return indb_hold_permit($params) unless $legacy_script_support;
+
+	my $ctx = {
+		patron_id	=> $$params{patron_id},
+		patron		=> $$params{patron},
+		copy			=> $$params{copy},
+		requestor	=> $$params{requestor},
+		title			=> $$params{title},
+		volume		=> $$params{volume},
+		flesh_age_protect => 1,
+		_direct	=> {
+			requestLib	=> $$params{request_lib},
+			pickupLib	=> $$params{pickup_lib},
+            newHold    => $$params{new_hold},
+		}
+	};
+
+	my $runner = OpenILS::Application::Circ::ScriptBuilder->build($ctx);
+
+	my $ets = $ctx->{_events};
+
+	# --------------------------------------------------------------
+	# Strip the expired event since holds are still allowed to be
+	# captured on expired patrons.  
+	# --------------------------------------------------------------
+	if( $ets and @$ets ) {
+		$ets = [ grep { $_->{textcode} ne 'PATRON_ACCOUNT_EXPIRED' } @$ets ];
+	} else { $ets = []; }
+
+	if( @$ets ) {
+		push( @allevents, @$ets);
+
+		# --------------------------------------------------------------
+		# If scriptbuilder returned any events, then the script context
+		# is undefined and should not be used
+		# --------------------------------------------------------------
+
+	} else {
+
+		# check the various holdable flags
+		push( @allevents, OpenILS::Event->new('ITEM_NOT_HOLDABLE') )
+			unless $U->is_true($ctx->{copy}->holdable);
+	
+		push( @allevents, OpenILS::Event->new('ITEM_NOT_HOLDABLE') )
+			unless $U->is_true($ctx->{copy}->location->holdable);
+	
+		push( @allevents, OpenILS::Event->new('ITEM_NOT_HOLDABLE') )
+			unless $U->is_true($ctx->{copy}->status->holdable);
+	
+      my $evt;
+
+      # grab the data safely
+      my $rlib = ref($$params{request_lib}) ? $$params{request_lib}->id : $$params{request_lib};
+      my $olib = ref($ctx->{volume}) ? $ctx->{volume}->owning_lib : -1;
+      my $rid  = ref($ctx->{requestor}) ? $ctx->{requestor}->id : -2;
+		my $pid  = ($params->{patron}) ? $params->{patron}->id : $params->{patron_id};
+
+      if( ($rid ne $pid) and ($olib eq $rlib) ) {
+         $logger->info("Item owning lib $olib is the same as the request lib.  No age_protection will be checked");
+      } else {
+         $logger->info("item owning lib = $olib, request lib = $rlib, requestor=$rid, patron=$pid. checking age_protection");
+		   $evt = check_age_protect($ctx->{patron}, $ctx->{copy});
+		   push( @allevents, $evt ) if $evt;
+      }
+	
+		$logger->debug("Running permit_copy_hold on copy " . $$params{copy}->id);
+	
+		load_scripts($runner);
+		my $result = $runner->run or 
+			throw OpenSRF::EX::ERROR ("Hold Copy Permit Script Died: $@");
+
+		# --------------------------------------------------------------
+		# Extract and uniquify the event list
+		# --------------------------------------------------------------
+		my $events = $result->{events};
+		$logger->debug("circ_permit_hold for user $pid returned events: [@$events]");
+	
+		push( @allevents, OpenILS::Event->new($_)) for @$events;
+	}
+
+	my %hash = map { ($_->{ilsevent} => $_) } @allevents;
+	@allevents = values %hash;
+
+	$runner->cleanup;
+
+	return \@allevents if $$params{show_event_list};
+	return 1 unless @allevents;
+	return 0;
+}
+
+
+sub load_scripts {
+	my $runner = shift;
+
+	if(!$script) {
+		my $conf = OpenSRF::Utils::SettingsClient->new;
+		my @pfx	= ( "apps", "open-ils.circ","app_settings" );
+		my $libs	= $conf->config_value(@pfx, 'script_path');
+		$script	= $conf->config_value(@pfx, 'scripts', 'circ_permit_hold');
+		$script_libs = (ref($libs)) ? $libs : [$libs];
+	}
+
+	$runner->add_path($_) for(@$script_libs);
+	$runner->load($script);
+}
+
+
+sub check_age_protect {
+	my( $patron, $copy ) = @_;
+
+	return undef unless $copy and $copy->age_protect and $patron;
+
+	my $hou = (ref $patron->home_ou) ? $patron->home_ou->id : $patron->home_ou;
+
+	my $prox = $U->storagereq(
+		'open-ils.storage.asset.copy.proximity', $copy->id, $hou );
+
+	# If this copy is within the appropriate proximity, 
+	# age protect does not apply
+	return undef if $prox <= $copy->age_protect->prox;
+
+	my $protection_list = $U->storagereq(
+		'open-ils.storage.direct.config.rules.age_hold_protect.search_where.atomic', 
+		{ age  => { '>=' => $copy->age_protect->age  },
+		  prox => { '>=' => $copy->age_protect->prox },
+		},
+		{ order_by => 'age' }
+	);
+
+	# Now, now many seconds old is this copy
+	my $create_date = DateTime::Format::ISO8601
+		->new
+		->parse_datetime( OpenSRF::Utils::cleanse_ISO8601($copy->create_date) )
+		->epoch;
+
+	my $age = time - $create_date;
+
+	for my $protection ( @$protection_list ) {
+
+		$logger->info("analyzing age protect ".$protection->name);
+
+		# age protect does not apply if within the proximity
+		last if $prox <= $protection->prox;
+
+		# How many seconds old does the copy have to be to escape age protection
+		my $interval = OpenSRF::Utils::interval_to_seconds($protection->age);
+
+		$logger->info("age_protect interval=$interval, create_date=$create_date, age=$age");
+
+		if( $interval > $age ) { 
+			# if age of the item is less than the protection interval, 
+			# the item falls within the age protect range
+			$logger->info("age_protect prevents copy from having a hold placed on it: ".$copy->id);
+			return OpenILS::Event->new('ITEM_AGE_PROTECTED', copy => $copy->id );
+		}
+	}
+		
+	return undef;
+}
+
+my $LEGACY_HOLD_EVENT_MAP = {
+    'config.hold_matrix_test.holdable' => 'ITEM_NOT_HOLDABLE',
+    'transit_range' => 'ITEM_NOT_HOLDABLE',
+    'no_matchpoint' => 'NO_POLICY_MATCHPOINT',
+    'config.hold_matrix_test.max_holds' => 'MAX_HOLDS',
+    'config.rule_age_hold_protect.prox' => 'ITEM_AGE_PROTECTED'
+};
+
+sub indb_hold_permit {
+    my $params = shift;
+
+    my $function = $$params{retarget} ? 'action.hold_retarget_permit_test' : 'action.hold_request_permit_test';
+    my $patron_id = 
+        ref($$params{patron}) ? $$params{patron}->id : $$params{patron_id};
+    my $request_lib = 
+        ref($$params{request_lib}) ? $$params{request_lib}->id : $$params{request_lib};
+
+    my $HOLD_TEST = {
+        from => [
+            $function,
+            $$params{pickup_lib}, 
+            $request_lib,
+            $$params{copy}->id, 
+            $patron_id,
+            $$params{requestor}->id 
+        ]
+    };
+
+    my $e = new_editor(xact=>1);
+    my $results = $e->json_query($HOLD_TEST);
+    $e->rollback;
+
+    unless($$params{show_event_list}) {
+        return 1 if $U->is_true($results->[0]->{success});
+        return 0;
+    }
+
+    return [
+        new OpenILS::Event(
+            "NO_POLICY_MATCHPOINT",
+            "payload" => {"fail_part" => "no_matchpoint"}
+        )
+    ] unless @$results;
+
+    return [] if $U->is_true($results->[0]->{success});
+
+    return [
+        map {
+            my $event = new OpenILS::Event(
+                $LEGACY_HOLD_EVENT_MAP->{$_->{"fail_part"}} || $_->{"fail_part"}
+            );
+            $event->{"payload"} = {"fail_part" => $_->{"fail_part"}};
+            $event;
+        } @$results
+    ];
+}
+
+
+23;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/RemoteAccount.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/RemoteAccount.pm
new file mode 100644
index 0000000000..d8c399ca62
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/RemoteAccount.pm
@@ -0,0 +1,713 @@
+package OpenILS::Utils::RemoteAccount;
+
+# use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Logger qw/:logger/;
+
+use Data::Dumper;
+use Net::FTP;
+use Net::SSH2;
+use File::Temp;
+use File::Basename;
+use File::Spec;
+use Text::Glob qw( match_glob glob_to_regex );
+# use Error;
+
+$Data::Dumper::Indent = 0;
+
+use strict;
+use warnings;
+
+use Carp;
+
+our $AUTOLOAD;
+
+our %keyfiles = ();
+
+my %fields = (
+    account_object  => undef,
+    remote_host     => undef,
+    remote_user     => undef,
+    remote_password => undef,
+    remote_account  => undef,
+    remote_file     => undef,
+    remote_path     => undef,   # not really doing anything with this... yet.
+    ssh_privatekey  => undef,
+    ssh_publickey   => undef,
+    type            => undef,
+    port            => undef,
+    content         => undef,
+    local_file      => undef,
+    tempfile        => undef,
+    error           => undef,
+    single_ext      => undef,
+    specific        => 0,
+    debug           => 0,
+);
+
+
+=head1 NAME 
+
+OpenILS::Utils::RemoteAccount - Encapsulate FTP, SFTP and SSH file transactions for Evergreen
+
+=head1 DESCRIPTION
+
+The Remote Account module attempts to transfer a file to/from a remote server.
+Either Net::FTP or Net::SSH2 is used.
+
+=head1 PARAMETERS
+
+All information is expected to be supplied by the caller via parameters:
+   ~ remote_host (required)
+   ~ remote_user
+   ~ remote_password
+   ~ remote_account
+   ~ ssh_privatekey
+   ~ ssh_publickey
+   ~ type (FTP, SFTP or SCP -- default FTP)
+   ~ port
+   ~ debug
+
+Note: none of the parameters are actually required, except remote_host.
+That is because remote_user, remote_password and remote_account can all be 
+extrapolated from other sources, as the Net::FTP docs describe:
+
+    If no arguments are given then Net::FTP uses the Net::Netrc package
+        to lookup the login information for the connected host.
+
+    If no information is found then a login of anonymous is used.
+
+    If no password is given and the login is anonymous then anonymous@
+        will be used for password.
+
+Note that specifying a password will require you to specify a user.
+Similarly, specifying an account requires both user and password.
+That is, there are no assumed defaults when the latter arguments are used.
+
+=head2 SSH KEYS:
+
+The use of ssh keys is preferred.  Explicit specification of connection type will prevent
+multiple attempts to the same server.  Therefore, using the type parameter is also recommended.
+
+If the type is not explicit, we attempt to use SSH keys where they are specified or otherwise found
+in the runtime environment.  If only one key is specified, we attempt to derive
+the corresponding filename based on the ssh-keygen defaults.  If either key is
+specified, but both are not found (and readable) then the result is failure.  If
+no key or type is specified, but keys are found, the key-based connections will be attempted,
+but failure will be non-fatal.
+
+=cut
+
+sub plausible_dirs {
+    # returns plausible locations of a .ssh subdir where SSH keys might be stashed
+    # NOTE: these would need to be properly genericized w/ Makefile vars
+    # in order to support Debian packaging and multiple EG's on one box.
+    # Until that happens, we just rely on $HOME
+
+    my @bases = (
+       # '/openils/conf',     # __EG_CONFIG_DIR__
+    );
+    ($ENV{HOME}) and unshift @bases, $ENV{HOME};
+
+    return grep {-d $_} map {"$_/.ssh"} @bases;
+}
+
+sub local_keyfiles {
+    # populates %keyfiles hash
+    # %keyfiles maps SSH_PRIVATEKEY => SSH_PUBLICKEY
+    my $self  = shift;
+    my $force = (@_ ? shift : 0);
+    return %keyfiles if (%keyfiles and not $force);   # caching
+    $logger->info("Checking for SSH keyfiles" . ($force ? ' (ignoring cache)' : ''));
+    %keyfiles = ();  # reset to empty
+    my @dirs = plausible_dirs();
+    $logger->debug(scalar(@dirs) . " plausible dirs: " . join(', ', @dirs));
+    foreach my $dir (@dirs) {
+        foreach my $key (qw/rsa dsa/) {
+            my $private = "$dir/id_$key";
+            my $public  = "$dir/id_$key.pub";
+            unless (-r $private) {
+                $logger->debug("Key '$private' cannot be read: $!");
+                next;
+            }
+            unless (-r $public) {
+                $logger->debug("Key '$public' cannot be read: $!");
+                next;
+            }
+            $keyfiles{$private} = $public;
+        }
+    }
+    return %keyfiles;
+}
+
+sub param_keys {
+    my $self = shift;
+    my %keys = ();
+    if ($self->ssh_publickey and not $self->ssh_privatekey) {
+        my $private = $self->ssh_publickey;
+        unless ($private and $private =~ s/\.pub$// and -r $self->ssh_privatekey) {        # try to guess missing private key name
+            $logger->error("No ssh_privatekey specified or found to pair with " . $self->ssh_publickey);
+            return;
+        }
+        $self->ssh_privatekey($private);
+    }
+    if ($self->ssh_privatekey and not $self->ssh_publickey) {
+        my $pub = $self->ssh_privatekey . '.pub'; # guess missing public key name
+        unless (-r $pub) {
+            $logger->error("No ssh_publickey specified or found to pair with " . $self->ssh_privatekey);
+            return;
+        }
+        $self->ssh_publickey($pub);
+    }
+
+    # so now, we have either both ssh_p*keys params or neither
+    foreach (qw/ssh_publickey ssh_privatekey/) {
+        unless (-r $self->{$_}) {
+            $logger->error("$_ '" . $self->{$_} . "' cannot be read: $!");
+            return;                 # quit w/ error if we fail on any user-specified key
+        }
+    }
+    $keys{$self->ssh_privatekey} = $self->ssh_publickey;
+    return %keys;
+}
+
+sub new_tempfile {
+    my $self = shift;
+    my $text = shift || $self->content || ''; 
+    my $tmp  = File::Temp->new();      # magical self-destructing tempfile
+    # print $tmp "THIS IS TEXT\n";
+    print $tmp $text  or  $logger->error($self->_error("could not write to tempfile '$tmp'"));
+    close $tmp;
+    $self->tempfile($tmp);             # save the object
+    $self->local_file($tmp->filename);  # save the filename
+    $logger->info(_pkg("using tempfile $tmp"));
+    return $self->local_file;           # return the filename
+}
+
+sub outbound_file {
+    my $self   = shift;
+    my $params = shift;
+
+    unless (defined $self->content or $self->local_file) {   # content can be emptystring
+        $logger->error($self->_error("No content or local_file specified -- nothing to send"));
+        return;
+    }
+
+    # tricky subtlety: we want to use the most recently specified options 
+    #   with priority order: filename, content, old filename, old content.
+    # 
+    # The $params->{x} will already match $self->x after the secondary init,
+    # so the checks using $params below are for whether the value was specified NOW (e.g. via put()) or not.
+    # 
+    # if we got a new local_file value, we use it
+    # else if the content is new to this call, build a new tempfile w/ it,
+    # else use existing local_file,
+    # else build new tempfile w/ content already specified via new()
+
+    return $params->{local_file} || (
+        (defined $params->{content})          ?
+         $self->new_tempfile($self->content)  :     # $self->content is same value as $params->{content}
+        ($self->local_file || $self->new_tempfile($self->content))
+    );
+}
+
+sub key_check {
+    my $self   = shift;
+    my $params = shift;
+
+    return if ($params->{type} and $params->{type} eq 'FTP');   # Forget it, user specified regular FTP
+    return if (   $self->type  and    $self->type  eq 'FTP');   # Forget it, user specified regular FTP
+
+    if ($self->ssh_publickey || $self->ssh_privatekey) {
+        $self->specific(1);
+        return $self->param_keys();  # we got one or both params, but they didn't pan out
+    }
+    return local_keyfiles();     # optional "force" arg could be used here to empty cache
+}
+
+
+# TOP LEVEL methods
+# TODO: delete for both FTP and SSH2
+
+sub get {
+    my $self   = shift;
+    my $params = shift;
+    if (! ref $params) {
+        $params = {remote_file => $params} ;
+    }
+
+    $self->init($params);   # secondary init
+
+    $self->{get_args} = [$self->remote_file];      # same for scp_put and FTP put
+    push @{$self->{get_args}}, $self->local_file if defined $self->local_file;
+    
+    # $self->content($content);
+
+    if ($self->type eq "FTP") {
+        return $self->get_ftp(@{$self->{get_args}});
+    } else {
+        my %keys = $self->key_check($params);
+        return $self->get_ssh2(\%keys, @{$self->{get_args}});
+    }
+}
+
+sub put {
+    my $self   = shift;
+    my $params = shift;
+    if (! ref $params) {
+        $params = {local_file => $params} ;
+    }
+
+    $self->init($params);   # secondary init
+   
+    my $local_file = $self->outbound_file($params) or return;
+
+    $self->{put_args} = [$local_file];      # same for scp_put and FTP put
+    if (defined $self->remote_path and not defined $self->remote_file) {
+        my $rpath = $self->remote_path;
+        my $fname = basename($local_file);
+        if ($rpath =~ /^(.*)\*+(.*)$/) {    # if the path has an asterisk in it, like './incoming/*.tst'
+            my $head = $1;
+            my $tail = $2;
+            if ($tail =~ /\//) {
+                $logger->warn($self->_error("remote path '$rpath' has dir slashes AFTER an asterisk.  Cannot determine target dir"));
+                return;
+            }
+            if ($self->single_ext) {
+                $tail =~ /\./ and $fname =~ s/\./_/g;    # if dot in tail, replace dots in fname (w/ _)
+            }
+            $self->remote_file($head . $fname . $tail);
+        } else {
+            $self->remote_file($rpath . '/' . $fname);   # if we know just the dir
+        }
+    }
+
+    if (defined $self->remote_file) {
+        push @{$self->{put_args}}, $self->remote_file;   # user can specify remote_file name, optionally
+    }
+
+    if ($self->type eq "FTP") {
+        return $self->put_ftp(@{$self->{put_args}});
+    } else {
+        my %keys = $self->key_check($params);
+        $self->put_ssh2(\%keys, @{$self->{put_args}}) and return $self->remote_file;
+    }
+}
+
+sub ls {
+    my $self   = shift;
+    my $params = shift;
+    my @targets = @_;
+    if (! ref $params) {
+        unshift @targets, ($params || '.');   # If it was just a string, it's the first target, else default pwd
+        delete $self->{remote_file}; # overriding any target in the object previously.
+        $params = {};                # make params a normal hashref again
+    } else {
+        if ($params->{remote_file} and @_) {
+            $logger->warn($self->_error("Ignoring ls parameter remote_file for subsequent args"));
+            delete $params->{remote_file};
+        }
+        $self->init($params);   # secondary init
+        $self->remote_file and (! @targets) and push @targets, $self->remote_file;  # if remote_file is there, and there's nothing else, use it
+        delete $self->{remote_file};
+    }
+
+    $self->{ls_args} = \@targets;
+
+    if ($self->type eq "FTP") {
+        return $self->ls_ftp(@targets);
+    } else {
+        my %keys = $self->key_check($params);
+        # $logger->info("*** calling ls_ssh2(keys, '" . join("', '", (scalar(@targets) ? map {defined $_ ? $_ : '' } @targets : ())) . "') with ssh keys");
+        return $self->ls_ssh2(\%keys, @targets);
+    }
+}
+
+# Checks if the filename part of a pathname has one or more glob characters
+# We split out the filename portion of the path
+# Detect glob or no glob.
+# returns: directory, regex for matching filenames
+sub glob_parse {
+    my $self = shift;
+    my $path = shift or return;
+    my ($vol, $dir, $file) = File::Spec->splitpath($path); # we don't care about attempted globs in mid-filepath
+    my $front = $vol ? File::Spec->catdir($vol, $dir) : $dir;
+    $file =~ /\*/ and return ($front, glob_to_regex($file));
+    $file =~ /\?/ and return ($front, glob_to_regex($file));
+    $logger->debug("No glob detected in '$path'");
+    return;
+}
+
+
+# Internal Mechanics
+
+sub _ssh2 {
+    my $self = shift;
+    $self->{ssh2} and return $self->{ssh2};     # caching
+    my $keys = shift;
+
+    my $ssh2 = Net::SSH2->new();
+    unless($ssh2->connect($self->remote_host)) {
+        $logger->warn($self->error("SSH2 connect FAILED: $! " . join(" ", $ssh2->error)));
+        return;     # we cannot connect
+    }
+
+    my $success  = 0;
+    my @privates = keys %$keys;
+    my $count    = scalar @privates;
+
+    if ($count) {
+        foreach (@privates) {
+            if ($self->auth_ssh2($ssh2,$self->auth_ssh2_args($_,$keys->{$_}))) {
+                $success++;
+                last;
+            }
+        }
+        unless ($success) {
+            $logger->error(
+                $self->error(
+                    "All ($count) keypair(s) FAILED for " . $self->remote_host
+                )
+            );
+            return;
+        }
+    } else {
+        $logger->error(
+            $self->error("Login FAILED for " . $self->remote_host)
+        ) unless $self->auth_ssh2($ssh2, $self->auth_ssh2_args);
+    }
+    return $self->{ssh2} = $ssh2;
+}
+
+sub auth_ssh2 {
+    my $self = shift;
+    my $ssh2 = shift;
+    my %auth_args = @_;
+    $ssh2 or return;
+
+    my $host = $auth_args{hostname}   || 'UNKNOWN';
+    my $key  = $auth_args{privatekey} || 'UNKNOWN';
+    my $msg  = "ssh2->auth by keypair for $host using $key"; 
+    if ($ssh2->auth(%auth_args)) {
+        $logger->info("Successful $msg");
+         return 1;
+    }
+
+    if ($self->specific) {
+        $logger->error($self->error("Aborting. FAILED $msg: " . ($ssh2->error || '')));
+    } else {
+        $logger->warn($self->error("Unsuccessful keypair: FAILED $msg: " . ($ssh2->error || '')));
+    }
+    return;
+}
+
+sub auth_ssh2_args {
+    my $self = shift;
+    my %auth_args = (
+        privatekey => shift,
+        publickey  => shift,
+        rank => [qw/ publickey hostbased password /],
+    );
+    $self->remote_user     and $auth_args{username} = $self->remote_user    ;
+    $self->remote_password and $auth_args{password} = $self->remote_password;
+    $self->remote_host     and $auth_args{hostname} = $self->remote_host    ;
+    return %auth_args;
+}
+
+sub put_ssh2 {
+    my $self = shift;
+    my $keys = shift;    # could have many keypairs here
+    unless (@_) {
+        $logger->error($self->_error("put_ssh2 called without target: nothing to put!"));
+        return;
+    }
+    
+    $logger->info("*** attempting put (" . join(", ", @_) . ") with ssh keys");
+    my $ssh2 = $self->_ssh2($keys) or return;
+    my $res;
+    if ($res = $ssh2->scp_put( @_ )) {
+        $logger->info(_pkg("successfully sent", $self->remote_host, join(' --> ', @_ )));
+        return $res;
+    }
+    $logger->error($self->_error(sprintf "put with keys to %s failed with error: $!", $self->remote_host));
+    return;
+}
+
+sub get_ssh2 {
+    my $self = shift;
+    my $keys = shift;    # could have many keypairs here
+    unless (@_) {
+        $logger->error($self->_error("get_ssh2 called without target: nothing to get!"));
+        return;
+    }
+    
+    $logger->info("*** get args: " . Dumper(\@_));
+    $logger->info("*** attempting get (" . join(", ", map {$_ =~ /\S/ ? $_ : '*Object'} map {defined($_) ? $_ : '*Object'} @_) . ") with ssh keys");
+    my $ssh2 = $self->_ssh2($keys) or return;
+    my $res;
+    if ($res = $ssh2->scp_get( @_ )) {
+        $logger->info(_pkg("successfully got", $self->remote_host, join(' --> ', @_ )));
+        return $res;
+    }
+    $logger->error($self->_error(sprintf "get with keys from %s failed with error: $!", $self->remote_host));
+    return;
+}
+
+sub ls_ssh2 {
+    my $self = shift;
+    my @list = $self->ls_ssh2_full(@_);
+    @list and return sort map {$_->{slash_path}} @list;
+#   @list and return sort grep {$_->{name} !~ /./ and {$_->{name} !~ /./ } map {$_->{slash_path}} @list;
+}
+
+sub ls_ssh2_full {
+    my $self = shift;
+    my $keys = shift;    # could have many keypairs here
+    my @targets = grep {defined} @_;
+
+    $logger->info("*** attempting ls ('" . join("', '", @targets) . "') with ssh keys");
+    my $ssh2 = $self->_ssh2($keys) or return;
+    my $sftp = $ssh2->sftp         or return;
+
+    my @list = ();
+    foreach my $target (@targets) {
+        my ($dir, $file);
+        my ($dirpath, $regex) = $self->glob_parse($target);
+        $dir = $sftp->opendir($dirpath || $target);     # Try to open it like a directory
+        unless ($dir) {
+            $file = $sftp->stat($target);   # Otherwise, check it like a file
+            if ($file) {
+                $file->{slash_path} = $self->_slash_path($target, $file->{name});     # it was a file, not a dir.  That's OK.
+                push @list, $file;
+            } else {
+                $logger->warn($self->_error("sftp->opendir($target) failed: " . $sftp->error));
+            }
+            next;
+        }
+        my @pool = ();
+        while ($file = $dir->read()) {
+            $file->{slash_path} = $self->_slash_path($target, $file->{name});
+            push @pool, $file;
+        }
+        if ($regex) {
+            my $count = scalar(@pool);
+            @pool = grep {$_->{name} =~ /$regex/} @pool;
+            $logger->info("SSH ls: Glob regex($regex) matches " . scalar(@pool) . " of $count files"); 
+        } # else { $logger->info("SSH ls: No Glob regex in '$target'.  Just a regular ls"); }
+        push @list, @pool;
+    }
+    return @list;
+
+}
+
+sub _slash_path {
+    my $self = shift;
+    my $dir  = shift || '.';
+    my $file = shift || '';
+    my ($dirpath, $regex) = $self->glob_parse($dir);
+    $dir = $dirpath if $dirpath;
+    return $dir . ($dir =~ /\/$/ ? '' : '/') . $file;
+}
+
+sub _ftp {
+    my $self = shift;
+    my %options = ();
+    $self->{ftp} and return $self->{ftp};   # caching
+    foreach (qw/debug port/) {
+        $options{ucfirst($_)} = $self->{$_} if $self->{$_};
+    }
+
+    my $ftp = new Net::FTP($self->remote_host, %options);
+    unless ($ftp) {
+        $logger->error(
+            $self->_error(
+                "new Net::FTP('" . $self->remote_host . ", ...) FAILED: $@"
+            )
+        );
+        return;
+    }
+
+    my @login_args = ();
+    foreach (qw/remote_user remote_password remote_account/) {
+        $self->{$_} or last;
+        push @login_args, $self->{$_};
+    }
+    my $login_ok = 0;
+    eval { $login_ok = $ftp->login(@login_args) };
+    if ($@ or !$login_ok) {
+        $logger->error(
+            $self->_error(
+                "failed login to", $self->remote_host, "w/ args(" .
+                join(',', @login_args) . ") : $@"
+            )
+        ); # XXX later, maybe keep passwords out of the logs?
+        return;
+    }
+    return $self->{ftp} = $ftp;
+}
+
+sub put_ftp {
+    my $self = shift;
+    my $filename;
+
+    eval { $filename = $self->_ftp->put(@{$self->{put_args}}) };
+    if ($@ or not $filename) {
+        $logger->error(
+            $self->_error(
+                "put to", $self->remote_host, "failed with error: $@"
+            )
+        );
+        return;
+    }
+
+    $self->remote_file($filename);
+    $logger->info(
+        _pkg(
+            "successfully sent", $self->remote_host, $self->local_file, '-->',
+            $filename
+        )
+    );
+    return $filename;
+}
+
+sub get_ftp {
+    my $self = shift;
+    my $filename;
+
+    eval { $filename = $self->_ftp->get(@{$self->{get_args}}) };
+    if ($@ or not $filename) {
+        $logger->error(
+            $self->_error(
+                "get from", $self->remote_host, "failed with error: $@"
+            )
+        );
+        return;
+    }
+
+    $self->local_file($filename);
+    $logger->info(
+        _pkg(
+            "successfully retrieved $filename <--", $self->remote_host . '/' .
+            $self->remote_file
+        )
+    );
+    return $self->local_file;
+}
+
+sub ls_ftp {   # returns full path like: dir/path/file.ext
+    my $self = shift;
+    my @list;
+
+    foreach (@_) {
+        my @part;
+        my ($dirpath, $regex) = $self->glob_parse($_);
+        my $dirtarget = $dirpath || $_;
+        $dirtarget =~ s/\/+$//;
+        eval { @part = $self->_ftp->ls($dirtarget) };      # this ls returns relative/path/filenames.  defer filename glob filtering for below.
+        if ($@) {
+            $logger->error(
+                $self->_error(
+                    "ls from",  $self->remote_host, "failed with error: $@"
+                )
+            );
+            next;
+        }
+        if ($dirtarget and $dirtarget ne '.' and $dirtarget ne './' and
+            $self->_ftp->is_dir($dirtarget)) {
+            foreach my $file (@part) {   # we ensure full(er) path
+                $file =~ /^$dirtarget\// and next;
+                $logger->debug("ls_ftp: prepending $dirtarget/ to $file");
+                $file = File::Spec->catdir($dirtarget, $file);
+            }
+        }
+        if ($regex) {
+            my $count = scalar(@part);
+            # @part = grep {my @a = split('/',$_); scalar(@a) ? /$regex/ : ($a[-1] =~ /$regex/)} @part;
+            my @bulk = @part;
+            @part = grep {
+                        my ($vol, $dir, $file) = File::Spec->splitpath($_);
+                        $file =~ /$regex/
+                    } @part;  
+            $logger->info("FTP ls: Glob regex($regex) matches " . scalar(@part) . " of $count files");
+        } #  else {$logger->info("FTP ls: No Glob regex in '$_'.  Just a regular ls");}
+        push @list, @part;
+    }
+    return @list;
+}
+
+sub delete_ftp { # XXX not yet used
+    $_[0]->_ftp->delete($_[1]);
+}
+
+sub _pkg {      # Not OO
+    return __PACKAGE__ . ' : ' unless @_;
+    return __PACKAGE__ . ' : ' . join(' ', @_);
+}
+
+sub _error {
+    my $self = shift;
+    return _pkg($self->error(join(' ',@_)));
+}
+
+sub init {
+    my $self   = shift;
+    my $params = shift;
+    my @required = @_;  # qw(remote_host) ;     # nothing required now
+
+    if ($params->{account_object}) {    # if we got passed an object, we initialize off that first
+        $self->{remote_host    } = $params->{account_object}->host;
+        $self->{remote_user    } = $params->{account_object}->username;
+        $self->{remote_password} = $params->{account_object}->password;
+        $self->{remote_account } = $params->{account_object}->account;
+        $self->{remote_path    } = $params->{account_object}->path;     # not really the same as remote_file, maybe expand on this later
+    }
+
+    foreach (keys %{$self->{_permitted}}) {
+        $self->{$_} = $params->{$_} if defined $params->{$_};   # possibly override settings from object
+    }
+
+    foreach (@required) {
+        unless ($self->{$_}) {
+            $logger->error("Required parameter $_ not specified");
+            return;
+        }
+    }
+    return $self;
+}
+
+sub new {
+    my ($class, %args) = @_;
+    my $self = { _permitted => \%fields, %fields };
+
+	bless $self, $class;
+
+    $self->init(\%args); # or croak "Initialization error caused by bad args";
+    return $self;
+}
+
+sub DESTROY { 
+	# in order to create, we must first ...
+	my $self  = shift;
+    $self->{ssh2} and $self->{ssh2}->disconnect();  # let the other end know we're done.
+    $self->{ftp} and $self->{ftp}->quit();  # let the other end know we're done.
+}
+
+sub AUTOLOAD {
+	my $self  = shift;
+	my $class = ref($self) or croak "AUTOLOAD error: $self is not an object";
+	my $name  = $AUTOLOAD;
+
+	$name =~ s/.*://;   #   strip leading package stuff
+
+	unless (exists $self->{_permitted}->{$name}) {
+		croak "AUTOLOAD error: Cannot access '$name' field of class '$class'";
+	}
+
+	if (@_) {
+		return $self->{$name} = shift;
+	} else {
+		return $self->{$name};
+	}
+}
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/ScriptRunner.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/ScriptRunner.pm
new file mode 100644
index 0000000000..72265f6f67
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/ScriptRunner.pm
@@ -0,0 +1,599 @@
+package OpenILS::Utils::ScriptRunner;
+use strict; use warnings;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenSRF::EX qw(:try);
+use OpenSRF::Utils::JSON;
+use JavaScript::SpiderMonkey;
+use LWP::UserAgent;
+use XML::LibXML;
+use Time::HiRes qw/time/;
+use vars qw/%_paths/;
+
+sub DESTROY {
+	my $self = shift;
+	$logger->info("script_runner: destroying self: $self");
+}
+
+sub cleanup {
+	my $runner = shift;
+	$logger->info("script_runner: destroying context...");
+	$runner->context->destroy;
+	delete($$runner{$_}) for (keys %$runner);
+}
+
+sub new {
+	my $class = shift;
+	my %params = @_;
+	$class = ref($class) || $class;
+	$params{paths} ||= [];
+	$params{reset_count} ||= 0;
+
+	my $self = bless {	file => $params{file},
+				libs => $params{libs},
+				reset_count => $params{reset_count},
+				_runs => 0,
+				_path => {%_paths} } => $class;
+
+	$self->add_path($_) for @{$params{paths}};
+	return $self->init; 
+}
+
+sub context {
+	my( $self, $context ) = @_;
+	$self->{ctx} = $context if $context;
+	return $self->{ctx};
+}
+
+sub init {
+	my $self = shift;
+	$self->context( new JavaScript::SpiderMonkey );
+	$self->context->init();
+
+	$self->{_runs} = 0;
+
+	# eating our own dog food with insert
+	$self->insert(log_stdout	=> sub { print "@_\n"; } );
+	$self->insert(log_stderr	=> sub { warn "@_\n"; } );
+	$self->insert(log_activity	=> sub { $logger->activity("script_runner: @_"); return 1;} );
+	$self->insert(log_error		=> sub { $logger->error("script_runner: @_"); return 1;} );
+	$self->insert(log_warn		=> sub { $logger->warn("script_runner: @_"); return 1;} );
+	$self->insert(log_info		=> sub { $logger->info("script_runner: @_"); return 1;} );
+	$self->insert(log_debug		=> sub { $logger->debug("script_runner: @_"); return 1;} );
+	$self->insert(log_internal	=> sub { $logger->internal("script_runner: @_"); return 1;} );
+	$self->insert(debug		=> sub { $logger->debug("script_runner: @_"); return 1;} );
+	$self->insert(alert		=> sub { $logger->warn("script_runner: @_"); return 1;} );
+	$self->insert(load_lib		=> sub { $self->load_lib(@_); return 1;});
+
+	# OpenSRF support functions
+	$self->insert(
+		_OILS_FUNC_jsonopensrfrequest_send =>
+			sub { $self->_jsonopensrfrequest_send(@_); }
+	);
+	$self->insert(
+		_OILS_FUNC_jsonopensrfrequest_connect =>
+			sub { $self->_jsonopensrfrequest_connect(@_); }
+	);
+	$self->insert(
+		_OILS_FUNC_jsonopensrfrequest_disconnect =>
+			sub { $self->_jsonopensrfrequest_disconnect(@_); }
+	);
+	$self->insert(
+		_OILS_FUNC_jsonopensrfrequest_finish =>
+			sub { $self->_jsonopensrfrequest_finish(@_); }
+	);
+
+	# XML support functions
+	$self->insert(
+		_OILS_FUNC_xmlhttprequest_send	=>
+			sub { $self->_xmlhttprequest_send(@_); }
+	);
+	$self->insert(
+		_OILS_FUNC_xml_parse_string	=>
+			sub { $self->_parse_xml_string(@_); }
+	);
+	
+	while ( my $e = shift @{$self->{_env}} ) {
+		$self->insert( @$e{ qw/key value readonly/ } => 1 );
+	}
+
+	while ( my $e = shift @{$self->{_methods}} ) {
+		$self->insert_method( @$e{ qw/key name meth/ } => 1 );
+	}
+
+	$self->load_lib($_) for @{$self->{libs}};
+
+	return $self;
+}
+
+sub refresh_context {
+	my $self = shift;
+	$logger->debug("Refreshing JavaScript Context...");
+	$self->context->destroy;
+	$logger->debug("Context destroyed");
+	$self->{_loaded} = {};
+	$logger->debug("Loaded scripts removed");
+	$self->init;
+	$logger->debug("New Context initialized");
+	return $self;
+}
+
+sub load {
+	my( $self, $filename ) = @_;
+	$self->{file} = $filename;
+}
+
+sub runs { shift()->{_runs} }
+
+sub reset_count {
+	my $self = shift;
+	my $count = shift;
+
+	$self->{reset_count} = $count if ($count);
+	return $self->{reset_count};
+}
+
+sub run {
+	my $self = shift;
+	my $file = shift();
+
+	my $_real = 0;
+	if(!$file) {
+		$_real = 1;
+		$file = $self->{file};
+	}
+
+	$self->refresh_context
+		if ($self->reset_count && $self->runs > $self->reset_count);
+
+	$self->{_runs}++ if ($_real);
+
+	$file = $self->_find_file($file);
+	$logger->debug("full script file path: $file");
+
+	if( ! open(F, $file) ) {
+		$logger->error("Error opening script file: $file");
+		return 0;
+	}
+
+	my $js = $self->context;
+
+	my $res = '';
+	{	local $/ = undef;
+
+		$self->insert('environment.result' => {});
+
+		my $content = ;
+		#print ( "full script is [$content]" );
+
+		my $s = time();
+		if( !$js || !$content || !$js->eval($content) ) {
+			$logger->error("$file Eval failed: $@");  
+			return 0;
+		}
+		$logger->debug("eval of $file took ". sprintf('%0.3f', time - $s) . " seconds");
+
+		if ($_real) {
+			$self->insert('__' => {'OILS_RESULT' => ''});
+			$js->eval("__.OILS_RESULT = js2JSON(environment.result);");
+			$res = $self->retrieve('__.OILS_RESULT');
+		}
+	}
+
+	close(F);
+	$logger->debug( "script result is [$res]" );
+	return OpenSRF::Utils::JSON->JSON2perl( $res );
+}
+
+sub remove_path { 
+	my( $self, $path ) = @_;
+	if (ref($self)) {
+		if ($self->{_path}{$path}) {
+			$self->{_path}{$path} = 0;
+		}
+		return $self->{_path}{$path};
+	} else {
+		if ($_paths{$path}) {
+			$_paths{$path} = 0;
+		}
+		return $_paths{$path};
+	}
+}
+
+sub add_path { 
+	my( $self, $path ) = @_;
+	if (ref($self)) {
+		if (!$self->{_path}{$path}) {
+			$self->{_path}{$path} = 1;
+		}
+	} else {
+		if (!$_paths{$path}) {
+			$_paths{$path} = 1;
+		}
+	}
+	return $self;
+}
+
+sub _find_file {
+	my $self = shift;
+	my $file = shift;
+	for my $p ( keys %{ $self->{_path} } ) {
+		next unless ($self->{_path}{$p});
+		my $full = join('/',$p,$file);
+		return $full if (-e $full);
+	}
+}
+
+sub load_lib { 
+	my( $self, $file ) = @_;
+
+	my @paths = keys %{$self->{_path}};
+	$logger->debug("script_runner: Loading lib file $file : paths=[@paths]");
+
+	push @{ $self->{libs} }, $file
+		if (! grep {$_ eq $file} @{ $self->{libs} });
+
+	if (!$self->{_loaded}{$file}) {
+		$self->run( $file );
+		$self->{_loaded}{$file} = 1;
+	}
+	return $self->{_loaded}{$file};
+}
+
+sub _js_prop_name {
+	my $name = shift;
+	$name =~ s/^.*\.//o;
+	return $name;
+}
+
+sub retrieve {
+	my( $self, $key ) = @_;
+	return $self->context->property_get($key);
+}
+
+sub insert_method {
+	my( $self, $obj_key, $meth_name, $sub, $stop) = @_;
+
+	push @{$self->{_methods}}, { key => $obj_key => name => $meth_name, meth => $sub } unless ($stop);
+	
+	my $obj = $self->context->object_by_path( $obj_key );
+	$self->context->function_set( $meth_name, $sub, $obj ) if $obj;
+}
+
+
+sub insert {
+	my( $self, $key, $val, $RO, $stop ) = @_;
+	return unless defined($key);
+
+	push @{$self->{_env}}, { key => $key => value => $val, readonly => $RO } unless ($stop);
+
+	if (ref($val) =~ /^Fieldmapper/o) {
+		$self->insert_fm($key, $val, $RO);
+	} elsif (ref($val) and $val =~ /ARRAY/o) {
+		$self->insert_array($key, $val, $RO);
+	} elsif (ref($val) and $val =~ /HASH/o) {
+		$self->insert_hash($key, $val, $RO);
+	} elsif (ref($val) and $val =~ /CODE/o) {
+		$self->context->function_set( $key, $val );
+	} elsif (!ref($val)) {
+		if( defined($val) ) {
+			$self->context->property_by_path(
+				$key, $val,
+				( !$RO ?  (sub { $val }, sub { my( $k, $v ) = @_; $val = $v; }) : () )
+			);
+		} else {
+			$self->context->property_by_path($key, "");
+		}
+
+	} else {
+		return 0;
+	}
+
+	return 1;
+}
+
+sub insert_fm {
+
+	my( $self, $key, $fm, $RO ) = @_;
+	my $ctx = $self->context;
+	return undef unless ($ctx and $key and $fm);
+	my $o = $ctx->object_by_path($key);
+	
+	for my $f ( $fm->properties ) {
+		my $val = $fm->$f();
+		if (ref $val) {
+			$self->insert("$key.$f", $val);
+		} else {
+			$ctx->property_by_path(
+				"$key.$f",
+				$val,
+				( !$RO ? 
+					(sub {
+						my $k = _js_prop_name(shift());
+						$fm->$k();
+					}, 
+					sub {
+						my $k = _js_prop_name(shift());
+						$fm->ischanged(1);
+						$fm->$k(@_);
+					}) :
+					()
+				)
+			);
+		}
+	}
+}
+
+sub insert_hash {
+
+	my( $self, $key, $hash, $RO ) = @_;
+	my $ctx = $self->context;
+	return undef unless ($ctx and $key and $hash);
+	$ctx->object_by_path($key);
+	
+	for my $k ( keys %$hash ) {
+		my $v = $hash->{$k};
+		if (ref $v) {
+			$self->insert("$key.$k", $v);
+		} else {
+			$ctx->property_by_path(
+				"$key.$k", $v,
+				( !$RO ? 
+					(sub { $hash->{_js_prop_name(shift())} },
+					sub {
+						my( $hashkey, $val ) = @_;
+						$hash->{_js_prop_name($hashkey)} = $val;
+					}) :
+					()
+				)
+			);
+		}
+	}
+}
+
+my $__array_id = 0;
+sub insert_array {
+
+	my( $self, $key, $array ) = @_;
+	my $ctx = $self->context;
+	return undef unless ($ctx and $key and $array);
+
+	my $a = $ctx->array_by_path($key);
+	
+	my $ind = 0;
+	for my $v ( @$array ) {
+		if (ref $v) {
+			my $tmp_index = $__array_id++;
+			my $elobj = $ctx->object_by_path('__tmp_arr_el'.$tmp_index);
+			$self->insert('__tmp_arr_el'.$tmp_index, $v);
+			$ctx->array_set_element_as_object( $a, $ind, $elobj );
+		} else {
+			$ctx->array_set_element( $a, $ind, $v ) if defined($v);
+		}
+		$ind++;
+	}
+}
+
+sub _xmlhttprequest_send {
+	my $self = shift;
+	my $id = shift;
+	my $method = shift;
+	my $url = shift;
+	my $blocking = shift;
+	my $headerlist = shift;
+	my $data = shift;
+
+	my $ctx = $self->context;
+
+	# just so perl has access to it...
+	$ctx->object_by_path('__xmlhttpreq_hash.id'.$id);
+
+	my $headers = new HTTP::Headers;
+	my @lines = split(/\n/so, $headerlist);
+	for my $line (@lines) {
+		if ($line =~ /^(.+?)|(.+)$/o) {
+			$headers->header($1 => $2);
+		}
+	}
+
+	my $ua = LWP::UserAgent->new;
+	$ua->agent("OpenILS/0.1");
+
+	my $req = HTTP::Request->new($method => $url => $headers => $data);
+	my $res = $ua->request($req);
+
+	if ($res->is_success) {
+		
+		$ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.responseText', $res->content);
+		$ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.readyState', 4);
+		$ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.statusText', $res->status_line);
+		$ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.status', $res->code);
+
+	}
+		
+}
+
+our %_jsonopensrfrequest_cache = ();
+
+sub _jsonopensrfrequest_connect {
+	my $self = shift;
+	my $id = shift;
+	my $service = shift;
+
+	my $ctx = $self->context;
+	$ctx->object_by_path('__jsonopensrfreq_hash.id'.$id);
+
+	my $ses = $_jsonopensrfrequest_cache{$id} ||
+			do { $_jsonopensrfrequest_cache{$id} = OpenSRF::AppSession->create($service) };
+
+	if($ses->connect) {
+		$ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.connected', 1);
+	} else {
+		$ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.connected', 0);
+	}
+}
+
+sub _jsonopensrfrequest_disconnect {
+	my $self = shift;
+	my $id = shift;
+
+	my $ctx = $self->context;
+	$ctx->object_by_path('__jsonopensrfreq_hash.id'.$id);
+
+	my $ses = $_jsonopensrfrequest_cache{$id};
+	return unless $ses;
+
+	$ses->disconnect;
+}
+
+sub _jsonopensrfrequest_finish {
+	my $self = shift;
+	my $id = shift;
+
+	my $ctx = $self->context;
+	$ctx->object_by_path('__jsonopensrfreq_hash.id'.$id);
+
+	my $ses = $_jsonopensrfrequest_cache{$id};
+	return unless $ses;
+
+	$ses->finish;
+	delete $_jsonopensrfrequest_cache{$id};
+}
+
+sub _jsonopensrfrequest_send {
+	my $self = shift;
+	my $id = shift;
+	my $service = shift;
+	my $method = shift;
+	my $blocking = shift;
+	my $params = shift;
+
+	my @p = @{ OpenSRF::Utils::JSON->JSON2perl($params) };
+
+	my $ctx = $self->context;
+
+	# just so perl has access to it...
+	$ctx->object_by_path('__jsonopensrfreq_hash.id'.$id);
+
+	my $ses = $_jsonopensrfrequest_cache{$id} ||
+			do { $_jsonopensrfrequest_cache{$id} = OpenSRF::AppSession->create($service) };
+	my $req = $ses->request($method,@p);
+
+	$req->wait_complete;
+	if (!$req->failed) {
+		my $res = $req->recv->content;
+		
+		$ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.responseText', OpenSRF::Utils::JSON->perl2JSON($res));
+		$ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.readyState', 4);
+		$ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.statusText', 'OK');
+		$ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.status', '200');
+
+	} else {
+		$ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.responseText', '');
+		$ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.readyState', 4);
+		$ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.statusText', $req->failed->status );
+		$ctx->property_by_path('__jsonopensrfreq_hash.id'.$id.'.status', $req->failed->statusCode );
+	}
+
+	$req->finish;
+		
+}
+
+sub _parse_xml_string {
+	my $self = shift;
+	my $string = shift;
+	my $key = shift;
+
+
+	my $doc;
+	my $s = 0;
+	try {
+		$doc = XML::LibXML->new->parse_string( $string );
+		$s = 1;
+	} catch Error with {
+		my $e = shift;
+		warn "Could not parse document: $e\n";
+	};
+	return unless ($s);
+
+	_JS_DOM($self->context, $key, $doc);
+}
+
+sub _JS_DOM {
+	my $ctx = shift;
+	my $key = shift;
+	my $node = shift;
+
+	if ($node->nodeType == 9) {
+		$node = $node->documentElement;
+
+		my $n = $node->nodeName;
+		my $ns = $node->namespaceURI;
+		$ns =~ s/'/\'/gso if ($ns);
+		$ns = "'$ns'" if ($ns);
+		$ns = 'null' unless ($ns);
+		$n =~ s/'/\'/gso;
+
+		#warn("$key = DOMImplementation().createDocument($ns,'$n');");
+		$ctx->eval("$key = new DOMImplementation().createDocument($ns,'$n');");
+
+		$key = $key.'.documentElement';
+	}
+
+	for my $a ($node->attributes) {
+		my $n = $a->nodeName;
+		my $v = $a->value;
+		$n =~ s/'/\'/gso;
+		$v =~ s/'/\'/gso;
+		#warn("$key.setAttribute('$n','$v');");
+		$ctx->eval("$key.setAttribute('$n','$v');");
+
+	}
+
+	my $k = 0;
+	for my $c ($node->childNodes) {
+		if ($c->nodeType == 1) {
+			my $n = $c->nodeName;
+			my $ns = $node->namespaceURI;
+
+			$n =~ s/'/\'/gso;
+			$ns =~ s/'/\'/gso if ($ns);
+			$ns = "'$ns'" if ($ns);
+			$ns = 'null' unless ($ns);
+
+			#warn("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));");
+			$ctx->eval("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));");
+			_JS_DOM($ctx, "$key.childNodes.item($k)",$c);
+
+		} elsif ($c->nodeType == 3) {
+			my $n = $c->data;
+			$n =~ s/'/\'/gso;
+			#warn("$key.appendChild($key.ownerDocument.createTextNode('$n'));");
+			#warn("path is $key.item($k);");
+			$ctx->eval("$key.appendChild($key.ownerDocument.createTextNode('$n'));");
+
+		} elsif ($c->nodeType == 4) {
+			my $n = $c->data;
+			$n =~ s/'/\'/gso;
+			#warn("$key.appendChild($key.ownerDocument.createCDATASection('$n'));");
+			$ctx->eval("$key.appendChild($key.ownerDocument.createCDATASection('$n'));");
+
+		} elsif ($c->nodeType == 8) {
+			my $n = $c->data;
+			$n =~ s/'/\'/gso;
+			#warn("$key.appendChild($key.ownerDocument.createComment('$n'));");
+			$ctx->eval("$key.appendChild($key.ownerDocument.createComment('$n'));");
+
+		} else {
+			warn "ACK! I don't know how to handle node type ".$c->nodeType;
+		}
+		
+
+		$k++;
+	}
+
+	return 1;
+}
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/SpiderMonkey.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/SpiderMonkey.pm
new file mode 100644
index 0000000000..88d0a96beb
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/SpiderMonkey.pm
@@ -0,0 +1,401 @@
+package OpenILS::Utils::SpiderMonkey;
+use strict; use warnings;
+use OpenSRF::Utils::Logger qw(:logger);
+use OpenSRF::EX qw(:try);
+use OpenILS::Utils::ScriptRunner;
+use base 'OpenILS::Utils::ScriptRunner';
+use JavaScript::SpiderMonkey;
+use LWP::UserAgent;
+use XML::LibXML;
+use Time::HiRes qw/time/;
+use vars qw/%_paths/;
+
+sub new {
+	my ( $class, %params ) = @_;
+	$class = ref($class) || $class;
+	$params{paths} ||= [];
+
+	my $self = { file => $params{file}, libs => $params{libs}, _path => {%_paths} };
+	bless( $self, $class );
+
+	$self->add_path($_) for @{$params{paths}};
+	return $self;
+}
+
+sub context {
+	my( $self, $context ) = @_;
+	$self->{ctx} = $context if $context;
+	return $self->{ctx};
+}
+
+sub init {
+	my $self = shift;
+	my $js = JavaScript::SpiderMonkey->new();
+	$js->init();
+
+	$js->function_set(perl_print	=> sub { print "@_\n"; } );
+	$js->function_set(perl_warn	=> sub { warn @_; } );
+	$js->function_set(log_activity	=> sub { $logger->activity(@_); return 1;} );
+	$js->function_set(log_error	=> sub { $logger->error(@_); return 1;} );
+	$js->function_set(log_warn	=> sub { $logger->warn(@_); return 1;} );
+	$js->function_set(log_info	=> sub { $logger->info(@_); return 1;} );
+	$js->function_set(log_debug	=> sub { $logger->debug(@_); return 1;} );
+	$js->function_set(log_internal	=> sub { $logger->internal(@_); return 1;} );
+	$js->function_set(debug		=> sub { $logger->debug(@_); return 1;} );
+	$js->function_set(alert		=> sub { $logger->warn(@_); return 1;} );
+	
+	$js->function_set(load_lib	=> sub { $self->load_lib(@_); });
+
+	# XML support functions
+	$js->function_set(
+		_OILS_FUNC_xmlhttprequest_send	=> sub { $self->_xmlhttprequest_send(@_); });
+	$js->function_set(
+		_OILS_FUNC_xml_parse_string	=> sub { $self->_parse_xml_string(@_); });
+	
+	$self->context($js);
+	$self->load_lib($_) for @{$self->{libs}};
+
+	return $self;
+}
+
+
+sub load {
+	my( $self, $filename ) = @_;
+	$self->{file} = $filename;
+}
+
+sub run {
+	my $self = shift;
+	my $file = shift() || $self->{file};
+	my $js = $self->context;
+
+	$file = $self->_find_file($file);
+
+	if( ! open(F, $file) ) {
+		$logger->error("Error opening script file: $file");
+		return 0;
+	}
+
+	{	local $/ = undef;
+		my $content = ;
+		my $s = time();
+		if( !$js || !$content || !$js->eval($content) ) {
+			$logger->error("$file Eval failed: $@");  
+			return 0;
+		}
+		$logger->debug("eval of $file took ". sprintf('%0.3f', time - $s) . " seconds");
+	}
+
+	close(F);
+	return 1;
+}
+
+sub remove_path { 
+	my( $self, $path ) = @_;
+	if (ref($self)) {
+		if ($self->{_path}{$path}) {
+			$self->{_path}{$path} = 0;
+		}
+		return $self->{_path}{$path};
+	} else {
+		if ($_paths{$path}) {
+			$_paths{$path} = 0;
+		}
+		return $_paths{$path};
+	}
+}
+
+sub add_path { 
+	my( $self, $path ) = @_;
+	if (ref($self)) {
+		if (!$self->{_path}{$path}) {
+			$self->{_path}{$path} = 1;
+		}
+	} else {
+		if (!$_paths{$path}) {
+			$_paths{$path} = 1;
+		}
+	}
+	return $self;
+}
+
+sub _find_file {
+	my $self = shift;
+	my $file = shift;
+	for my $p ( keys %{ $self->{_path} } ) {
+		next unless ($self->{_path}{$p});
+		my $full = join('/',$p,$file);
+		return $full if (-e $full);
+	}
+}
+
+sub load_lib { 
+	my( $self, $file ) = @_;
+	if (!$self->{_loaded}{$file} && $self->run( $file )) {
+		$self->{_loaded}{$file} = 1;
+	}
+	return $self->{_loaded}{$file};
+}
+
+sub _js_prop_name {
+	my $name = shift;
+	$name =~ s/^.*\.//o;
+	return $name;
+}
+
+sub retrieve {
+	my( $self, $key ) = @_;
+	return $self->context->property_get($key);
+}
+
+sub insert_method {
+	my( $self, $obj_key, $meth_name, $sub ) = @_;
+	my $obj = $self->context->object_by_path( $obj_key );
+	$self->context->function_set( $meth_name, $sub, $obj ) if $obj;
+}
+
+
+sub insert {
+	my( $self, $key, $val ) = @_;
+	return unless defined($key);
+
+	if (ref($val) =~ /^Fieldmapper/o) {
+		$self->insert_fm($key, $val);
+	} elsif (ref($val) and $val =~ /ARRAY/o) {
+		$self->insert_array($key, $val);
+	} elsif (ref($val) and $val =~ /HASH/o) {
+		$self->insert_hash($key, $val);
+	} elsif (ref($val) and $val =~ /CODE/o) {
+		$self->context->function_set( $key, $val );
+	} elsif (!ref($val)) {
+		if( defined($val) ) {
+			$self->context->property_by_path(
+				$key, $val,
+				sub { $val },
+				sub { my( $k, $v ) = @_; $val = $v; }
+			);
+		} else {
+			$self->context->property_by_path($key);
+		}
+
+	} else {
+		return 0;
+	}
+
+	return 1;
+}
+
+sub insert_fm {
+
+	my( $self, $key, $fm ) = @_;
+	my $ctx = $self->context;
+	return undef unless ($ctx and $key and $fm);
+	my $o = $ctx->object_by_path($key);
+	
+	for my $f ( $fm->properties ) {
+		my $val = $fm->$f();
+		if (ref $val) {
+			$self->insert("$key.$f", $val);
+		} else {
+			$ctx->property_by_path(
+				"$key.$f",
+				$val,
+				sub {
+					my $k = _js_prop_name(shift());
+					$fm->$k();
+				}, 
+
+				sub {
+					my $k = _js_prop_name(shift());
+					$fm->ischanged(1);
+					$fm->$k(@_);
+				}
+			);
+		}
+	}
+}
+
+sub insert_hash {
+
+	my( $self, $key, $hash ) = @_;
+	my $ctx = $self->context;
+	return undef unless ($ctx and $key and $hash);
+	$ctx->object_by_path($key);
+	
+	for my $k ( keys %$hash ) {
+		my $v = $hash->{$k};
+		if (ref $v) {
+			$self->insert("$key.$k", $v);
+		} else {
+			$ctx->property_by_path(
+				"$key.$k", $v,
+				sub { $hash->{_js_prop_name(shift())} },
+				sub { 
+					my( $key, $val ) = @_;
+					$hash->{_js_prop_name($key)} = $val; }
+			);
+		}
+	}
+}
+
+my $__array_id = 0;
+sub insert_array {
+
+	my( $self, $key, $array ) = @_;
+	my $ctx = $self->context;
+	return undef unless ($ctx and $key and $array);
+
+	my $a = $ctx->array_by_path($key);
+	
+	my $ind = 0;
+	for my $v ( @$array ) {
+		if (ref $v) {
+			my $elobj = $ctx->object_by_path('__tmp_arr_el'.$__array_id);
+			$self->insert('__tmp_arr_el'.$__array_id, $v);
+			$ctx->array_set_element_as_object( $a, $ind, $elobj );
+			$__array_id++;
+		} else {
+			$ctx->array_set_element( $a, $ind, $v ) if defined($v);
+		}
+		$ind++;
+	}
+}
+
+sub _xmlhttprequest_send {
+	my $self = shift;
+	my $id = shift;
+	my $method = shift;
+	my $url = shift;
+	my $blocking = shift;
+	my $headerlist = shift;
+	my $data = shift;
+
+	my $ctx = $self->context;
+
+	# just so perl has access to it...
+	$ctx->object_by_path('__xmlhttpreq_hash.id'.$id);
+
+	my $headers = new HTTP::Headers;
+	my @lines = split(/\n/so, $headerlist);
+	for my $line (@lines) {
+		if ($line =~ /^(.+?)|(.+)$/o) {
+			$headers->header($1 => $2);
+		}
+	}
+
+	my $ua = LWP::UserAgent->new;
+	$ua->agent("OpenILS/0.1");
+
+	my $req = HTTP::Request->new($method => $url => $headers => $data);
+	my $res = $ua->request($req);
+
+	if ($res->is_success) {
+		
+		$ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.responseText', $res->content);
+		$ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.readyState', 4);
+		$ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.statusText', $res->status_line);
+		$ctx->property_by_path('__xmlhttpreq_hash.id'.$id.'.status', $res->code);
+
+	}
+		
+}
+
+sub _parse_xml_string {
+	my $self = shift;
+	my $string = shift;
+	my $key = shift;
+
+
+	my $doc;
+	my $s = 0;
+	try {
+		$doc = XML::LibXML->new->parse_string( $string );
+		$s = 1;
+	} catch Error with {
+		my $e = shift;
+		warn "Could not parse document: $e\n";
+	};
+	return unless ($s);
+
+	_JS_DOM($self->context, $key, $doc);
+}
+
+sub _JS_DOM {
+	my $ctx = shift;
+	my $key = shift;
+	my $node = shift;
+
+	if ($node->nodeType == 9) {
+		$node = $node->documentElement;
+
+		my $n = $node->nodeName;
+		my $ns = $node->namespaceURI;
+		$ns =~ s/'/\'/gso if ($ns);
+		$ns = "'$ns'" if ($ns);
+		$ns = 'null' unless ($ns);
+		$n =~ s/'/\'/gso;
+
+		#warn("$key = DOMImplementation().createDocument($ns,'$n');");
+		$ctx->eval("$key = new DOMImplementation().createDocument($ns,'$n');");
+
+		$key = $key.'.documentElement';
+	}
+
+	for my $a ($node->attributes) {
+		my $n = $a->nodeName;
+		my $v = $a->value;
+		$n =~ s/'/\'/gso;
+		$v =~ s/'/\'/gso;
+		#warn("$key.setAttribute('$n','$v');");
+		$ctx->eval("$key.setAttribute('$n','$v');");
+
+	}
+
+	my $k = 0;
+	for my $c ($node->childNodes) {
+		if ($c->nodeType == 1) {
+			my $n = $c->nodeName;
+			my $ns = $node->namespaceURI;
+
+			$n =~ s/'/\'/gso;
+			$ns =~ s/'/\'/gso if ($ns);
+			$ns = "'$ns'" if ($ns);
+			$ns = 'null' unless ($ns);
+
+			#warn("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));");
+			$ctx->eval("$key.appendChild($key.ownerDocument.createElementNS($ns,'$n'));");
+			_JS_DOM($ctx, "$key.childNodes.item($k)",$c);
+
+		} elsif ($c->nodeType == 3) {
+			my $n = $c->data;
+			$n =~ s/'/\'/gso;
+			#warn("$key.appendChild($key.ownerDocument.createTextNode('$n'));");
+			#warn("path is $key.item($k);");
+			$ctx->eval("$key.appendChild($key.ownerDocument.createTextNode('$n'));");
+
+		} elsif ($c->nodeType == 4) {
+			my $n = $c->data;
+			$n =~ s/'/\'/gso;
+			#warn("$key.appendChild($key.ownerDocument.createCDATASection('$n'));");
+			$ctx->eval("$key.appendChild($key.ownerDocument.createCDATASection('$n'));");
+
+		} elsif ($c->nodeType == 8) {
+			my $n = $c->data;
+			$n =~ s/'/\'/gso;
+			#warn("$key.appendChild($key.ownerDocument.createComment('$n'));");
+			$ctx->eval("$key.appendChild($key.ownerDocument.createComment('$n'));");
+
+		} else {
+			warn "ACK! I don't know how to handle node type ".$c->nodeType;
+		}
+		
+
+		$k++;
+	}
+
+	return 1;
+}
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/ZClient.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/ZClient.pm
new file mode 100644
index 0000000000..10080de1a3
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/ZClient.pm
@@ -0,0 +1,169 @@
+package OpenILS::Utils::ZClient;
+use UNIVERSAL::require;
+
+sub DESTROY {};
+
+use overload 'bool' => sub { return $_[0]->{connection} ? 1 : 0 };
+
+sub EVENT_NONE { 0 }
+sub EVENT_CONNECT { 1 }
+sub EVENT_SEND_DATA { 2 }
+sub EVENT_RECV_DATA { 3 }
+sub EVENT_TIMEOUT { 4 }
+sub EVENT_UNKNOWN { 5 }
+sub EVENT_SEND_APDU { 6 }
+sub EVENT_RECV_APDU { 7 }
+sub EVENT_RECV_RECORD { 8 }
+sub EVENT_RECV_SEARCH { 9 }
+sub EVENT_END { 10 }
+
+our $conn_class = 'ZOOM::Connection';
+our $imp_class = 'ZOOM';
+our $AUTOLOAD;
+
+# Detect the installed z client, prefering ZOOM.
+if (!$imp_class->use()) {
+
+	$imp_class = 'Net::Z3950';  # Try Net::Z3950
+	if ($imp_class->use()) {
+
+		# Tell 'new' how to build the connection
+		$conn_class = 'Net::Z3950::Connection';
+		
+	} else {
+		die "Cannot load a z39.50 client implementation!  Please install either ZOOM or Net::Z3950.\n";
+	}
+}
+
+# 'new' is called thusly:
+#  my $conn = OpenILS::Utils::ZClient->new( $host, $port, databaseName => $db, user => $username )
+
+sub new {
+	my $class = shift();
+	my @args = @_;
+
+	if ($class ne __PACKAGE__) { # NOT called OO-ishly
+		# put the first param back if called like OpenILS::Utils::ZClient::new()
+		unshift @args, $class;
+	}
+
+	return bless { connection => $conn_class->new(@_) } => __PACKAGE__;
+}
+
+sub search {
+	my $self = shift;
+	my $r =  $imp_class eq 'Net::Z3950' ?
+		$self->{connection}->search( @_ ) :
+		$self->{connection}->search_pqf( @_ );
+
+	return OpenILS::Utils::ZClient::ResultSet->new( $r );
+}
+
+sub event {
+	my $list = shift;
+	if ($imp_class eq 'Net::Z3950') {
+		if (defined $$list[0]{_async_index}) {	
+			return 0 if ($$list[0]{_async_index} == @$list);
+			return ++$$list[0]{_async_index};
+		} else {
+			return $$list[0]{_async_index} = 1;
+		}
+	}
+
+	return ZOOM::event([map { ($_->{connection}) } @$list]);
+}
+
+*{__PACKAGE__ . '::search_pqf'} = \&search; 
+
+sub AUTOLOAD {
+	my $self = shift;
+
+	my $method = $AUTOLOAD;
+	$method =~ s/.*://;   # strip fully-qualified portion
+
+	return $self->{connection}->$method( @_ );
+}
+
+#-------------------------------------------------------------------------------
+package OpenILS::Utils::ZClient::ResultSet;
+
+sub DESTROY {};
+our $AUTOLOAD;
+
+sub new {
+	my $class = shift;
+	my @args = @_;
+
+	if ($class ne __PACKAGE__) { # NOT called OO-ishly
+		# put the first param back if called like OpenILS::Utils::ZClient::ResultSet::new()
+		unshift @args, $class;
+	}
+
+
+	return bless { result => $args[0] } => __PACKAGE__;
+}
+
+sub record {
+	my $self = shift;
+	my $offset = shift;
+	my $r = $imp_class eq 'Net::Z3950' ?
+		$self->{result}->record( ++$offset ) :
+		$self->{result}->record( $offset );
+
+	return  OpenILS::Utils::ZClient::Record->new( $r );
+}
+
+sub last_event {
+	my $self = shift;
+	return OpenILS::Utils::ZClient::EVENT_END() if ($imp_class eq 'Net::Z3950');
+	$self->{result}->last_event();
+}
+
+sub AUTOLOAD {
+	my $self = shift;
+
+	my $method = $AUTOLOAD;
+	$method =~ s/.*://;   # strip fully-qualified portion
+
+	return $self->{result}->$method( @_ );
+}
+
+#-------------------------------------------------------------------------------
+package OpenILS::Utils::ZClient::Record;
+
+sub DESTROY {};
+our $AUTOLOAD;
+
+sub new {
+	my $class = shift;
+	my @args = @_;
+
+	if ($class ne __PACKAGE__) { # NOT called OO-ishly
+		# put the first param back if called like OpenILS::Utils::ZClient::ResultSet::new()
+		unshift @args, $class;
+	}
+
+
+	return bless { record => shift() } => __PACKAGE__;
+}
+
+sub rawdata {
+	my $self = shift;
+	return $OpenILS::Utils::ZClient::imp_class eq 'Net::Z3950' ?
+		$self->{record}->rawdata( @_ ) :
+		$self->{record}->raw( @_ );
+}
+
+*{__PACKAGE__ . '::raw'} = \&rawdata; 
+
+sub AUTOLOAD {
+	my $self = shift;
+
+	my $method = $AUTOLOAD;
+	$method =~ s/.*://;   # strip fully-qualified portion
+
+	return $self->{record}->$method( @_ );
+}
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent.pm
new file mode 100644
index 0000000000..f4c816b2dc
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent.pm
@@ -0,0 +1,202 @@
+package OpenILS::WWW::AddedContent;
+use strict; use warnings;
+
+use lib qw(/usr/lib/perl5/Bundle/);
+
+use CGI;
+use Apache2::Log;
+use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::RequestUtil;
+use Data::Dumper;
+use UNIVERSAL::require;
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::Utils::Cache;
+use OpenSRF::System;
+use OpenSRF::Utils::Logger qw/$logger/;
+
+use LWP::UserAgent;
+use MIME::Base64;
+
+my $AC = __PACKAGE__;
+
+
+# set the bootstrap config when this module is loaded
+my $bs_config;
+
+sub import {
+    my $self = shift;
+    $bs_config = shift;
+}
+
+
+my $handler; # added content handler class handle
+my $cache; # memcache handle
+my $net_timeout; # max seconds to wait for a response from the added content vendor
+my $max_errors; # max consecutive lookup failures before added content is temporarily disabled
+my $error_countdown; # current consecutive errors countdown
+
+# number of seconds to wait before next lookup 
+# is attempted after lookups have been disabled
+my $error_retry_timeout;
+
+
+sub child_init {
+
+    OpenSRF::System->bootstrap_client( config_file => $bs_config );
+    $cache = OpenSRF::Utils::Cache->new;
+
+    my $sclient = OpenSRF::Utils::SettingsClient->new();
+    my $ac_data = $sclient->config_value("added_content");
+
+    return unless $ac_data;
+    my $ac_handler = $ac_data->{module};
+    return unless $ac_handler;
+
+    $net_timeout = $ac_data->{timeout} || 1;
+    $error_countdown = $max_errors = $ac_data->{max_errors} || 10;
+    $error_retry_timeout = $ac_data->{retry_timeout} || 600;
+
+    $logger->debug("Attempting to load Added Content handler: $ac_handler");
+
+    $ac_handler->use;
+
+    if($@) {    
+        $logger->error("Unable to load Added Content handler [$ac_handler]: $@"); 
+        return; 
+    }
+
+    $handler = $ac_handler->new($ac_data);
+    $logger->debug("added content loaded handler: $handler");
+}
+
+
+sub handler {
+
+    my $r   = shift;
+    return Apache2::Const::DECLINED if (-e $r->filename);
+
+    my $cgi = CGI->new;
+    my $path = $r->path_info;
+    my $res;
+
+    my( undef, $type, $format, $key ) = split(/\//, $r->path_info);
+
+    child_init() unless $handler;
+
+    return Apache2::Const::NOT_FOUND unless $handler and $type and $format and $key;
+
+    my $err;
+    my $data;
+    my $method = "${type}_${format}";
+
+    return Apache2::Const::NOT_FOUND unless $handler->can($method);
+    return $res if defined($res = $AC->serve_from_cache($type, $format, $key));
+    return Apache2::Const::NOT_FOUND unless $AC->lookups_enabled;
+
+    try {
+        $data = $handler->$method($key);
+    } catch Error with { 
+        $err = shift; 
+        decr_error_countdown();
+        $logger->debug("added content handler failed: $method($key) => $err");
+    };
+
+    return Apache2::Const::NOT_FOUND if $err;
+
+    if(!$data) {
+        # if the AC lookup found no corresponding data, cache that information
+        $logger->debug("added content handler returned no results $method($key)") unless $data;
+        $AC->cache_result($type, $format, $key, {nocontent=>1});
+        return Apache2::Const::NOT_FOUND;
+    }
+    
+    $AC->print_content($data);
+    $AC->cache_result($type, $format, $key, $data);
+
+    reset_error_countdown();
+    return Apache2::Const::OK;
+}
+
+sub print_content {
+    my($class, $data, $from_cache) = @_;
+    return Apache2::Const::NOT_FOUND if $data->{nocontent};
+
+    my $ct = $data->{content_type};
+    my $content = $data->{content};
+    print "Content-type: $ct\n\n";
+
+    if($data->{binary}) {
+        binmode STDOUT;
+        # if it hasn't been cached yet, it's still in binary form
+        print( ($from_cache) ? decode_base64($content) : $content );
+    } else {
+        print $content;
+    }
+
+
+    return Apache2::Const::OK;
+}
+
+
+
+
+# returns an HTPP::Response object
+sub get_url {
+    my( $self, $url ) = @_;
+
+    $logger->info("added content getting [timeout=$net_timeout, errors_remaining=$error_countdown] URL = $url");
+    my $agent = LWP::UserAgent->new(timeout => $net_timeout);
+
+    my $res = $agent->get($url); 
+    $logger->info("added content request returned with code " . $res->code);
+    die "added content request failed: " . $res->status_line ."\n" unless $res->is_success;
+
+    return $res;
+}
+
+sub lookups_enabled {
+    if( $cache->get_cache('ac.no_lookup') ) {
+        $logger->info("added content lookup disabled");
+        return undef;
+    }
+    return 1;
+}
+
+sub disable_lookups {
+    $cache->put_cache('ac.no_lookup', 1, $error_retry_timeout);
+}
+
+sub decr_error_countdown {
+    $error_countdown--;
+    if($error_countdown < 1) {
+        $logger->warn("added content error count exhausted.  Disabling lookups for $error_retry_timeout seconds");
+        $AC->disable_lookups;
+    }
+}
+
+sub reset_error_countdown {
+    $error_countdown = $max_errors;
+}
+
+sub cache_result {
+    my($class, $type, $format, $key, $data) = @_;
+    $logger->debug("caching $type/$format/$key");
+    $data->{content} = encode_base64($data->{content}) if $data->{binary};
+    return $cache->put_cache("ac.$type.$format.$key", $data);
+}
+
+sub serve_from_cache {
+    my($class, $type, $format, $key) = @_;
+    my $data = $cache->get_cache("ac.$type.$format.$key");
+    return undef unless $data;
+    $logger->debug("serving $type/$format/$key from cache");
+    return $class->print_content($data, 1);
+}
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent/Amazon.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent/Amazon.pm
new file mode 100644
index 0000000000..77c6bef531
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent/Amazon.pm
@@ -0,0 +1,75 @@
+package OpenILS::WWW::AddedContent::Amazon;
+use strict; use warnings;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenSRF::Utils::SettingsParser;
+use OpenILS::WWW::AddedContent;
+use OpenSRF::Utils::JSON;
+use OpenSRF::EX qw/:try/;
+use XML::LibXML;
+
+my $AC = 'OpenILS::WWW::AddedContent';
+
+sub new {
+    my( $class, $args ) = @_;
+    $class = ref $class || $class;
+    return bless($args, $class);
+}
+
+sub base_url {
+    my $self = shift;
+    return $self->{base_url};
+}
+
+sub userid {
+    my $self = shift;
+    return $self->{userid};
+}
+
+
+# --------------------------------------------------------------------------
+sub jacket_small {
+    my( $self, $key ) = @_;
+    return $self->send_img(
+        $self->fetch_response('_SCMZZZZZZZ_.jpg', $key));
+}
+
+sub jacket_medium {
+    my( $self, $key ) = @_;
+    return $self->send_img(
+        $self->fetch_response('_SCMZZZZZZZ_.jpg', $key));
+
+}
+sub jacket_large {
+    my( $self, $key ) = @_;
+    return $self->send_img(
+        $self->fetch_response('_SCZZZZZZZ_.jpg', $key));
+}
+
+# --------------------------------------------------------------------------
+
+sub send_img {
+    my($self, $response) = @_;
+    return { 
+        content_type => $response->header('Content-type'),
+        content => $response->content, 
+        binary => 1 
+    };
+}
+
+# returns the raw content returned from the URL fetch
+sub fetch_content {
+    my( $self, $page, $key ) = @_;
+    return $self->fetch_response($page, $key)->content;
+}
+
+# returns the HTTP response object from the URL fetch
+sub fetch_response {
+    my( $self, $page, $key ) = @_;
+    my $uname = $self->userid;
+    my $url = $self->base_url . "$key.01.$page";
+    return $AC->get_url($url);
+}
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent/ContentCafe.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent/ContentCafe.pm
new file mode 100644
index 0000000000..c6e7f4ff8f
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent/ContentCafe.pm
@@ -0,0 +1,299 @@
+package OpenILS::WWW::AddedContent::ContentCafe;
+use strict; use warnings;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenSRF::Utils::SettingsParser;
+use OpenSRF::Utils::JSON;
+use OpenSRF::EX qw/:try/;
+use OpenILS::WWW::AddedContent;
+use XML::LibXML;
+use MIME::Base64;
+
+my $AC = 'OpenILS::WWW::AddedContent';
+
+my $base_url = 'http://contentcafe2.btol.com/ContentCafe/ContentCafe.asmx/Single';
+my $cover_base_url = 'http://contentcafe2.btol.com/ContentCafe/Jacket.aspx';
+
+sub new {
+    my( $class, $args ) = @_;
+    $class = ref $class || $class;
+    return bless($args, $class);
+}
+
+sub userid {
+    my $self = shift;
+    return $self->{ContentCafe}->{userid};
+}
+
+sub password {
+    my $self = shift;
+    return $self->{ContentCafe}->{password};
+}
+
+sub return_behavior_on_no_jacket_image {
+    my $self = shift;
+    return $self->{ContentCafe}->{return_behavior_on_no_jacket_image};
+}
+
+# --------------------------------------------------------------------------
+sub jacket_small {
+    my( $self, $key ) = @_;
+    return $self->send_img(
+        $self->fetch_cover_response('S', $key));
+}
+
+sub jacket_medium {
+    my( $self, $key ) = @_;
+    return $self->send_img(
+        $self->fetch_cover_response('M', $key));
+
+}
+sub jacket_large {
+    my( $self, $key ) = @_;
+    return $self->send_img(
+        $self->fetch_cover_response('L', $key));
+}
+
+# --------------------------------------------------------------------------
+
+sub toc_html {
+    my( $self, $key ) = @_;
+    my $xml = $self->fetch_content('TocDetail', $key);
+    my $doc = XML::LibXML->new->parse_string($xml);
+    $doc->documentElement->setNamespace('http://ContentCafe2.btol.com', 'cc');
+    my $html = '';
+    my @nodes = $doc->findnodes('//cc:Toc');
+    return 0 if (scalar(@nodes) < 1);
+    foreach my $node ( @nodes ) {
+        $html .= $node->textContent . '
';
+    }
+    return $self->send_html($html);
+}
+
+sub toc_xml {
+    my( $self, $key ) = @_;
+    return $self->send_xml(
+        $self->fetch_content('TocDetail', $key));
+}
+
+sub toc_json {
+    my( $self, $key ) = @_;
+    return $self->send_json(
+        $self->fetch_content('TocDetail', $key));
+}
+
+# --------------------------------------------------------------------------
+
+sub anotes_html {
+    my( $self, $key ) = @_;
+    my $xml = $self->fetch_content('BiographyDetail', $key);
+    my $doc = XML::LibXML->new->parse_string($xml);
+    $doc->documentElement->setNamespace('http://ContentCafe2.btol.com', 'cc');
+    my $html = '';
+    my @nodes = $doc->findnodes('//cc:Biography');
+    return 0 if (scalar(@nodes) < 1);
+    foreach my $node ( @nodes ) {
+        $html .= '
' . $node->textContent . '
';
+    }
+    return $self->send_html($html);
+}
+
+sub anotes_xml {
+    my( $self, $key ) = @_;
+    return $self->send_xml(
+        $self->fetch_content('BiographyDetail', $key));
+}
+
+sub anotes_json {
+    my( $self, $key ) = @_;
+    return $self->send_json(
+        $self->fetch_content('BiographyDetail', $key));
+}
+
+
+# --------------------------------------------------------------------------
+
+sub excerpt_html {
+    my( $self, $key ) = @_;
+    my $xml = $self->fetch_content('ExcerptDetail', $key);
+    my $doc = XML::LibXML->new->parse_string($xml);
+    $doc->documentElement->setNamespace('http://ContentCafe2.btol.com', 'cc');
+    my $html = '';
+    my @nodes = $doc->findnodes('//cc:Excerpt');
+    return 0 if (scalar(@nodes) < 1);
+    foreach my $node ( @nodes ) {
+        $html .= $node->textContent;
+    }
+    return $self->send_html($html);
+}
+
+sub excerpt_xml {
+    my( $self, $key ) = @_;
+    return $self->send_xml(
+        $self->fetch_content('ExcerptDetail', $key));
+}
+
+sub excerpt_json {
+    my( $self, $key ) = @_;
+    return $self->send_json(
+        $self->fetch_content('ExcerptDetail', $key));
+}
+
+# --------------------------------------------------------------------------
+
+sub reviews_html {
+    my( $self, $key ) = @_;
+    my $xml = $self->fetch_content('ReviewDetail', $key);
+    my $doc = XML::LibXML->new->parse_string($xml);
+    $doc->documentElement->setNamespace('http://ContentCafe2.btol.com', 'cc');
+    my $html = '
    ';
+    my @nodes = $doc->findnodes('//cc:ReviewItem');
+    return 0 if (scalar(@nodes) < 1);
+    foreach my $node ( @nodes ) {
+        my @s_nodes = $node->findnodes('./cc:Supplier');
+        my @p_nodes = $node->findnodes('./cc:Publication');
+        my @i_nodes = $node->findnodes('./cc:Issue');
+        my @r_nodes = $node->findnodes('./cc:Review');
+        $html .= '
  • ' . (scalar(@p_nodes) ? $p_nodes[0]->textContent : '') . '';
+        if (scalar(@i_nodes) && scalar(@p_nodes)) { $html .= ' : '; }
+        $html .= (scalar(@i_nodes) ? $i_nodes[0]->textContent : '') . '
    ';
+        $html .= (scalar(@r_nodes) ? $r_nodes[0]->textContent : '') . '
    • ';
+    }
+    $html .= '
';
+    return $self->send_html($html);
+}
+
+sub reviews_xml {
+    my( $self, $key ) = @_;
+    return $self->send_xml(
+        $self->fetch_content('ReviewDetail', $key));
+}
+
+sub reviews_json {
+    my( $self, $key ) = @_;
+    return $self->send_json(
+        $self->fetch_content('ReviewDetail', $key));
+}
+
+# --------------------------------------------------------------------------
+
+sub summary_html {
+    my( $self, $key ) = @_;
+    my $xml = $self->fetch_content('AnnotationDetail', $key);
+    my $doc = XML::LibXML->new->parse_string($xml);
+    $doc->documentElement->setNamespace('http://ContentCafe2.btol.com', 'cc');
+    my $html = '
    ';
+    my @nodes = $doc->findnodes('//cc:AnnotationItem');
+    return 0 if (scalar(@nodes) < 1);
+    foreach my $node ( @nodes ) {
+        my @s_nodes = $node->findnodes('./cc:Supplier');
+        my @a_nodes = $node->findnodes('./cc:Annotation');
+        $html .= '
  • ' . (scalar(@s_nodes) ? $s_nodes[0]->textContent : '') . '
    ';
+        $html .= (scalar(@a_nodes) ? $a_nodes[0]->textContent : '') . '
    • ';
+    }
+    $html .= '
';
+    return $self->send_html($html);
+}
+
+sub summary_xml {
+    my( $self, $key ) = @_;
+    return $self->send_xml(
+        $self->fetch_content('AnnotationDetail', $key));
+}
+
+sub summary_json {
+    my( $self, $key ) = @_;
+    return $self->send_json(
+        $self->fetch_content('AnnotationDetail', $key));
+}
+
+
+# --------------------------------------------------------------------------
+
+
+sub data_exists {
+    my( $self, $data ) = @_;
+    return 0 if $data =~ m/error<\/title>/iog;
+    return 1;
+}
+
+
+sub send_json {
+    my( $self, $xml ) = @_;
+    return 0 unless $self->data_exists($xml);
+    my $doc;
+
+    try {
+        $doc = XML::LibXML->new->parse_string($xml);
+    } catch Error with {
+        my $err = shift;
+        $logger->error("added content XML parser error: $err\n\n$xml");
+        $doc = undef;
+    };
+
+    return 0 unless $doc;
+    my $perl = OpenSRF::Utils::SettingsParser::XML2perl($doc->documentElement);
+    my $json = OpenSRF::Utils::JSON->perl2JSON($perl);
+    return { content_type => 'text/plain', content => $json };
+}
+
+sub send_xml {
+    my( $self, $xml ) = @_;
+    return 0 unless $self->data_exists($xml);
+    return { content_type => 'application/xml', content => $xml };
+}
+
+sub send_html {
+    my( $self, $content ) = @_;
+    return 0 unless $self->data_exists($content);
+
+    # Hide anything that might contain a link since it will be broken
+    my $HTML = <<"    HTML";
+        <div>
+            <style type='text/css'>
+                div.ac input, div.ac a[href],div.ac img, div.ac button { display: none; visibility: hidden }
+            </style>
+            <div class='ac'>
+                $content
+            </div>
+        </div>
+    HTML
+
+    return { content_type => 'text/html', content => $HTML };
+}
+
+sub send_img {
+    my($self, $response) = @_;
+    return { 
+        content_type => $response->header('Content-type'),
+        content => $response->content, 
+        binary => 1 
+    };
+}
+
+# returns the raw content returned from the URL fetch
+sub fetch_content {
+    my( $self, $contentType, $key ) = @_;
+    return $self->fetch_response($contentType, $key)->content;
+}
+
+# returns the HTTP response object from the URL fetch
+sub fetch_response {
+    my( $self, $contentType, $key ) = @_;
+    my $userid = $self->userid;
+    my $password = $self->password;
+    my $url = $base_url . "?UserID=$userid&Password=$password&Key=$key&Content=$contentType";
+    return $AC->get_url($url);
+}
+
+# returns the HTTP response object from the URL fetch
+sub fetch_cover_response {
+    my( $self, $size, $key ) = @_;
+    my $userid = $self->userid;
+    my $password = $self->password;
+    my $return = $self->return_behavior_on_no_jacket_image;
+    my $url = $cover_base_url . "?UserID=$userid&Password=$password&Return=$return&Type=$size&Value=$key";
+    return $AC->get_url($url);
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent/OpenLibrary.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent/OpenLibrary.pm
new file mode 100644
index 0000000000..634fdc7560
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent/OpenLibrary.pm
@@ -0,0 +1,185 @@
+# ---------------------------------------------------------------
+# Copyright (C) 2009 David Christensen <david.a.christensen@gmail.com>
+# Copyright (C) 2009 Dan Scott <dscott@laurentian.ca>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# ---------------------------------------------------------------
+
+package OpenILS::WWW::AddedContent::OpenLibrary;
+use strict; use warnings;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenSRF::Utils::SettingsParser;
+use OpenILS::WWW::AddedContent;
+use OpenSRF::Utils::JSON;
+use OpenSRF::EX qw/:try/;
+use Data::Dumper;
+
+# Edit the <added_content> section of /openils/conf/opensrf.xml
+# Change <module> to:
+#   <module>OpenILS::WWW::AddedContent::OpenLibrary</module>
+
+my $AC = 'OpenILS::WWW::AddedContent';
+
+# These URLs are always the same for OpenLibrary, so there's no advantage to
+# pulling from opensrf.xml; we hardcode them here
+my $base_url = 'http://openlibrary.org/api/books?details=true&bibkeys=ISBN:';
+my $cover_base_url = 'http://covers.openlibrary.org/b/isbn/';
+
+sub new {
+    my( $class, $args ) = @_;
+    $class = ref $class || $class;
+    return bless($args, $class);
+}
+
+# --------------------------------------------------------------------------
+sub jacket_small {
+    my( $self, $key ) = @_;
+    return $self->send_img(
+        $self->fetch_cover_response('-S.jpg', $key));
+}
+
+sub jacket_medium {
+    my( $self, $key ) = @_;
+    return $self->send_img(
+        $self->fetch_cover_response('-M.jpg', $key));
+
+}
+sub jacket_large {
+    my( $self, $key ) = @_;
+    return $self->send_img(
+        $self->fetch_cover_response('-L.jpg', $key));
+}
+
+# --------------------------------------------------------------------------
+
+=head1
+
+OpenLibrary returns a JSON hash of zero or more book responses matching our
+request. Each response may contain a table of contents within the details
+section of the response.
+
+For now, we check only the first response in the hash for a table of
+contents, and if we find a table of contents, we transform it to a simple
+HTML table.
+
+=cut
+
+sub toc_html {
+    my( $self, $key ) = @_;
+    my $book_details_json = $self->fetch_response($key)->content();
+
+
+    # Trim the "var _OlBookInfo = " declaration that makes this
+    # invalid JSON
+    $book_details_json =~ s/^.+?({.*?});$/$1/s;
+
+    $logger->debug("$key: " . $book_details_json);
+
+    my $toc_html;
+    
+    my $book_details = OpenSRF::Utils::JSON->JSON2perl($book_details_json);
+    my $book_key = (keys %$book_details)[0];
+
+    # We didn't find a matching book; short-circuit our response
+    if (!$book_key) {
+        $logger->debug("$key: no found book");
+        return 0;
+    }
+
+    my $toc_json = $book_details->{$book_key}->{details}->{table_of_contents};
+
+    # No table of contents is available for this book; short-circuit
+    if (!$toc_json or !scalar(@$toc_json)) {
+        $logger->debug("$key: no TOC");
+        return 0;
+    }
+
+    # Build a basic HTML table containing the section number, section title,
+    # and page number. Some rows may not contain section numbers, we should
+    # protect against empty page numbers too.
+    foreach my $chapter (@$toc_json) {
+	my $label = $chapter->{label};
+        if ($label) {
+            $label .= '. ';
+        }
+        my $title = $chapter->{title} || '';
+        my $page_number = $chapter->{pagenum} || '';
+ 
+        $toc_html .= '<tr>' .
+            "<td style='text-align: right;'>$label</td>" .
+            "<td style='text-align: left; padding-right: 2em;'>$title</td>" .
+            "<td style='text-align: right;'>$page_number</td>" .
+            "</tr>\n";
+    }
+
+    $logger->debug("$key: $toc_html");
+    $self->send_html("<table>$toc_html</table>");
+}
+
+sub toc_json {
+    my( $self, $key ) = @_;
+    my $toc = $self->send_json(
+        $self->fetch_response($key)
+    );
+}
+
+sub send_img {
+    my($self, $response) = @_;
+    return { 
+        content_type => $response->header('Content-type'),
+        content => $response->content, 
+        binary => 1 
+    };
+}
+
+sub send_json {
+    my( $self, $content ) = @_;
+    return 0 unless $content;
+
+    return { content_type => 'text/plain', content => $content };
+}
+
+sub send_html {
+    my( $self, $content ) = @_;
+    return 0 unless $content;
+
+    # Hide anything that might contain a link since it will be broken
+    my $HTML = <<"    HTML";
+        <div>
+            <style type='text/css'>
+                div.ac input, div.ac a[href],div.ac img, div.ac button { display: none; visibility: hidden }
+            </style>
+            <div class='ac'>
+                $content
+            </div>
+        </div>
+    HTML
+
+    return { content_type => 'text/html', content => $HTML };
+}
+
+# returns the HTTP response object from the URL fetch
+sub fetch_response {
+    my( $self, $key ) = @_;
+    my $url = $base_url . "$key";
+    my $response = $AC->get_url($url);
+    return $response;
+}
+
+# returns the HTTP response object from the URL fetch
+sub fetch_cover_response {
+    my( $self, $size, $key ) = @_;
+    my $url = $cover_base_url . "$key$size";
+    return $AC->get_url($url);
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent/Syndetic.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent/Syndetic.pm
new file mode 100644
index 0000000000..6ae2a5ab64
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/AddedContent/Syndetic.pm
@@ -0,0 +1,262 @@
+package OpenILS::WWW::AddedContent::Syndetic;
+use strict; use warnings;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenSRF::Utils::SettingsParser;
+use OpenSRF::Utils::JSON;
+use OpenSRF::EX qw/:try/;
+use OpenILS::WWW::AddedContent;
+use XML::LibXML;
+use MIME::Base64;
+
+my $AC = 'OpenILS::WWW::AddedContent';
+
+
+sub new {
+    my( $class, $args ) = @_;
+    $class = ref $class || $class;
+    return bless($args, $class);
+}
+
+sub base_url {
+    my $self = shift;
+    return $self->{base_url};
+}
+
+sub userid {
+    my $self = shift;
+    return $self->{userid};
+}
+
+
+# --------------------------------------------------------------------------
+sub jacket_small {
+    my( $self, $key ) = @_;
+    return $self->send_img(
+        $self->fetch_response('sc.gif', $key, 1));
+}
+
+sub jacket_medium {
+    my( $self, $key ) = @_;
+    return $self->send_img(
+        $self->fetch_response('mc.gif', $key, 1));
+
+}
+sub jacket_large {
+    my( $self, $key ) = @_;
+    return $self->send_img(
+        $self->fetch_response('lc.gif', $key, 1));
+}
+
+# --------------------------------------------------------------------------
+
+sub toc_html {
+    my( $self, $key ) = @_;
+    return $self->send_html(
+        $self->fetch_content('toc.html', $key));
+}
+
+sub toc_xml {
+    my( $self, $key ) = @_;
+    return $self->send_xml(
+        $self->fetch_content('toc.xml', $key));
+}
+
+sub toc_json {
+    my( $self, $key ) = @_;
+    return $self->send_json(
+        $self->fetch_content('toc.xml', $key));
+}
+
+# --------------------------------------------------------------------------
+
+sub anotes_html {
+    my( $self, $key ) = @_;
+    return $self->send_html(
+        $self->fetch_content('anotes.html', $key));
+}
+
+sub anotes_xml {
+    my( $self, $key ) = @_;
+    return $self->send_xml(
+        $self->fetch_content('anotes.xml', $key));
+}
+
+sub anotes_json {
+    my( $self, $key ) = @_;
+    return $self->send_json(
+        $self->fetch_content('anotes.xml', $key));
+}
+
+
+# --------------------------------------------------------------------------
+
+sub excerpt_html {
+    my( $self, $key ) = @_;
+    return $self->send_html(
+        $self->fetch_content('dbchapter.html', $key));
+}
+
+sub excerpt_xml {
+    my( $self, $key ) = @_;
+    return $self->send_xml(
+        $self->fetch_content('dbchapter.xml', $key));
+}
+
+sub excerpt_json {
+    my( $self, $key ) = @_;
+    return $self->send_json(
+        $self->fetch_content('dbchapter.xml', $key));
+}
+
+# --------------------------------------------------------------------------
+
+sub reviews_html {
+    my( $self, $key ) = @_;
+
+    my %reviews;
+
+    $reviews{ljreview} = $self->fetch_content('ljreview.html', $key);
+    $reviews{pwreview} = $self->fetch_content('pwreview.html', $key);
+    $reviews{slreview} = $self->fetch_content('slreview.html', $key);
+    $reviews{chreview} = $self->fetch_content('chreview.html', $key);
+    $reviews{blreview} = $self->fetch_content('blreview.html', $key);
+    $reviews{hbreview} = $self->fetch_content('hbreview.html', $key);
+    $reviews{kirkreview} = $self->fetch_content('kirkreview.html', $key);
+
+    for(keys %reviews) {
+        if( ! $self->data_exists($reviews{$_}) ) {
+            delete $reviews{$_};
+            next;
+        }
+        $reviews{$_} =~ s/<!.*?>//og; # Strip any doctype declarations
+    }
+
+    return 0 if scalar(keys %reviews) == 0;
+    
+    #my $html = "<div>";
+    my $html;
+    $html .= $reviews{$_} for keys %reviews;
+    #$html .= "</div>";
+
+    return $self->send_html($html);
+}
+
+# we have to aggregate the reviews
+sub reviews_xml {
+    my( $self, $key ) = @_;
+    my %reviews;
+
+    $reviews{ljreview} = $self->fetch_content('ljreview.xml', $key);
+    $reviews{pwreview} = $self->fetch_content('pwreview.xml', $key);
+    $reviews{slreview} = $self->fetch_content('slreview.xml', $key);
+    $reviews{chreview} = $self->fetch_content('chreview.xml', $key);
+    $reviews{blreview} = $self->fetch_content('blreview.xml', $key);
+    $reviews{hbreview} = $self->fetch_content('hbreview.xml', $key);
+    $reviews{kirkreview} = $self->fetch_content('kirkreview.xml', $key);
+
+    for(keys %reviews) {
+        if( ! $self->data_exists($reviews{$_}) ) {
+            delete $reviews{$_};
+            next;
+        }
+        # Strip the xml and doctype declarations
+        $reviews{$_} =~ s/<\?xml.*?>//og;
+        $reviews{$_} =~ s/<!.*?>//og;
+    }
+
+    return 0 if scalar(keys %reviews) == 0;
+    
+    my $xml = "<reviews>";
+    $xml .= $reviews{$_} for keys %reviews;
+    $xml .= "</reviews>";
+
+    return $self->send_xml($xml);
+}
+
+
+sub reviews_json {
+    my( $self, $key ) = @_;
+    return $self->send_json(
+        $self->fetch_content('dbchapter.xml', $key));
+}
+
+# --------------------------------------------------------------------------
+
+
+sub data_exists {
+    my( $self, $data ) = @_;
+    return 0 if $data =~ m/<title>error<\/title>/iog;
+    return 1;
+}
+
+
+sub send_json {
+    my( $self, $xml ) = @_;
+    return 0 unless $self->data_exists($xml);
+    my $doc;
+
+    try {
+        $doc = XML::LibXML->new->parse_string($xml);
+    } catch Error with {
+        my $err = shift;
+        $logger->error("added content XML parser error: $err\n\n$xml");
+        $doc = undef;
+    };
+
+    return 0 unless $doc;
+    my $perl = OpenSRF::Utils::SettingsParser::XML2perl($doc->documentElement);
+    my $json = OpenSRF::Utils::JSON->perl2JSON($perl);
+    return { content_type => 'text/plain', content => $json };
+}
+
+sub send_xml {
+    my( $self, $xml ) = @_;
+    return 0 unless $self->data_exists($xml);
+    return { content_type => 'application/xml', content => $xml };
+}
+
+sub send_html {
+    my( $self, $content ) = @_;
+    return 0 unless $self->data_exists($content);
+
+    # Hide anything that might contain a link since it will be broken
+    my $HTML = <<"    HTML";
+        <div>
+            <style type='text/css'>
+                div.ac input, div.ac a[href],div.ac img, div.ac button { display: none; visibility: hidden }
+            </style>
+            <div class='ac'>
+                $content
+            </div>
+        </div>
+    HTML
+
+    return { content_type => 'text/html', content => $HTML };
+}
+
+sub send_img {
+    my($self, $response) = @_;
+    return { 
+        content_type => $response->header('Content-type'),
+        content => $response->content, 
+        binary => 1 
+    };
+}
+
+# returns the raw content returned from the URL fetch
+sub fetch_content {
+    my( $self, $page, $key ) = @_;
+    return $self->fetch_response($page, $key)->content;
+}
+
+# returns the HTTP response object from the URL fetch
+sub fetch_response {
+    my( $self, $page, $key, $notype ) = @_;
+    my $uname = $self->userid;
+    my $url = $self->base_url . "?isbn=$key/$page&client=$uname" . (($notype) ? '' : "&type=rw12");
+    return $AC->get_url($url);
+}
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/BadDebt.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/BadDebt.pm
new file mode 100644
index 0000000000..cb7c322d69
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/BadDebt.pm
@@ -0,0 +1,215 @@
+package OpenILS::WWW::BadDebt;
+use strict;
+use warnings;
+use bytes;
+
+use Apache2::Log;
+use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use APR::Table;
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::RequestUtil;
+use CGI;
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::System;
+use OpenSRF::AppSession;
+use XML::LibXML;
+use XML::LibXSLT;
+
+use Encode;
+use Unicode::Normalize;
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::Logger qw/$logger/;
+
+use UNIVERSAL::require;
+
+# set the bootstrap config when this module is loaded
+my $bootstrap;
+
+sub import {
+        my $self = shift;
+        $bootstrap = shift;
+}
+
+
+sub child_init {
+        OpenSRF::System->bootstrap_client( config_file => $bootstrap );
+}
+
+sub handler {
+	my $r = shift;
+	my $cgi = new CGI;
+    my $auth_ses = $cgi->cookie('ses') || $cgi->param('ses');
+
+	# find some IDs ...
+	my @xacts;
+
+    my $user = verify_login($auth_ses);
+    return 403 unless $user;
+
+	my $mark_bad = $cgi->param('action') eq 'unmark' ? 'f' : 't';
+	my $format = $cgi->param('format') || 'csv';
+
+	my $file = $cgi->param('idfile');
+	if ($file) {
+		my $col = $cgi->param('idcolumn') || 0;
+		my $csv = new Text::CSV;
+
+		while (<$file>) {
+			$csv->parse($_);
+			my @data = $csv->fields;
+			my $id = $data[$col];
+			$id =~ s/\D+//o;
+			next unless ($id);
+			push @xacts, $id;
+		}
+	}
+
+	if (!@xacts) { # try pathinfo
+		my $path_rec = $cgi->path_info();
+		if ($path_rec) {
+			@xacts = map { $_ ? ($_) : () } split '/', $path_rec;
+		}
+	}
+
+    return 404 unless @xacts;
+
+    my @lines;
+
+    my ($yr,$mon,$day) = (localtime())[5,4,3]; $yr += 1900;
+    my $date = sprintf('%d-%02d-%02d',$yr,$mon,$day);
+
+    my @header = ( '"Transaction ID"', '"Message"', '"Amount Owed"', '"Transaction Start Date"', '"User Barcode"' );
+
+	my $cstore = OpenSRF::AppSession->create('open-ils.cstore');
+    my $actor = OpenSRF::AppSession->create('open-ils.actor');
+
+    $cstore->connect();
+    $cstore->request('open-ils.cstore.transaction.begin')->gather(1);
+
+    for my $xact ( @xacts ) {
+        try {
+    
+            my $x = $cstore->request('open-ils.cstore.direct.money.billable_xact.retrieve' => $xact)->gather(1);
+            my $s = $cstore->request('open-ils.cstore.direct.money.billable_xact_summary.retrieve' => $xact)->gather(1);
+            my $u = $cstore->request('open-ils.cstore.direct.actor.usr.retrieve' => $s->usr)->gather(1);
+            my $c = $cstore->request('open-ils.cstore.direct.actor.card.retrieve' => $u->card)->gather(1);
+            my $w;
+
+            if ($s->xact_type eq 'circulation') {
+                $w = $cstore->request('open-ils.cstore.direct.action.circulation.retrieve' => $xact)->gather(1)->circ_lib :
+            } elsif ($s->xact_type eq 'grocery') {
+                $w = $cstore->request('open-ils.cstore.direct.money.grocery.retrieve' => $xact)->gather(1)->billing_location;
+            } elsif ($s->xact_type eq 'reservation') {
+                $w = $cstore->request('open-ils.cstore.direct.booking.reservation.retrieve' => $xact)->gather(1)->pickup_lib;
+            } else {
+                die;
+            }
+    
+            my $failures = $actor->request('open-ils.actor.user.perm.check', $auth_ses, $user->id, $w, ['MARK_BAD_DEBT'])->gather(1);
+    
+            if (@$failures) {
+                push @lines, [ $xact, '"Permission Failure"', '""', '""', '""' ];
+            } else {
+                $x->unrecovered($mark_bad);
+                my $result = $cstore->request('open-ils.cstore.direct.money.billable_xact.update' => $x)->gather(1);
+                if ($result != $x->id) {
+                    push @lines, [ $xact, '"Update Failure"', '""', '""', '""' ];
+                } else {
+                    my $amount = $s->balance_owed;
+                    my $start = $s->xact_start;
+                    my $barcode = $c->barcode;
+
+                    if ( $mark_bad eq 't' ) {
+                        push @lines, [ $xact, '"Marked Bad Debt"', $amount, "\"$start\"", "\"$barcode\"" ];
+                    } else {
+                        push @lines, [ $xact, '"Unmarked Bad Debt"', $amount, "\"$start\"", "\"$barcode\"" ];
+                    }
+                }
+            }
+        } otherwise {
+            push @lines, [ $xact, '"Update Failure"', '""', '""', '""' ];
+        };
+    }
+
+    $cstore->request('open-ils.cstore.transaction.commit')->gather(1);
+    $cstore->disconnect();
+
+    if ($format eq 'csv') {
+        $r->headers_out->set("Content-Disposition" => "inline; filename=bad_debt_$date.csv");
+	    $r->content_type('application/octet-stream');
+
+        $r->print( join(',', @header) . "\n" );
+        $r->print( join(',', @$_    ) . "\n" ) for (@lines);
+
+    } elsif ($format eq 'json') {
+
+	    $r->content_type('application/json');
+
+        $r->print( '[' );
+
+        my $first = 1;
+        for my $line ( @lines ) {
+            $r->print( ',' ) if $first;
+            $first = 0;
+
+            $r->print( '{' );
+            for my $field ( 0 .. 4 ) {
+                $r->print( "$header[$field] : $$line[$field]" );
+                $r->print( ',' ) if ($field < 4);
+            }
+            $r->print( '}' );
+        }
+
+        $r->print( ']' );
+    }
+
+	return Apache2::Const::OK;
+
+}
+
+sub verify_login {
+        my $auth_token = shift;
+        return undef unless $auth_token;
+
+        my $user = OpenSRF::AppSession
+                ->create("open-ils.auth")
+                ->request( "open-ils.auth.session.retrieve", $auth_token )
+                ->gather(1);
+
+        if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) {
+                return undef;
+        }
+
+        return $user if ref($user);
+        return undef;
+}
+
+sub show_template {
+	my $r = shift;
+
+	$r->content_type('text/html');
+	$r->print(<<HTML);
+
+<html>
+	<head>
+		<title>Record Export
+	
+	
+		

+			Use field number  (starting from 0)
+			from CSV file 
+			
+		

+	
+
+
+HTML
+
+	return Apache2::Const::OK;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/EGWeb.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/EGWeb.pm
new file mode 100644
index 0000000000..42eb6ffbf7
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/EGWeb.pm
@@ -0,0 +1,230 @@
+package OpenILS::WWW::EGWeb;
+use strict; use warnings;
+use Template;
+use XML::Simple;
+use XML::LibXML;
+use File::stat;
+use Apache2::Const -compile => qw(OK DECLINED HTTP_INTERNAL_SERVER_ERROR);
+use Apache2::Log;
+use OpenSRF::EX qw(:try);
+
+use constant OILS_HTTP_COOKIE_SKIN => 'oils:skin';
+use constant OILS_HTTP_COOKIE_THEME => 'oils:theme';
+use constant OILS_HTTP_COOKIE_LOCALE => 'oils:locale';
+
+my $web_config;
+my $web_config_file;
+my $web_config_edit_time;
+
+sub import {
+    my $self = shift;
+    $web_config_file = shift;
+    unless(-r $web_config_file) {
+        warn "Invalid web config $web_config_file";
+        return;
+    }
+    check_web_config();
+}
+
+
+sub handler {
+    my $r = shift;
+    check_web_config($r); # option to disable this
+    my $ctx = load_context($r);
+    my $base = $ctx->{base_path};
+    my($template, $page_args, $as_xml) = find_template($r, $base, $ctx);
+    return Apache2::Const::DECLINED unless $template;
+
+    $template = $ctx->{skin} . "/$template";
+    $ctx->{page_args} = $page_args;
+    $r->content_type('text/html; encoding=utf8');
+
+    my $tt = Template->new({
+        OUTPUT => ($as_xml) ?  sub { parse_as_xml($r, $ctx, @_); } : $r,
+        INCLUDE_PATH => $ctx->{template_paths},
+    });
+
+    unless($tt->process($template, {ctx => $ctx})) {
+        $r->log->warn('Template error: ' . $tt->error);
+        return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR;
+    }
+
+    return Apache2::Const::OK;
+}
+
+sub parse_as_xml {
+    my $r = shift;
+    my $ctx = shift;
+    my $data = shift;
+
+    my $success = 0;
+
+    try { 
+        my $doc = XML::LibXML->new->parse_string($data); 
+        $data = $doc->documentElement->toStringC14N;
+        $data = $ctx->{final_dtd} . "\n" . $data;
+        $success = 1;
+    } otherwise {
+	my $e = shift;
+        my $err = "Invalid XML: $e";
+        $r->log->error($err);
+        $r->content_type('text/plain; encoding=utf8');
+        $r->print("\n$err\n\n$data");
+    };
+
+    $r->print($data) if ($success);
+}
+
+
+sub load_context {
+    my $r = shift;
+    my $cgi = CGI->new;
+    my $ctx = $web_config->{ctx};
+    $ctx->{hostname} = $r->hostname;
+    $ctx->{base_url} = $cgi->url(-base => 1);
+    $ctx->{skin} = $cgi->cookie(OILS_HTTP_COOKIE_SKIN) || 'default';
+    $ctx->{theme} = $cgi->cookie(OILS_HTTP_COOKIE_THEME) || 'default';
+    $ctx->{locale} = 
+        $cgi->cookie(OILS_HTTP_COOKIE_LOCALE) || 
+        parse_accept_lang($r->headers_in->get('Accept-Language')) || 'en-US';
+    $r->log->debug('skin = ' . $ctx->{skin} . ' : theme = ' . 
+        $ctx->{theme} . ' : locale = ' . $ctx->{locale});
+    return $ctx;
+}
+
+# turn Accept-Language into sometihng EG can understand
+sub parse_accept_lang {
+    my $al = shift;
+    return undef unless $al;
+    my ($locale) = split(/,/, $al);
+    ($locale) = split(/;/, $locale);
+    return undef unless $locale;
+    $locale =~ s/-(.*)/eval '-'.uc("$1")/e;
+    return $locale;
+}
+
+# Given a URI, finds the configured template and any extra page 
+# arguments (trailing path info).  Any extra data is returned
+# as page arguments, in the form of an array, one item per 
+# /-separated URI component
+sub find_template {
+    my $r = shift;
+    my $base = shift;
+    my $ctx = shift;
+    my $skin = $ctx->{skin};
+    my $path = $r->uri;
+    $path =~ s/$base//og;
+    my @parts = split('/', $path);
+    my $template = '';
+    my $page_args = [];
+    my $as_xml = $ctx->{force_valid_xml};
+    my $handler = $web_config->{handlers};
+
+    while(@parts) {
+        my $part = shift @parts;
+        next unless $part;
+        my $t = $handler->{$part};
+        if(ref($t) eq 'PathConfig') {
+            $template = $t->{template};
+            $as_xml = ($t->{as_xml} and $t->{as_xml} =~ /true/io) || $as_xml;
+            $page_args = [@parts];
+            last;
+        } else {
+            $handler = $t;
+        }
+    }
+
+    unless($template) { # no template configured
+
+        # see if we can magically find the template based on the path and default extension
+        my $ext = $ctx->{default_template_extension};
+
+        my @parts = split('/', $path);
+        my $localpath = $path;
+        my @args;
+        while(@parts) {
+            last unless $localpath;
+            for my $tpath (@{$ctx->{template_paths}}) {
+                my $fpath = "$tpath/$skin/$localpath.$ext";
+                $r->log->debug("looking at possible template $fpath");
+                if(-r $fpath) {
+                    $template = "$localpath.$ext";
+                    last;
+                }
+            }
+            last if $template;
+            push(@args, pop @parts);
+            $localpath = '/'.join('/', @parts);
+        } 
+
+        $page_args = [@args];
+
+        # no template configured or found
+        unless($template) {
+            $r->log->warn("No template configured for path $path");
+            return ();
+        }
+    }
+
+    $r->log->debug("template = $template : page args = @$page_args");
+    return ($template, $page_args, $as_xml);
+}
+
+# if the web configuration file has never been loaded or has
+# changed since the last load, reload it
+sub check_web_config {
+    my $r = shift;
+    my $epoch = stat($web_config_file)->mtime;
+    unless($web_config_edit_time and $web_config_edit_time == $epoch) {
+        $r->log->debug("Reloading web config after edit...") if $r;
+        $web_config_edit_time = $epoch;
+        $web_config = parse_config($web_config_file);
+    }
+}
+
+sub parse_config {
+    my $cfg_file = shift;
+    my $data = XML::Simple->new->XMLin($cfg_file);
+    my $ctx = {};
+    my $handlers = {};
+
+    $ctx->{media_prefix} = (ref $data->{media_prefix}) ? '' : $data->{media_prefix};
+    $ctx->{base_path} = (ref $data->{base_path}) ? '' : $data->{base_path};
+    $ctx->{template_paths} = [];
+    $ctx->{force_valid_xml} = ($data->{force_valid_xml} =~ /true/io) ? 1 : 0;
+    $ctx->{default_template_extension} = $data->{default_template_extension} || 'tt2';
+    $ctx->{web_dir} = $data->{web_dir};
+
+    my $tpaths = $data->{template_paths}->{path};
+    $tpaths = [$tpaths] unless ref $tpaths;
+    push(@{$ctx->{template_paths}}, $_) for @$tpaths;
+
+    for my $handler (@{$data->{handlers}->{handler}}) {
+        my @parts = split('/', $handler->{path});
+        my $h = $handlers;
+        my $pcount = scalar(@parts);
+        for(my $i = 0; $i < $pcount; $i++) {
+            my $p = $parts[$i];
+            unless(defined $h->{$p}) {
+                if($i == $pcount - 1) {
+                    $h->{$p} = PathConfig->new(%$handler);
+                    last;
+                } else {
+                    $h->{$p} = {};
+                }
+            }
+            $h = $h->{$p};
+        }
+    }
+
+    return {ctx => $ctx, handlers => $handlers};
+}
+
+package PathConfig;
+sub new {
+    my($class, %args) = @_;
+    return bless(\%args, $class);
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/Exporter.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Exporter.pm
new file mode 100644
index 0000000000..8234d1cfeb
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Exporter.pm
@@ -0,0 +1,347 @@
+package OpenILS::WWW::Exporter;
+use strict;
+use warnings;
+use bytes;
+
+use Apache2::Log;
+use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use APR::Table;
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::RequestUtil;
+use CGI;
+use Data::Dumper;
+use Text::CSV;
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::Utils qw/:datetime/;
+use OpenSRF::Utils::Cache;
+use OpenSRF::System;
+use OpenSRF::AppSession;
+use XML::LibXML;
+use XML::LibXSLT;
+
+use Encode;
+use Unicode::Normalize;
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::Logger qw/$logger/;
+
+use MARC::Record;
+use MARC::File::XML;
+
+use UNIVERSAL::require;
+
+our @formats = qw/USMARC UNIMARC XML BRE/;
+
+# set the bootstrap config and template include directory when
+# this module is loaded
+my $bootstrap;
+
+sub import {
+        my $self = shift;
+        $bootstrap = shift;
+}
+
+
+sub child_init {
+        OpenSRF::System->bootstrap_client( config_file => $bootstrap );
+}
+
+sub handler {
+	my $r = shift;
+	my $cgi = new CGI;
+
+	# find some IDs ...
+	my @records;
+
+	@records = map { $_ ? ($_) : () } $cgi->param('id');
+
+	if (!@records) { # try for a file
+		my $file = $cgi->param('idfile');
+		if ($file) {
+			my $col = $cgi->param('idcolumn') || 0;
+			my $csv = new Text::CSV;
+
+			while (<$file>) {
+				$csv->parse($_);
+				my @data = $csv->fields;
+				my $id = $data[$col];
+				$id =~ s/\D+//o;
+				next unless ($id);
+				push @records, $id;
+			}
+		}
+	}
+
+	if (!@records) { # try pathinfo
+		my $path_rec = $cgi->path_info();
+		if ($path_rec) {
+			@records = map { $_ ? ($_) : () } split '/', $path_rec;
+		}
+	}
+
+	my $ses = OpenSRF::AppSession->create('open-ils.cstore');
+
+	# still no records ...
+	my $container = $cgi->param('containerid');
+	if ($container) {
+		my $bucket = $ses->request( 'open-ils.cstore.direct.container.biblio_record_entry_bucket.retrieve', $container )->gather(1);
+        unless($bucket) {
+            $r->log->error("No such bucket $container"); 
+            $logger->error("No such bucket $container"); 
+            return Apache2::Const::NOT_FOUND;
+        }
+        if ($bucket->pub !~ /t|1/oi) {
+    		my $authid = $cgi->cookie('ses') || $cgi->param('ses');
+	    	my $auth = verify_login($authid);
+		    if (!$auth) {
+			    return 403;
+    		}
+        }
+		my $recs = $ses->request( 'open-ils.cstore.direct.container.biblio_record_entry_bucket_item.search.atomic', { bucket => $container } )->gather(1);
+		@records = map { ($_->target_biblio_record_entry) } @$recs;
+	}
+
+	return show_template($r) unless (@records);
+
+	my $type = $cgi->param('rectype') || 'biblio';
+	if ($type ne 'biblio' && $type ne 'authority') {
+		return 400;
+	}
+
+	my $tcn_v = 'tcn_value';
+	my $tcn_s = 'tcn_source';
+
+	my $holdings = $cgi->param('holdings') if ($type eq 'biblio');
+	my $location = $cgi->param('location') || 'gaaagpl'; # just because...
+
+	my $format = $cgi->param('format') || 'USMARC';
+	$format = uc($format);
+
+	my $encoding = $cgi->param('encoding') || 'UTF-8';
+	$encoding = uc($encoding);
+
+	my $filename = $cgi->param('filename') || "export.$type.$encoding.$format";
+
+	binmode(STDOUT, ':raw') if ($encoding ne 'UTF-8');
+	binmode(STDOUT, ':utf8') if ($encoding eq 'UTF-8');
+
+	if (!grep { uc($format) eq $_ } @formats) {
+		return 400;
+	}
+
+	if ($format ne 'XML') {
+		my $ftype = 'MARC::File::' . $format;
+		$ftype->require;
+	}
+
+
+	$r->headers_out->set("Content-Disposition" => "inline; filename=$filename");
+
+	if (uc($format) eq 'XML') {
+		$r->content_type('application/xml');
+	} else {
+		$r->content_type('application/octet-stream');
+	}
+
+	$r->print( <<"	HEADER" ) if (uc($format) eq 'XML');
+
+
+	HEADER
+
+	my %orgs;
+	my %shelves;
+	my %statuses;
+
+	my $flesh = {};
+	if ($holdings) {
+
+		my $req = $ses->request( 'open-ils.cstore.direct.actor.org_unit.search', { id => { '!=' => undef } } );
+
+    		while (my $o = $req->recv) {
+        		next if ($req->failed);
+        		$o = $o->content;
+        		last unless ($o);
+	    		$orgs{$o->id} = $o;
+    		}
+    		$req->finish;
+
+		$req = $ses->request( 'open-ils.cstore.direct.asset.copy_location.search', { id => { '!=' => undef } } );
+
+    		while (my $s = $req->recv) {
+        		next if ($req->failed);
+        		$s = $s->content;
+        		last unless ($s);
+	    		$shelves{$s->id} = $s;
+    		}
+    		$req->finish;
+
+		$req = $ses->request( 'open-ils.cstore.direct.config.copy_status.search', { id => { '!=' => undef } } );
+
+    		while (my $s = $req->recv) {
+        		next if ($req->failed);
+        		$s = $s->content;
+        		last unless ($s);
+	    		$statuses{$s->id} = $s;
+    		}
+    		$req->finish;
+
+    		$flesh = { flesh => 2, flesh_fields => { bre => [ 'call_numbers' ], acn => [ 'copies' ] } };
+	}
+
+	for my $i ( @records ) {
+    		my $bib;
+    		try {
+        		local $SIG{ALRM} = sub { die "TIMEOUT\n" };
+        		alarm(1);
+	    		$bib = $ses->request( "open-ils.cstore.direct.$type.record_entry.retrieve", $i, $flesh )->gather(1);
+        		alarm(0);
+    		} otherwise {
+        		warn "\n!!!!!! Timed out trying to read record $i\n";
+    		};
+    		alarm(0);
+
+		next unless $bib;
+
+    		if (uc($format) eq 'BRE') {
+        		$r->print( OpenSRF::Utils::JSON->perl2JSON($bib) . "\n" );
+        		next;
+    		}
+
+		try {
+
+			my $req = MARC::Record->new_from_xml( $bib->marc, $encoding, $format );
+			$req->encoding($encoding) if ($encoding eq 'UTF-8');
+
+			if ($holdings) {
+				$req->delete_field( $_ ) for ($req->field('852')); # remove any legacy 852s
+        			my $cn_list = $bib->call_numbers;
+        			if ($cn_list && @$cn_list) {
+
+            				my $cp_list = [ map { @{ $_->copies } } @$cn_list ];
+            				if ($cp_list && @$cp_list) {
+
+	            				my %cn_map;
+	            				push @{$cn_map{$_->call_number}}, $_ for (@$cp_list);
+		                        
+	            				for my $cn ( @$cn_list ) {
+	                				my $cn_map_list = $cn_map{$cn->id};
+	
+	                				for my $cp ( @$cn_map_list ) {
+		                        
+								$req->append_fields(
+									MARC::Field->new(
+										852, '4', '', 
+										a => $location,
+										b => $orgs{$cn->owning_lib}->shortname,
+										b => $orgs{$cp->circ_lib}->shortname,
+										c => $shelves{$cp->location}->name,
+										j => $cn->label,
+										($cp->circ_modifier ? ( g => $cp->circ_modifier ) : ()),
+										p => $cp->barcode,
+										($cp->price ? ( y => $cp->price ) : ()),
+										($cp->copy_number ? ( t => $cp->copy_number ) : ()),
+										($cp->ref eq 't' ? ( x => 'reference' ) : ( x => 'nonreference' )),
+										($cp->holdable eq 'f' ? ( x => 'unholdable' ) : ( x => 'holdable' )),
+										($cp->circulate eq 'f' ? ( x => 'noncirculating' ) : ( x => 'circulating' )),
+										($cp->opac_visible eq 'f' ? ( x => 'hidden' ) : ( x => 'visible' )),
+										z => $statuses{$cp->status}->name,
+									)
+								);
+
+							}
+						}
+					}
+        			}
+			}
+
+			if (uc($format) eq 'XML') {
+				my $x = $req->as_xml_record;
+				$x =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
+				$r->print($x);
+			} elsif (uc($format) eq 'UNIMARC') {
+				$r->print($req->as_usmarc);
+			} elsif (uc($format) eq 'USMARC') {
+				$r->print($req->as_usmarc);
+			}
+
+            $r->rflush();
+
+		} otherwise {
+			my $e = shift;
+			warn "\n$e\n";
+		};
+
+	}
+
+	$r->print("\n") if ($format eq 'XML');
+
+	return Apache2::Const::OK;
+
+}
+
+sub verify_login {
+        my $auth_token = shift;
+        return undef unless $auth_token;
+
+        my $user = OpenSRF::AppSession
+                ->create("open-ils.auth")
+                ->request( "open-ils.auth.session.retrieve", $auth_token )
+                ->gather(1);
+
+        if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) {
+                return undef;
+        }
+
+        return $user if ref($user);
+        return undef;
+}
+
+sub show_template {
+	my $r = shift;
+
+	$r->content_type('text/html');
+	$r->print(<
+	
+		Record Export
+	
+	
+		

+			Use field number  (starting from 0)
+			from CSV file 
+			

 or 


+			Record ID 
+			

 Record Type:
+			
+			
 Record Format:
+			
+			
 Record Encoding:
+			
+			
 Include holdings in Bibliographic Records:
+			
+			


+		

+	
+
+
+HTML
+
+	return Apache2::Const::OK;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/IDL2js.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/IDL2js.pm
new file mode 100644
index 0000000000..ee5b2ef255
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/IDL2js.pm
@@ -0,0 +1,79 @@
+package OpenILS::WWW::IDL2js;
+use strict; use warnings;
+use XML::LibXML;
+use XML::LibXSLT;
+use Apache2::Const -compile => qw(OK DECLINED HTTP_INTERNAL_SERVER_ERROR);
+use Error qw/:try/;
+use OpenSRF::System;
+use OpenSRF::Utils::SettingsClient;
+
+my $bs_config;
+my $stylesheet;
+my $idl_doc;
+
+
+# load and parse the stylesheet
+sub import {
+    my $self = shift;
+    $bs_config = shift;
+}
+
+# parse the IDL, loaded from the network
+my $__initted = 0;
+sub child_init {
+    $__initted = 1;
+
+    OpenSRF::System->bootstrap_client(config_file => $bs_config);
+    my $sclient = OpenSRF::Utils::SettingsClient->new();
+
+    my $xsl_file = $sclient->config_value('IDL2js');
+
+    unless($xsl_file) {
+        warn "XSL2js XSL file required for IDL2js Apache module\n";
+        return;
+    }
+
+    $xsl_file = $sclient->config_value(dirs => 'xsl')."/$xsl_file";
+    my $idl_file = $sclient->config_value("IDL");
+
+    my $xslt = XML::LibXSLT->new();
+
+    try {
+
+        my $style_doc = XML::LibXML->load_xml(location => $xsl_file, no_cdata=>1);
+        $stylesheet = $xslt->parse_stylesheet($style_doc);
+
+    } catch Error with {
+        my $e = shift;
+        warn "Invalid XSL File: $xsl_file: $e\n";
+    };
+
+    $idl_doc = XML::LibXML->load_xml(location => $idl_file);
+}
+
+
+sub handler {
+    my $r = shift;
+    my $args = $r->args || '';
+    child_init() unless $__initted;
+
+    return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR unless $stylesheet and $idl_doc;
+    return Apache2::Const::DECLINED if $args and $args !~ /^[a-zA-Z,]*$/;
+
+    my $output;
+    try {
+        my $results = $stylesheet->transform($idl_doc, class_list => "'$args'");
+        $output = $stylesheet->output_as_bytes($results);
+    } catch Error with {
+        my $e = shift;
+        $r->log->error("IDL XSL Error: $e");
+    };
+
+    return Apache2::Const::HTTP_INTERNAL_SERVER_ERROR unless $output;
+
+    $r->content_type('application/x-javascript; encoding=utf8');
+    $r->print($output);
+    return Apache2::Const::OK;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/Method.pm.in b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Method.pm.in
new file mode 100644
index 0000000000..3bec97c5d1
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Method.pm.in
@@ -0,0 +1,161 @@
+package OpenILS::WWW::Method;
+use strict; use warnings;
+
+use Apache2::Log;
+use Apache2::Const -compile => qw(OK REDIRECT :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::RequestUtil;
+
+use OpenSRF::Utils::JSON;
+
+use CGI ();
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::System;
+
+my %session_hash;
+
+use constant MAX_SESSION_REQUESTS => 20;
+
+sub handler {
+
+	use Data::Dumper;
+
+
+	my $apache = shift;
+	my $cgi = CGI->new( $apache );
+
+	print "Content-type: text/plain; charset=utf-8\n\n";
+	#print $cgi->header;
+
+	my @p = $cgi->param();
+	warn "Params: " . Dumper(\@p);
+
+	my $method = $cgi->param("method");
+	my $service = $cgi->param("service");
+
+	my $err = undef;
+
+	if( ! $service || ! $method ) {
+		$err = { 
+			is_err	=> 1, 
+			err_msg	=> "Service name and method name required to fulfill request",
+		};
+	}
+
+	if($err) {
+		print  OpenSRF::Utils::JSON->perl2JSON($err);
+		return Apache2::Const::OK;
+	}
+
+	my @param_array;
+	my %param_hash;
+
+	warn "here\n";
+
+	if(defined($cgi->param("param"))) {
+		for my $param ( $cgi->param("param")) {
+			push( @param_array, OpenSRF::Utils::JSON->JSON2perl( $param ));
+		}
+	} else {
+		for my $param ($cgi->param()) {
+			$param_hash{$param} = OpenSRF::Utils::JSON->JSON2perl($cgi->param($param))
+				unless( $param eq "method" or $param eq "service" );
+		}
+	}
+
+
+	if( @param_array ) {
+		perform_method($service, $method, @param_array);
+	} else {
+		perform_method($service, $method, %param_hash);
+	}
+
+	return Apache2::Const::OK;
+}
+
+sub child_init_handler {
+	OpenSRF::System->bootstrap_client( 
+		config_file => "@sysconfdir@/opensrf_core.xml" );
+}
+
+
+sub perform_method {
+
+	my ($service, $method, @params) = @_;
+
+	warn "performing method $method for service $service with params @params\n";
+
+	my $session;
+
+	if($session_hash{$service} ) {
+
+		$session = $session_hash{$service};
+		$session->{web_count} += 1;
+
+		if( $session->{web_count} > MAX_SESSION_REQUESTS) {
+			$session->disconnect();
+			$session->{web_count} = 1;
+		}
+
+	} else { 
+
+		$session = OpenSRF::AppSession->create($service); 
+		$session_hash{$service} = $session;
+		$session->{web_count} = 1;
+
+	}
+
+	my $request = $session->request( $method, @params );
+
+	my @results;
+	while( my $response = $request->recv(20) ) {
+		
+		if( UNIVERSAL::isa( $response, "Error" )) {
+			warn "Received exception: " . $response->stringify . "\n";
+			my $err = { 
+				is_err	=> 1, 
+				err_msg	=> "Error Completing Request:\n " . 
+					"Service: $service \nMethod: $method \nParams: @params \n" .
+					$response->stringify() . "\n",
+			};
+			print OpenSRF::Utils::JSON->perl2JSON($err);
+			$request->finish();
+			return 0;
+		}
+
+		my $content = $response->content;
+		push @results, $content;
+	}
+
+
+	if(!$request->complete) { 
+		warn "ERROR Completing Request"; 
+		my $err = { 
+			is_err	=> 1, 
+			err_msg	=> "Error Completing Request:\n ".
+				"Service: $service \nMethod: $method \nParams: @params \n" .
+				"request->complete test failed in OpenILS::Web::Method\n" 
+		};
+		print OpenSRF::Utils::JSON->perl2JSON($err); 
+		$request->finish();
+		return 0;
+	}
+
+	$request->finish();
+	$session->finish();
+
+	warn "Results: \n";
+	warn Dumper \@results;
+
+	print OpenSRF::Utils::JSON->perl2JSON( \@results );
+
+	return 1;
+}
+
+# This module appears unfinshed and/or obsolete with many unconditional warns/dumps.
+# File is not referenced elsewhere in the codebase.  Candidate for deletion.
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/PasswordReset.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/PasswordReset.pm
new file mode 100644
index 0000000000..17ec3059f0
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/PasswordReset.pm
@@ -0,0 +1,218 @@
+package OpenILS::WWW::PasswordReset;
+
+# Copyright (C) 2010 Laurentian University
+# Dan Scott 
+# 
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+
+use strict; use warnings;
+
+use Apache2::Log;
+use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::RequestUtil;
+use CGI;
+use Template;
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::Utils qw/:datetime/;
+use OpenSRF::Utils::Cache;
+use OpenSRF::System;
+use OpenSRF::AppSession;
+
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenILS::Application::AppUtils;
+use OpenILS::Utils::CStoreEditor qw/:funcs/;
+
+my $log = 'OpenSRF::Utils::Logger';
+my $U = 'OpenILS::Application::AppUtils';
+
+my ($bootstrap, $actor, $templates);
+my $i18n = {};
+my $init_done = 0; # has child_init been called?
+
+sub import {
+    my $self = shift;
+    $bootstrap = shift;
+}
+
+sub child_init {
+    OpenSRF::System->bootstrap_client( config_file => $bootstrap );
+    
+    my $conf = OpenSRF::Utils::SettingsClient->new();
+    my $idl = $conf->config_value("IDL");
+    Fieldmapper->import(IDL => $idl);
+    $templates = $conf->config_value("dirs", "templates");
+    $actor = OpenSRF::AppSession->create('open-ils.actor');
+    load_i18n();
+    $init_done = 1;
+}
+
+sub password_reset {
+    my $apache = shift;
+
+    child_init() unless $init_done;
+
+    return Apache2::Const::DECLINED if (-e $apache->filename);
+
+    $apache->content_type('text/html');
+
+	my $cgi = new CGI;
+    my $ctx = {};
+
+    $ctx->{'uri'} = $apache->uri;
+
+    # Get our locale from the URL
+    (my $locale = $apache->path_info) =~ s{^.*?/([a-z]{2}-[A-Z]{2})/.*?$}{$1};
+    if (!$locale) {
+        $locale = 'en-US';
+    }
+
+    # If locale exists, use it; otherwise fall back to en-US
+    if (exists $i18n->{$locale}) {
+        $ctx->{'i18n'} = $i18n->{$locale};
+    } else {
+        $ctx->{'i18n'} = $i18n->{'en-US'};
+    }
+
+    my $tt = Template->new({
+        INCLUDE_PATH => $templates
+    }) || die "$Template::ERROR\n";
+
+    # Get our UUID: if no UUID, then display barcode / username / email prompt
+    (my $uuid = $apache->path_info) =~ s{^/$locale/([^/]*?)$}{$1};
+    $logger->info("Password reset: UUID = $uuid");
+
+    if (!$uuid) {
+        request_password_reset($apache, $cgi, $tt, $ctx);
+    } else {
+        reset_password($apache, $cgi, $tt, $ctx, $uuid);
+    }
+}
+
+sub reset_password {
+    my ($apache, $cgi, $tt, $ctx, $uuid) = @_;
+
+    my $password_1 = $cgi->param('pwd1');
+    my $password_2 = $cgi->param('pwd2');
+
+    $ctx->{'title'} = $ctx->{'i18n'}{'TITLE'};
+    $ctx->{'password_prompt'} = $ctx->{'i18n'}{'PASSWORD_PROMPT'};
+    $ctx->{'password_prompt2'} = $ctx->{'i18n'}{'PASSWORD_PROMPT2'};
+
+    # In case non-matching passwords slip through our funky Web interface
+    if ($password_1 and $password_2 and ($password_1 ne $password_2)) {
+        $ctx->{'status'} = {
+            style => 'error',
+            msg => $ctx->{'i18n'}{'NO_MATCH'}
+        };
+        $tt->process('password-reset/reset-form.tt2', $ctx)
+            || die $tt->error();
+        return Apache2::Const::OK;
+    }
+
+    if ($password_1 and $password_2 and ($password_1 eq $password_2)) {
+        my $response = $actor->request('open-ils.actor.patron.password_reset.commit', $uuid, $password_1)->gather();
+        if (ref($response) && $response->{'textcode'}) {
+
+            if ($response->{'textcode'} eq 'PATRON_NOT_AN_ACTIVE_PASSWORD_RESET_REQUEST') {
+                $ctx->{'status'} = { 
+                    style => 'error',
+                    msg => $ctx->{'i18n'}{'NOT_ACTIVE'}
+
+                };
+            }
+            if ($response->{'textcode'} eq 'PATRON_PASSWORD_WAS_NOT_STRONG') {
+                $ctx->{'status'} = { 
+                    style => 'error',
+                    msg => $ctx->{'i18n'}{'NOT_STRONG'}
+
+                };
+            }
+            $tt->process('password-reset/reset-form.tt2', $ctx)
+                || die $tt->error();
+            return Apache2::Const::OK;
+        }
+        $ctx->{'status'} = { 
+            style => 'success',
+            msg => $ctx->{'i18n'}{'SUCCESS'}
+        };
+    }
+
+    # Either the password change was successful, or this is their first time through
+    $tt->process('password-reset/reset-form.tt2', $ctx)
+        || die $tt->error();
+
+    return Apache2::Const::OK;
+}
+
+# Load our localized strings - lame, need to convert to Locale::Maketext
+sub load_i18n {
+    foreach my $string_bundle (glob("$templates/password-reset/strings.*")) {
+        open(I18NFH, '<', $string_bundle);
+        (my $locale = $string_bundle) =~ s/^.*\.([a-z]{2}-[A-Z]{2})$/$1/;
+        $logger->debug("Loaded locale [$locale] from file: [$string_bundle]");
+        while() {
+            my ($string_id, $string) = ($_ =~ m/^(.+?)=(.*?)$/);
+            $i18n->{$locale}{$string_id} = $string;
+        }
+        close(I18NFH);
+    }
+}
+
+sub request_password_reset {
+    my ($apache, $cgi, $tt, $ctx) = @_;
+
+    my $barcode = $cgi->param('barcode');
+    my $username = $cgi->param('username');
+    my $email = $cgi->param('email');
+
+    if (!($barcode or $username or $email)) {
+        $ctx->{'status'} = {
+            style => 'plain',
+            msg => $ctx->{'i18n'}{'IDENTIFY_YOURSELF'}
+        };
+        $tt->process('password-reset/request-form.tt2', $ctx)
+            || die $tt->error();
+        return Apache2::Const::OK;
+    } elsif ($barcode) {
+        my $response = $actor->request('open-ils.actor.patron.password_reset.request', 'barcode', $barcode)->gather();
+        $ctx->{'status'} = {
+            style => 'plain',
+            msg => $ctx->{'i18n'}{'REQUEST_SUCCESS'}
+        };
+        # Hide form
+        $tt->process('password-reset/request-form.tt2', $ctx)
+            || die $tt->error();
+        return Apache2::Const::OK;
+    } elsif ($username) {
+        my $response = $actor->request('open-ils.actor.patron.password_reset.request', 'username', $username)->gather();
+        $ctx->{'status'} = {
+            style => 'plain',
+            msg => $ctx->{'i18n'}{'REQUEST_SUCCESS'}
+        };
+        # Hide form
+        $tt->process('password-reset/request-form.tt2', $ctx)
+            || die $tt->error();
+        return Apache2::Const::OK;
+    }
+}
+
+1;
+
+# vim: et:ts=4:sw=4
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/Proxy.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Proxy.pm
new file mode 100644
index 0000000000..6c5f3da40d
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Proxy.pm
@@ -0,0 +1,199 @@
+package OpenILS::WWW::Proxy;
+use strict; use warnings;
+
+use Apache2::Log;
+use Apache2::Const -compile => qw(REDIRECT FORBIDDEN OK NOT_FOUND DECLINED :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use CGI;
+use Data::Dumper;
+use Digest::MD5 qw/md5_hex/;
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::System;
+
+
+# set the bootstrap config and template include directory when 
+# this module is loaded
+my $bootstrap;
+my $ssl_off;
+
+my $default_template = <
+	
+		TITLE
+	
+	
+		



+		

+		

+			
+				
+					
+				
+				
+					
+					
+				
+				
+					
+					
+				
+			
DESCRIPTION
Username or barcode:
Password:

+			
+		

+		

+	
+
+HTML
+
+sub import {
+	my $self = shift;
+	$bootstrap = shift;
+	$ssl_off = shift;
+}
+
+
+sub child_init {
+	OpenSRF::System->bootstrap_client( config_file => $bootstrap );
+}
+
+sub handler {
+	my $apache = shift;
+
+	my $proxyhtml = $apache->dir_config('OILSProxyHTML');
+	my $title = $apache->dir_config('OILSProxyTitle');
+	my $desc = $apache->dir_config('OILSProxyDescription');
+	my $ltype = $apache->dir_config('OILSProxyLoginType');
+	my $perms = [ split ' ', $apache->dir_config('OILSProxyPermissions') ];
+
+	return Apache2::Const::NOT_FOUND unless ($title || $proxyhtml);
+	return Apache2::Const::NOT_FOUND unless (@$perms);
+
+	my $cgi = new CGI;
+	my $auth_ses = $cgi->cookie('ses') || $cgi->param('ses');
+	my $ws_ou = $apache->dir_config('OILSProxyLoginOU') || $cgi->cookie('ws_ou') || $cgi->param('ws_ou');
+
+	my $url = $cgi->url;
+
+	# push everyone to the secure site
+	if (!$ssl_off && $url =~ /^http:/o) {
+        my $base = $cgi->url(-base=>1);
+		$base =~ s/^http:/https:/o;
+		print "Location: $base".$apache->unparsed_uri."\n\n";
+		return Apache2::Const::REDIRECT;
+	}
+
+	if (!$auth_ses) {
+		my $u = $cgi->param('user');
+		my $p = $cgi->param('passwd');
+
+		if (!$u) {
+
+			print $cgi->header(-type=>'text/html', -expires=>'-1d');
+			if (!$proxyhtml) {
+				$proxyhtml = $default_template;
+				$proxyhtml =~ s/TITLE/$title/gso;
+				$proxyhtml =~ s/DESCRIPTION/$desc/gso;
+			} else {
+				# XXX template toolkit??
+			}
+
+			print $proxyhtml;
+			return Apache2::Const::OK;
+		}
+
+		$auth_ses = oils_login($u, $p, $ltype);
+		if ($auth_ses) {
+			print $cgi->redirect(
+				-uri=> $apache->unparsed_uri,
+				-cookie=>$cgi->cookie(
+					-name=>'ses',
+					-value=>$auth_ses,
+					-path=>'/'
+				)
+			);
+			return Apache2::Const::REDIRECT;
+		} else {
+            return back_to_login($apache, $cgi);
+        }
+	}
+
+	my $user = verify_login($auth_ses);
+    return back_to_login($apache, $cgi) unless $user;
+
+	$ws_ou ||= $user->home_ou;
+
+	warn "Checking perms " . join(',', @$perms) . " for user " . $user->id . " at location $ws_ou\n";
+
+	my $failures = OpenSRF::AppSession
+		->create('open-ils.actor')
+		->request('open-ils.actor.user.perm.check', $auth_ses, $user->id, $ws_ou, $perms)
+		->gather(1);
+
+	return back_to_login($apache, $cgi) if (@$failures > 0);
+
+	# they're good, let 'em through
+	return Apache2::Const::DECLINED;
+}
+
+sub back_to_login {
+    my $apache = shift;
+    my $cgi = shift;
+    print $cgi->redirect(
+        -uri=>$apache->unparsed_uri,
+        -cookie=>$cgi->cookie(
+            -name=>'ses',
+            -value=>'',
+            -path=>'/',-expires=>'-1h'
+        )
+    );
+    return Apache2::Const::REDIRECT;
+}
+
+# returns the user object if the session is valid, 0 otherwise
+sub verify_login {
+	my $auth_token = shift;
+	return undef unless $auth_token;
+
+	my $user = OpenSRF::AppSession
+		->create("open-ils.auth")
+		->request( "open-ils.auth.session.retrieve", $auth_token )
+		->gather(1);
+
+	if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) {
+		return undef;
+	}
+
+	return $user if ref($user);
+	return undef;
+}
+
+sub oils_login {
+        my( $username, $password, $type ) = @_;
+
+        $type |= "staff";
+	my $nametype = 'username';
+	$nametype = 'barcode' if ($username =~ /^\d+$/o);
+
+        my $seed = OpenSRF::AppSession
+		->create("open-ils.auth")
+		->request( 'open-ils.auth.authenticate.init', $username )
+		->gather(1);
+
+        return undef unless $seed;
+
+        my $response = OpenSRF::AppSession
+		->create("open-ils.auth")
+		->request( 'open-ils.auth.authenticate.complete',
+			{ $nametype => $username,
+			  password => md5_hex($seed . md5_hex($password)),
+			  type => $type })
+		->gather(1);
+
+        return undef unless $response;
+
+        return $response->{payload}->{authtoken};
+}
+
+1;
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/Redirect.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Redirect.pm
new file mode 100644
index 0000000000..b4854773e6
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Redirect.pm
@@ -0,0 +1,158 @@
+package OpenILS::WWW::Redirect;
+use strict; use warnings;
+
+use Socket;
+use Apache2::Log;
+use Apache2::Const -compile => qw(OK REDIRECT :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use CGI ();
+
+use OpenSRF::AppSession;
+use OpenSRF::System;
+use OpenSRF::Utils::Logger qw/$logger/;
+
+use vars '$lib_ips_hash';
+my $lib_ips_hash;
+
+my $bootstrap_config_file;
+sub import {
+	my( $self, $config ) = @_;
+	$bootstrap_config_file = $config;
+}
+
+sub init {
+	OpenSRF::System->bootstrap_client( config_file => $bootstrap_config_file );
+}
+
+sub parse_ips_file {
+    my $class = shift;
+    my $ips_file = shift;
+
+    if( open(F, $ips_file) ) {
+
+       while( my $data =  ) {
+         chomp($data);
+
+         my( $shortname, $ip1, $ip2 ) = split(/\s+/, $data);
+         next unless ($shortname and $ip1 and $ip2);
+
+         $lib_ips_hash->{$shortname} = [] unless $lib_ips_hash->{$shortname};
+         push( @{$lib_ips_hash->{$shortname}}, [ $ip1, $ip2 ] );
+       }
+
+       close(F);
+
+    } else {
+        $logger->error("Unable to open lib IP redirector file $ips_file");
+    }
+}
+
+
+sub handler {
+
+	my $user_ip = $ENV{REMOTE_ADDR};
+	my $apache_obj = shift;
+	my $cgi = CGI->new( $apache_obj );
+
+
+	my $skin = $apache_obj->dir_config('OILSRedirectSkin') || 'default';
+	my $depth = $apache_obj->dir_config('OILSRedirectDepth');
+	my $locale = $apache_obj->dir_config('OILSRedirectLocale') || 'en-US';
+
+	my $hostname = $cgi->server_name();
+	my $port		= $cgi->server_port();
+
+	my $proto = "http";
+	if($cgi->https) { $proto = "https"; }
+
+	my $url = "$proto://$hostname:$port/opac/$locale/skin/$skin/xml/index.xml";
+
+	my $path = $apache_obj->path_info();
+
+	$logger->debug("Apache client connecting from $user_ip");
+
+	if(my $shortname = redirect_libs($user_ip)) {
+
+		$logger->info("Apache redirecting $user_ip to $shortname");
+		my $session = OpenSRF::AppSession->create("open-ils.actor");
+
+		my $org = $session->request(
+            'open-ils.actor.org_unit.retrieve_by_shortname',
+			 $shortname)->gather(1);
+
+		if($org) { 
+            $url .= "?ol=" . $org->id; 
+            $url .= "&d=$depth" if defined $depth;
+        }
+	}
+
+	print "Location: $url\n\n"; 
+	return Apache2::Const::REDIRECT;
+
+	return print_page($url);
+}
+
+sub redirect_libs {
+	my $source_ip = shift;
+	my $aton_binary = inet_aton( $source_ip );
+
+    return 0 unless $aton_binary;
+
+	# do this the linear way for now...
+	for my $shortname (keys %$lib_ips_hash) {
+
+        for my $block (@{$lib_ips_hash->{$shortname}}) {
+
+            if(defined($block->[0]) && defined($block->[1]) ) {
+                my $start_binary	= inet_aton( $block->[0] );
+                my $end_binary		= inet_aton( $block->[1] );
+                next unless( $start_binary and $end_binary );
+                if( $start_binary le $aton_binary and
+                        $end_binary ge $aton_binary ) {
+                    return $shortname;
+                }
+            }
+        }
+	}
+	return 0;
+}
+
+
+sub print_page {
+
+	my $url = shift;
+
+	print "Content-type: text/html; charset=utf-8\n\n";
+	print <<"	HTML";
+	
+		
+			 
+			
+		
+		
+			


+			

+				
Loading...

+			

+			


+			

+		
+	
+	HTML
+
+	return Apache2::Const::OK;
+}
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/Reporter.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Reporter.pm
new file mode 100644
index 0000000000..573bcd499a
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Reporter.pm
@@ -0,0 +1,159 @@
+package OpenILS::WWW::Reporter;
+use strict; use warnings;
+
+use vars qw/$dtype_xform_map $dtype_xform/;
+
+use Apache2::Log;
+use Apache2::Const -compile => qw(OK REDIRECT DECLINED :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::RequestUtil;
+use CGI;
+use Data::Dumper;
+
+use Template;
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::System;
+use XML::LibXML;
+
+use OpenSRF::Utils::SettingsParser;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::WWW::Reporter::transforms;
+
+
+# set the bootstrap config and template include directory when 
+# this module is loaded
+my $bootstrap;
+my $includes = [];  
+my $base_xml;
+#my $base_xml_doc;
+
+sub import {
+	my( $self, $bs_config, $core_xml, @incs ) = @_;
+	$bootstrap = $bs_config;
+	$base_xml = $core_xml;
+	$includes = [ @incs ];
+}
+
+
+# our templates plugins are here
+my $plugin_base = 'OpenILS::Template::Plugin';
+
+sub child_init {
+	OpenSRF::System->bootstrap_client( config_file => $bootstrap );
+
+	#parse the base xml file
+	#my $parser = XML::LibXML->new;
+	#$parser->expand_xinclude(1);
+
+	#$base_xml_doc = $parser->parse_file($base_xml);
+
+}
+
+sub handler {
+
+	my $apache = shift;
+	return Apache2::Const::DECLINED if (-e $apache->filename);
+
+	my $cgi = CGI->new;
+
+	my $path = $apache->path_info;
+	(my $ttk = $path) =~ s{^/?([a-zA-Z0-9_]+).*?$}{$1}o;
+
+	$ttk = $apache->filename unless $ttk;
+	$ttk = "dashboard" unless $ttk;
+
+	$ttk = (split '/', $ttk)[-1];
+	
+	my $user;
+
+	# if the user is not logged in via cookie, route them to the login page
+	if(! ($user = verify_login($cgi->cookie("ses"))) ) {
+		$ttk = "login";
+	}
+
+
+	print "Content-type: text/html; charset=utf-8\n\n";
+	#print "Content-type: text/html\n\n";
+
+	_process_template(
+			apache		=> $apache,
+			template		=> "$ttk.ttk",
+			params		=> { 
+				user => $user, 
+				stage_dir => $ttk, 
+				config_xml => $base_xml, 
+				},
+			);
+
+	return Apache2::Const::OK;
+}
+
+
+sub _process_template {
+
+	my %params = @_;
+	my $ttk				= $params{template}		|| return undef;
+	my $apache			= $params{apache}			|| undef;
+	my $param_hash		= $params{params}			|| {};
+	$$param_hash{dtype_xform_map} = $OpenILS::WWW::Reporter::dtype_xform_map;
+	$$param_hash{dtype_xforms} = $OpenILS::WWW::Reporter::dtype_xforms;
+
+	my $template;
+
+	$template = Template->new( { 
+		OUTPUT			=> $apache, 
+		ABSOLUTE		=> 1, 
+		RELATIVE		=> 1,
+		PLUGIN_BASE		=> $plugin_base,
+		INCLUDE_PATH	=> $includes, 
+		PRE_CHOMP		=> 1,
+		POST_CHOMP		=> 1,
+		#LOAD_PERL		=> 1,
+		} 
+	);
+
+	try {
+
+		if( ! $template->process( $ttk, $param_hash ) ) { 
+			warn  "Error Processing Template: " . $template->error();
+			my $err = $template->error();
+			$err =~ s/\n/\/g;
+			warn "Error processing template $ttk\n";	
+			my $string =  "
Unable to process template:

 " . $err . "";
+			print "ERROR: $string";
+			#$template->process( $error_ttk , { error => $string } );
+		}
+
+	} catch Error with {
+		my $e = shift;
+		warn "Error processing template $ttk:  $e - $@ \n";	
+		print "


Error

 $e 

 $@ 
";
+		return;
+	};
+
+}
+
+# returns the user object if the session is valid, 0 otherwise
+sub verify_login {
+	my $auth_token = shift;
+	return 0 unless $auth_token;
+
+	my $session = OpenSRF::AppSession->create("open-ils.auth");
+	my $req = $session->request(
+		"open-ils.auth.session.retrieve", $auth_token );
+	my $user = $req->gather(1);
+
+	if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) {
+		return 0;
+	}
+
+	return $user if ref($user);
+	return 0;
+}
+
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/Reporter/transforms.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Reporter/transforms.pm
new file mode 100644
index 0000000000..8123d15c41
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Reporter/transforms.pm
@@ -0,0 +1,87 @@
+#!/usr/bin/perl
+
+package OpenILS::WWW::Reporter;
+
+our $dtype_xform_map = {
+        'int'                   => [ 'avg','stddev','sum','count','count_dist','numformat'],
+        'numeric'       => [ 'avg','stddev','sum','count','count_dist','numformat'],
+        'float' => [ 'avg','stddev','sum','count','count_dist','numformat'],
+        'time'  => [ 'count', 'dateformat'],
+        'date'  => [ 'count', 'age','dateformat'],
+        'timestamp'     => [ 'count', 'age','dateformat'],
+        'timestamptz'   => [ 'count', 'age','dateformat'],
+        'text'  => [ 'count','count_dist','lower','upper','substr'],
+        'call_number'  => [ 'count','count_dist','dewy','dewy_prefix','count_dist_dewey','count_dist_dewey_prefix','lower','upper','substr'],
+};
+
+
+
+our $dtype_xforms = {
+        'avg'           => { 
+                'name'  => 'Average per group',
+                'select'        => 'AVG(?COLNAME?)',
+                'group' => 0 },
+        'stddev'        => {
+                'label' => 'Standard Deviation per group',
+                'select'        => 'STDDEV(?COLNAME?)',
+                'group' => 0 },
+        'sum'           => {
+                'label' => 'Sum per group',
+                'select'        => 'SUM(?COLNAME?)',
+                'group' => 0 }, 
+        'count'         => {    
+                'label' => 'Count per group',
+                'select'        => 'COUNT(?COLNAME?)',
+                'group' => 0 },
+        'count_dist'            => {
+                'label' => 'Distinct Count per group',
+                'select'        => 'COUNT(DISTINCT ?COLNAME?)',
+                'group' => 0 }, 
+        'count_dist_dewey'      => {
+                'label' => 'Distinct Count of Dewey numbers per group',
+                'select'        => 'COUNT(DISTINCT call_number_dewey(?COLNAME?))',
+                'group' => 1 }, 
+        'count_dist_dewey_prefix'=> {
+                'label' => 'Distinct Count of Dewey Number Prefixes per group',
+                'select'        => 'COUNT(DISTINCT call_number_dewey(?COLNAME?,?PARAM?))',
+                'param' => 1,           
+                'group' => 1 }, 
+        'dewy_prefix'         => {    
+                'label' => 'Extract Dewey number prefix from call number',
+                'select'        => 'call_number_dewey(?COLNAME?,?PARAM?)',
+                'param' => 1,           
+                'group' => 1 },
+        'dewy'         => {    
+                'label' => 'Extract Dewey number from call number',
+                'select'        => 'call_number_dewey(?COLNAME?)',
+                'group' => 1 },
+        'lower'         => {    
+                'label' => 'Transform string to lower case',
+                'select'        => 'LOWER(?COLNAME?)',
+                'group' => 1 },
+        'upper'         => {
+                'label' => 'Transform string to upper case',
+                'select'        => 'UPPER(?COLNAME?)',
+                'group' => 1 }, 
+        'substr'                => {
+                'label' => 'Trim string length',
+                'select'        => 'substr(?COLNAME?,1,?PARAM?)',
+                'param' => 1,           
+                'group' => 1 },                 
+        'age'           => {            
+                'label' => 'Age as of runtime -- day granularity',
+                'select'        => 'AGE(?COLNAME?::DATE)',
+                'group' => 1 },
+        'dateformat'            => { # see http://www.postgresql.org/docs/8.0/interactive/functions-formatting.html
+                'label' => 'Format date and time',
+                'select'        => "TO_CHAR(?COLNAME?,'?PARAM?')",
+                'param' => 1,           
+                'group' => 1 },                 
+        'numformat'             => { # see http://www.postgresql.org/docs/8.0/interactive/functions-formatting.html
+                'label' => 'Format Numeric data',
+                'select'        => "TO_CHAR(?COLNAME?,'?PARAM?')",
+                'param' => 1,                           
+                'group' => 1 },                         
+};                                      
+
+;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/SuperCat.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/SuperCat.pm
new file mode 100644
index 0000000000..040b88897e
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/SuperCat.pm
@@ -0,0 +1,2088 @@
+package OpenILS::WWW::SuperCat;
+use strict; use warnings;
+
+use Apache2::Log;
+use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::RequestUtil;
+use CGI;
+use Data::Dumper;
+use SRU::Request;
+use SRU::Response;
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::Utils qw/:datetime/;
+use OpenSRF::Utils::Cache;
+use OpenSRF::System;
+use OpenSRF::AppSession;
+use XML::LibXML;
+use XML::LibXSLT;
+
+use Encode;
+use Unicode::Normalize;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::WWW::SuperCat::Feed;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenILS::Application::AppUtils;
+
+use MARC::Record;
+use MARC::File::XML;
+
+my $log = 'OpenSRF::Utils::Logger';
+my $U = 'OpenILS::Application::AppUtils';
+
+# set the bootstrap config when this module is loaded
+my ($bootstrap, $supercat, $actor, $parser, $search, $xslt, $cn_browse_xslt, %browse_types);
+
+$browse_types{call_number}{xml} = sub {
+	my $tree = shift;
+
+	my $year = (gmtime())[5] + 1900;
+	my $content = '';
+
+	$content .= "\n";
+
+	for my $cn (@$tree) {
+		(my $cn_class = $cn->class_name) =~ s/::/-/gso;
+		$cn_class =~ s/Fieldmapper-//gso;
+
+		my $cn_tag = "tag:open-ils.org,$year:$cn_class/".$cn->id;
+		my $cn_lib = $cn->owning_lib->shortname;
+		my $cn_label = $cn->label;
+
+		$cn_label =~ s/\n//gos;
+		$cn_label =~ s/&/&/go;
+		$cn_label =~ s/'/'/go;
+		$cn_label =~ s//>/go;
+
+		(my $ou_class = $cn->owning_lib->class_name) =~ s/::/-/gso;
+		$ou_class =~ s/Fieldmapper-//gso;
+
+		my $ou_tag = "tag:open-ils.org,$year:$ou_class/".$cn->owning_lib->id;
+		my $ou_name = $cn->owning_lib->name;
+
+		$ou_name =~ s/\n//gos;
+		$ou_name =~ s/'/'/go;
+
+		(my $rec_class = $cn->record->class_name) =~ s/::/-/gso;
+		$rec_class =~ s/Fieldmapper-//gso;
+
+		my $rec_tag = "tag:open-ils.org,$year:$rec_class/".$cn->record->id.'/'.$cn->owning_lib->shortname;
+
+		$content .= "\n";
+		$content .= "\n";
+
+		my $r_doc = $parser->parse_string($cn->record->marc);
+		$r_doc->documentElement->setAttribute( id => $rec_tag );
+		$content .= $U->entityize($r_doc->documentElement->toString);
+
+		$content .= "\n";
+	}
+
+	$content .= "\n";
+	return ("Content-type: application/xml\n\n",$content);
+};
+
+
+$browse_types{call_number}{html} = sub {
+	my $tree = shift;
+	my $p = shift;
+	my $n = shift;
+
+	if (!$cn_browse_xslt) {
+	        $cn_browse_xslt = $parser->parse_file(
+        	        OpenSRF::Utils::SettingsClient
+                	        ->new
+                        	->config_value( dirs => 'xsl' ).
+	                "/CNBrowse2HTML.xsl"
+        	);
+		$cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
+	}
+
+	my (undef,$xml) = $browse_types{call_number}{xml}->($tree);
+
+	return (
+		"Content-type: text/html\n\n",
+		$U->entityize(
+			$cn_browse_xslt->transform(
+				$parser->parse_string( $xml ),
+				'prev' => "'$p'",
+				'next' => "'$n'"
+			)->toString(1)
+		)
+	);
+};
+
+sub import {
+	my $self = shift;
+	$bootstrap = shift;
+}
+
+
+sub child_init {
+	OpenSRF::System->bootstrap_client( config_file => $bootstrap );
+	
+	my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
+	Fieldmapper->import(IDL => $idl);
+
+	$supercat = OpenSRF::AppSession->create('open-ils.supercat');
+	$actor = OpenSRF::AppSession->create('open-ils.actor');
+	$search = OpenSRF::AppSession->create('open-ils.search');
+	$parser = new XML::LibXML;
+	$xslt = new XML::LibXSLT;
+
+        $cn_browse_xslt = $parser->parse_file(
+                OpenSRF::Utils::SettingsClient
+                        ->new
+                        ->config_value( dirs => 'xsl' ).
+                "/CNBrowse2HTML.xsl"
+        );
+
+	$cn_browse_xslt = $xslt->parse_stylesheet( $cn_browse_xslt );
+
+	my $list = $supercat
+		->request("open-ils.supercat.record.formats")
+		->gather(1);
+
+    $list = [ map { (keys %$_)[0] } @$list ];
+    push @$list, 'htmlholdings','html', 'marctxt', 'ris';
+
+    for my $browse_axis ( qw/title author subject topic series item-age/ ) {
+        for my $record_browse_format ( @$list ) {
+            {
+                my $__f = $record_browse_format;
+                my $__a = $browse_axis;
+
+                $browse_types{$__a}{$__f} = sub {
+                	my $record_list = shift;
+                	my $prev = shift;
+                	my $next = shift;
+                	my $real_format = shift || $__f;
+                	my $unapi = shift;
+                	my $base = shift;
+                	my $site = shift;
+
+					$log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
+                	my $feed = create_record_feed( 'record', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /(-full|-uris)$/o ? 1 : 0 );
+                	$feed->root( "$base/../" );
+                	$feed->lib( $site );
+                	$feed->link( next => $next => $feed->type );
+                	$feed->link( previous => $prev => $feed->type );
+
+                	return (
+                        "Content-type: ". $feed->type ."; charset=utf-8\n\n",
+                        $feed->toString
+                    );
+                };
+            }
+        }
+    }
+
+    for my $basic_axis ( qw/authority.title authority.author authority.subject authority.topic/ ) {
+        for my $browse_axis ( ($basic_axis, $basic_axis . ".refs") ) {
+            {
+                my $__f = 'marcxml';
+                my $__a = $browse_axis;
+
+                $browse_types{$__a}{$__f} = sub {
+                	my $record_list = shift;
+                	my $prev = shift;
+                	my $next = shift;
+                	my $real_format = shift || $__f;
+                	my $unapi = shift;
+                	my $base = shift;
+                	my $site = shift;
+
+					$log->info("Creating record feed with params [$real_format, $record_list, $unapi, $site]");
+                	my $feed = create_record_feed( 'authority', $real_format, $record_list, $unapi, $site, undef, $real_format =~ /-full$/o ? -1 : 0 );
+                	$feed->root( "$base/../" );
+                	$feed->link( next => $next => $feed->type );
+                	$feed->link( previous => $prev => $feed->type );
+
+                	return (
+                        "Content-type: ". $feed->type ."; charset=utf-8\n\n",
+                        $feed->toString
+                    );
+                };
+            }
+        }
+    }
+}
+
+=head2 parse_feed_type($type)
+
+Determines whether and how a given feed type needs to be "fleshed out"
+with holdings information.
+
+The feed type could end with the string "-full", in which case we want
+to return call numbers, copies, and URIS.
+
+Or the feed type could be "-uris", in which case we want to return
+call numbers and URIS.
+
+Otherwise, we won't return any holdings.
+
+=cut
+
+sub parse_feed_type {
+	my $type = shift;
+
+ 	if ($type =~ /-full$/o) {
+		return 1;
+	}
+
+ 	if ($type =~ /-uris$/o) {
+		return "uris";
+	}
+
+	# Otherwise, we'll return just the facts, ma'am
+	return 0;
+}
+
+=head2 supercat_format($format_hashref, $format_type)
+
+Given a reference to a hash containing the namespace_uri,
+docs, and schema location attributes for a set of formats,
+generate the XML description required by the supercat service.
+
+We derive the base type from the format type so that we do not
+have to populate the hash with redundant information.
+
+=cut
+
+sub supercat_format {
+	my $h = shift;
+	my $type = shift;
+
+	(my $base_type = $type) =~ s/(-full|-uris)$//o;
+
+	my $format = "$typeapplication/xml";
+
+	for my $part ( qw/namespace_uri docs schema_location/ ) {
+		$format .= "<$part>$$h{$base_type}{$part}"
+			if ($$h{$base_type}{$part});
+	}
+
+	$format .= '';
+
+	return $format;
+}
+
+=head2 unapi_format($format_hashref, $format_type)
+
+Given a reference to a hash containing the namespace_uri,
+docs, and schema location attributes for a set of formats,
+generate the XML description required by the supercat service.
+
+We derive the base type from the format type so that we do not
+have to populate the hash with redundant information.
+
+=cut
+
+sub unapi_format {
+	my $h = shift;
+	my $type = shift;
+
+	(my $base_type = $type) =~ s/(-full|-uris)$//o;
+
+	my $format = "filename);
+
+	(my $isbn = $apache->path_info) =~ s{^.*?([^/]+)$}{$1}o;
+
+	my $list = $supercat
+		->request("open-ils.supercat.oisbn", $isbn)
+		->gather(1);
+
+	print "Content-type: application/xml; charset=utf-8\n\n";
+	print "\n";
+
+	unless (exists $$list{metarecord}) {
+		print '';
+		return Apache2::Const::OK;
+	}
+
+	print "\n";
+
+	for ( keys %{ $$list{record_list} } ) {
+		(my $o = $$list{record_list}{$_}) =~s/^(\S+).*?$/$1/o;
+		print "  $o\n"
+	}
+
+	print "\n";
+
+	return Apache2::Const::OK;
+}
+
+sub unapi {
+
+	my $apache = shift;
+	return Apache2::Const::DECLINED if (-e $apache->filename);
+
+	my $cgi = new CGI;
+
+	my $add_path = 0;
+	if ( $cgi->server_software !~ m|^Apache/2.2| ) {
+		my $rel_name = $cgi->url(-relative=>1);
+		$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
+	}
+
+	my $url = $cgi->url(-path_info=>$add_path);
+	my $root = (split 'unapi', $url)[0];
+	my $base = (split 'unapi', $url)[0] . 'unapi';
+
+
+	my $uri = $cgi->param('id') || '';
+	my $host = $cgi->virtual_host || $cgi->server_name;
+
+	my $skin = $cgi->param('skin') || 'default';
+	my $locale = $cgi->param('locale') || 'en-US';
+
+	# Enable localized results of copy status, etc
+	$supercat->session_locale($locale);
+
+	my $format = $cgi->param('format');
+	my $flesh_feed = parse_feed_type($format);
+	(my $base_format = $format) =~ s/(-full|-uris)$//o;
+	my ($id,$type,$command,$lib,$depth,$paging) = ('','','');
+
+	if (!$format) {
+		my $body = "Content-type: application/xml; charset=utf-8\n\n";
+	
+		if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
+			$id = $2;
+			$paging = $3;
+			($lib,$depth) = split('/', $4);
+			$type = 'record';
+			$type = 'metarecord' if ($1 =~ /^m/o);
+			$type = 'authority' if ($1 =~ /^authority/o);
+
+			my $list = $supercat
+				->request("open-ils.supercat.$type.formats")
+				->gather(1);
+
+			if ($type eq 'record' or $type eq 'isbn') {
+				$body .= <<"				FORMATS";
+
+	
+	
+	
+	
+	
+	
+	
+	
+	
+				FORMATS
+			} elsif ($type eq 'metarecord') {
+				$body .= <<"				FORMATS";
+				
+					
+				FORMATS
+			} else {
+				$body .= <<"				FORMATS";
+				
+				FORMATS
+			}
+
+			for my $h (@$list) {
+				my ($type) = keys %$h;
+				$body .= unapi_format($h, $type);
+
+				if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
+					$body .= unapi_format($h, "$type-full");
+					$body .= unapi_format($h, "$type-uris");
+				}
+			}
+
+			$body .= "\n";
+
+		} else {
+			my $list = $supercat
+				->request("open-ils.supercat.$type.formats")
+				->gather(1);
+				
+			push @$list,
+				@{ $supercat
+					->request("open-ils.supercat.metarecord.formats")
+					->gather(1);
+				};
+
+			my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
+			$list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
+
+			$body .= <<"			FORMATS";
+
+	
+	
+	
+	
+	
+	
+	
+	
+	
+			FORMATS
+
+
+			for my $h (@$list) {
+				my ($type) = keys %$h;
+				$body .= "\t" . unapi_format($h, $type);
+
+				if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
+					$body .= "\t" . unapi_format($h, "$type-full");
+					$body .= "\t" . unapi_format($h, "$type-uris");
+				}
+			}
+
+			$body .= "\n";
+
+		}
+		print $body;
+		return Apache2::Const::OK;
+	}
+
+	my $scheme;
+	if ($uri =~ m{^tag:[^:]+:([^\/]+)/([^\/[]+)(?:\[([0-9,]+)\])?(?:/(.+))?}o) {
+		$scheme = $1;
+		$id = $2;
+		$paging = $3;
+		($lib,$depth) = split('/', $4);
+		$type = 'record';
+		$type = 'metarecord' if ($scheme =~ /^metabib/o);
+		$type = 'isbn' if ($scheme =~ /^isbn/o);
+		$type = 'acp' if ($scheme =~ /^asset-copy/o);
+		$type = 'acn' if ($scheme =~ /^asset-call_number/o);
+		$type = 'auri' if ($scheme =~ /^asset-uri/o);
+		$type = 'authority' if ($scheme =~ /^authority/o);
+		$command = 'retrieve';
+		$command = 'browse' if (grep { $scheme eq $_ } qw/call_number title author subject topic authority.title authority.author authority.subject authority.topic series item-age/);
+	}
+
+    if ($paging) {
+        $paging = [split ',', $paging];
+    } else {
+        $paging = [];
+    }
+
+	if (!$lib || $lib eq '-') {
+	 	$lib = $actor->request(
+			'open-ils.actor.org_unit_list.search' => parent_ou => undef
+		)->gather(1)->[0]->shortname;
+	}
+
+	my ($lib_object,$lib_id,$ou_types,$lib_depth);
+	if ($type ne 'acn' && $type ne 'acp' && $type ne 'auri') {
+		$lib_object = $actor->request(
+			'open-ils.actor.org_unit_list.search' => shortname => $lib
+		)->gather(1)->[0];
+		$lib_id = $lib_object->id;
+
+		$ou_types = $actor->request( 'open-ils.actor.org_types.retrieve' )->gather(1);
+		$lib_depth = $depth || (grep { $_->id == $lib_object->ou_type } @$ou_types)[0]->depth;
+	}
+
+	if ($command eq 'browse') {
+		print "Location: $root/browse/$base_format/$scheme/$lib/$id\n\n";
+		return 302;
+	}
+
+	if ($type eq 'isbn') {
+		my $rec = $supercat->request('open-ils.supercat.isbn.object.retrieve',$id)->gather(1);
+		if (!@$rec) {
+			print "Content-type: text/html; charset=utf-8\n\n";
+			$apache->custom_response( 404, <<"			HTML");
+			
+				
+					Type [$type] with id [$id] not found!
+				
+				
+					

+					
Sorry, we couldn't $command a $type with the id of $id in format $format.

+				
+			
+			HTML
+			return 404;
+		}
+		$id = $rec->[0]->id;
+		$type = 'record';
+	}
+
+	if ( !grep
+		   { (keys(%$_))[0] eq $base_format }
+		   @{ $supercat->request("open-ils.supercat.$type.formats")->gather(1) }
+		 and !grep
+		   { $_ eq $base_format }
+		   qw/opac html htmlholdings marctxt ris holdings_xml/
+	) {
+		print "Content-type: text/html; charset=utf-8\n\n";
+		$apache->custom_response( 406, <<"		HTML");
+		
+			
+				Invalid format [$format] for type [$type]!
+			
+			
+				

+				
Sorry, format $format is not valid for type $type.

+			
+		
+		HTML
+		return 406;
+	}
+
+	if ($format eq 'opac') {
+		print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id&l=$lib_id&d=$lib_depth\n\n"
+			if ($type eq 'metarecord');
+		print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id&l=$lib_id&d=$lib_depth\n\n"
+			if ($type eq 'record');
+		return 302;
+	} elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format) && ($type ne 'acn' && $type ne 'acp' && $type ne 'auri')) {
+		my $feed = create_record_feed(
+			$type,
+			$format => [ $id ],
+			$base,
+			$lib,
+			$depth,
+			$flesh_feed,
+            $paging
+		);
+
+		if (!$feed->count) {
+			print "Content-type: text/html; charset=utf-8\n\n";
+			$apache->custom_response( 404, <<"			HTML");
+			
+				
+					Type [$type] with id [$id] not found!
+				
+				
+					

+					
Sorry, we couldn't $command a $type with the id of $id in format $format.

+				
+			
+			HTML
+			return 404;
+		}
+
+		$feed->root($root);
+		$feed->creator($host);
+		$feed->update_ts();
+		$feed->link( unapi => $base) if ($flesh_feed);
+
+		print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
+		print $U->entityize($feed->toString) . "\n";
+
+		return Apache2::Const::OK;
+	}
+
+	my $method = "open-ils.supercat.$type.$base_format.$command";
+	my @params = ($id);
+	push @params, $lib, $lib_depth, $flesh_feed, $paging if ($base_format eq 'holdings_xml');
+
+	# for acn, acp, etc, the "lib" pathinfo position isn't useful.
+	# however, we can have it carry extra options like no_record! (comma separated)
+	push @params, { map { ( $_ => 1 ) } split(',', $lib) } if ( grep { $type eq $_} qw/acn acp auri/);
+
+	my $req = $supercat->request($method,@params);
+	my $data = $req->gather();
+
+	if ($req->failed || !$data) {
+		print "Content-type: text/html; charset=utf-8\n\n";
+		$apache->custom_response( 404, <<"		HTML");
+		
+			
+				$type $id not found!
+			
+			
+				

+				
Sorry, we couldn't $command a $type with the id of $id in format $format.

+			
+		
+		HTML
+		return 404;
+	}
+
+	print "Content-type: application/xml; charset=utf-8\n\n$data";
+
+	if ($base_format eq 'holdings_xml') {
+		while (my $c = $req->recv) {
+			print $c->content;
+		}
+	}
+
+	return Apache2::Const::OK;
+}
+
+sub supercat {
+
+	my $apache = shift;
+	return Apache2::Const::DECLINED if (-e $apache->filename);
+
+	my $cgi = new CGI;
+
+	my $add_path = 0;
+	if ( $cgi->server_software !~ m|^Apache/2.2| ) {
+		my $rel_name = $cgi->url(-relative=>1);
+		$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
+	}
+
+	my $url = $cgi->url(-path_info=>$add_path);
+	my $root = (split 'supercat', $url)[0];
+	my $base = (split 'supercat', $url)[0] . 'supercat';
+	my $unapi = (split 'supercat', $url)[0] . 'unapi';
+
+	my $host = $cgi->virtual_host || $cgi->server_name;
+
+	my $path = $cgi->path_info;
+	my ($id,$type,$format,$command) = reverse split '/', $path;
+	my $flesh_feed = parse_feed_type($format);
+	(my $base_format = $format) =~ s/(-full|-uris)$//o;
+
+	my $skin = $cgi->param('skin') || 'default';
+	my $locale = $cgi->param('locale') || 'en-US';
+
+	# Enable localized results of copy status, etc
+	$supercat->session_locale($locale);
+	
+	if ( $path =~ m{^/formats(?:/([^\/]+))?$}o ) {
+		print "Content-type: application/xml; charset=utf-8\n";
+		if ($1) {
+			my $list = $supercat
+				->request("open-ils.supercat.$1.formats")
+				->gather(1);
+
+			print "\n";
+
+			print "
+				   
+				     opac
+				     text/html
+				   ";
+
+			if ($1 eq 'record' or $1 eq 'isbn') {
+				print "
+				     htmlholdings
+				     text/html
+				   
+				   
+				     html
+				     text/html
+				   
+				   
+				     htmlholdings-full
+				     text/html
+				   
+				   
+				     html-full
+				     text/html
+				   
+				   
+				     marctxt
+				     text/plain
+				   
+				   
+				     ris
+				     text/plain
+				   ";
+			}
+
+			for my $h (@$list) {
+				my ($type) = keys %$h;
+				print supercat_format($h, $type);
+
+				if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
+					print supercat_format($h, "$type-full");
+					print supercat_format($h, "$type-uris");
+				}
+
+			}
+
+			print "\n";
+
+			return Apache2::Const::OK;
+		}
+
+		my $list = $supercat
+			->request("open-ils.supercat.record.formats")
+			->gather(1);
+				
+		push @$list,
+			@{ $supercat
+				->request("open-ils.supercat.metarecord.formats")
+				->gather(1);
+			};
+
+		my %hash = map { ( (keys %$_)[0] => (values %$_)[0] ) } @$list;
+		$list = [ map { { $_ => $hash{$_} } } sort keys %hash ];
+
+		print "\n
+			   
+			     opac
+			     text/html
+			   
+			   
+			     htmlholdings
+			     text/html
+			   
+			   
+			     html
+			     text/html
+			   
+			   
+			     htmlholdings-full
+			     text/html
+			   
+			   
+			     html-full
+			     text/html
+			   
+			   
+			     marctxt
+			     text/plain
+			   
+			   
+			     ris
+			     text/plain
+			   ";
+
+		for my $h (@$list) {
+			my ($type) = keys %$h;
+			print supercat_format($h, $type);
+
+			if (OpenILS::WWW::SuperCat::Feed->exists($type)) {
+				print supercat_format($h, "$type-full");
+				print supercat_format($h, "$type-uris");
+			}
+
+		}
+
+		print "\n";
+
+
+		return Apache2::Const::OK;
+	}
+
+	if ($format eq 'opac') {
+		print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?m=$id\n\n"
+			if ($type eq 'metarecord');
+		print "Location: $root/../../$locale/skin/$skin/xml/rdetail.xml?r=$id\n\n"
+			if ($type eq 'record');
+		return 302;
+
+	} elsif ($base_format eq 'marc21') {
+
+		my $ret = 200;    
+		try {
+			my $bib = $supercat->request( "open-ils.supercat.record.object.retrieve", $id )->gather(1)->[0];
+        
+			print "Content-type: application/octet-stream\n\n" . MARC::Record->new_from_xml( $bib->marc, 'UTF-8', 'USMARC' )->as_usmarc;
+
+		} otherwise {
+			warn shift();
+			
+			print "Content-type: text/html; charset=utf-8\n\n";
+			$apache->custom_response( 404, <<"			HTML");
+			
+				
+					ERROR
+				
+				
+					

+					
Couldn't fetch $id as MARC21.

+				
+			
+			HTML
+			$ret = 404;
+		};
+
+		return Apache2::Const::OK;
+
+	} elsif (OpenILS::WWW::SuperCat::Feed->exists($base_format)) {
+		my $feed = create_record_feed(
+			$type,
+			$format => [ $id ],
+			undef, undef, undef,
+			$flesh_feed
+		);
+
+		$feed->root($root);
+		$feed->creator($host);
+
+		$feed->update_ts();
+
+		$feed->link( unapi => $base) if ($flesh_feed);
+
+		print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
+		print $U->entityize($feed->toString) . "\n";
+
+		return Apache2::Const::OK;
+	}
+
+	my $req = $supercat->request("open-ils.supercat.$type.$format.$command",$id);
+	$req->wait_complete;
+
+	if ($req->failed) {
+		print "Content-type: text/html; charset=utf-8\n\n";
+		$apache->custom_response( 404, <<"		HTML");
+		
+			
+				$type $id not found!
+			
+			
+				

+				
Sorry, we couldn't $command a $type with the id of $id in format $format.

+			
+		
+		HTML
+		return 404;
+	}
+
+	print "Content-type: application/xml; charset=utf-8\n\n";
+	print $U->entityize( $parser->parse_string( $req->gather(1) )->documentElement->toString );
+
+	return Apache2::Const::OK;
+}
+
+
+sub bookbag_feed {
+	my $apache = shift;
+	return Apache2::Const::DECLINED if (-e $apache->filename);
+
+	my $cgi = new CGI;
+
+	my $year = (gmtime())[5] + 1900;
+	my $host = $cgi->virtual_host || $cgi->server_name;
+
+	my $add_path = 0;
+	if ( $cgi->server_software !~ m|^Apache/2.2| ) {
+		my $rel_name = $cgi->url(-relative=>1);
+		$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
+	}
+
+	my $url = $cgi->url(-path_info=>$add_path);
+	my $root = (split 'feed', $url)[0] . '/';
+	my $base = (split 'bookbag', $url)[0] . '/bookbag';
+	my $unapi = (split 'feed', $url)[0] . '/unapi';
+
+	my $skin = $cgi->param('skin') || 'default';
+	my $locale = $cgi->param('locale') || 'en-US';
+	my $org = $cgi->param('searchOrg');
+
+	# Enable localized results of copy status, etc
+	$supercat->session_locale($locale);
+
+	my $org_unit = get_ou($org);
+	my $scope = "l=" . $org_unit->[0]->id . "&";
+
+	$root =~ s{(?path_info;
+	#warn "URL breakdown: $url -> $root -> $base -> $path -> $unapi";
+
+	my ($id,$type) = reverse split '/', $path;
+	my $flesh_feed = parse_feed_type($type);
+
+	my $bucket = $actor->request("open-ils.actor.container.public.flesh", 'biblio', $id)->gather(1);
+	return Apache2::Const::NOT_FOUND unless($bucket);
+
+	my $bucket_tag = "tag:$host,$year:record_bucket/$id";
+	if ($type eq 'opac') {
+		print "Location: $root/../../$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
+			join('&', map { "rl=" . $_->target_biblio_record_entry } @{ $bucket->items }) .
+			"\n\n";
+		return 302;
+	}
+
+	my $feed = create_record_feed(
+		'record',
+		$type,
+		[ map { $_->target_biblio_record_entry } @{ $bucket->items } ],
+		$unapi,
+		$org_unit->[0]->shortname,
+		undef,
+		$flesh_feed
+	);
+	$feed->root($root);
+	$feed->id($bucket_tag);
+
+	$feed->title("Items in Book Bag [".$bucket->name."]");
+	$feed->creator($host);
+	$feed->update_ts();
+
+	$feed->link(alternate => $base . "/rss2-full/$id" => 'application/rss+xml');
+	$feed->link(atom => $base . "/atom-full/$id" => 'application/atom+xml');
+	$feed->link(html => $base . "/html-full/$id" => 'text/html');
+	$feed->link(unapi => $unapi);
+
+	$feed->link(
+		OPAC =>
+		"http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
+			join('&', map { 'rl=' . $_->target_biblio_record_entry } @{$bucket->items} ),
+		'text/html'
+	);
+
+
+	print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
+	print $U->entityize($feed->toString) . "\n";
+
+	return Apache2::Const::OK;
+}
+
+sub changes_feed {
+	my $apache = shift;
+	return Apache2::Const::DECLINED if (-e $apache->filename);
+
+	my $cgi = new CGI;
+
+	my $year = (gmtime())[5] + 1900;
+	my $host = $cgi->virtual_host || $cgi->server_name;
+
+	my $add_path = 0;
+	if ( $cgi->server_software !~ m|^Apache/2.2| ) {
+		my $rel_name = $cgi->url(-relative=>1);
+		$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
+	}
+
+	my $url = $cgi->url(-path_info=>$add_path);
+	my $root = (split 'feed', $url)[0];
+	my $base = (split 'freshmeat', $url)[0] . '/freshmeat';
+	my $unapi = (split 'feed', $url)[0] . 'unapi';
+
+	my $skin = $cgi->param('skin') || 'default';
+	my $locale = $cgi->param('locale') || 'en-US';
+	my $org = $cgi->param('searchOrg');
+
+	# Enable localized results of copy status, etc
+	$supercat->session_locale($locale);
+
+	my $org_unit = get_ou($org);
+	my $scope = "l=" . $org_unit->[0]->id . "&";
+
+	my $path = $cgi->path_info;
+	#warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
+
+	$path =~ s/^\/(?:feed\/)?freshmeat\///og;
+	
+	my ($type,$rtype,$axis,$limit,$date) = split '/', $path;
+	my $flesh_feed = parse_feed_type($type);
+
+	$limit ||= 10;
+	$limit = 10 if $limit !~ /^\d+$/;
+
+	my $list = $supercat->request("open-ils.supercat.$rtype.record.$axis.recent", $date, $limit)->gather(1);
+
+	#if ($type eq 'opac') {
+	#	print "Location: $root/../../en-US/skin/default/xml/rresult.xml?rt=list&" .
+	#		join('&', map { "rl=" . $_ } @$list) .
+	#		"\n\n";
+	#	return 302;
+	#}
+
+	my $search = 'record';
+	if ($rtype eq 'authority') {
+		$search = 'authority';
+	}
+	my $feed = create_record_feed( $search, $type, $list, $unapi, $org_unit->[0]->shortname, undef, $flesh_feed);
+	$feed->root($root);
+
+	if ($date) {
+		$feed->title("Up to $limit recent $rtype ${axis}s from $date forward");
+	} else {
+		$feed->title("$limit most recent $rtype ${axis}s");
+	}
+
+	$feed->creator($host);
+	$feed->update_ts();
+
+	$feed->link(alternate => $base . "/rss2-full/$rtype/$axis/$limit/$date" => 'application/rss+xml');
+	$feed->link(atom => $base . "/atom-full/$rtype/$axis/$limit/$date" => 'application/atom+xml');
+	$feed->link(html => $base . "/html-full/$rtype/$axis/$limit/$date" => 'text/html');
+	$feed->link(unapi => $unapi);
+
+	$feed->link(
+		OPAC =>
+		"http://$host/opac/$locale/skin/$skin/xml/rresult.xml?$scope" . "rt=list&" .
+			join('&', map { 'rl=' . $_} @$list ),
+		'text/html'
+	);
+
+
+	print "Content-type: ". $feed->type ."; charset=utf-8\n\n";
+	print $U->entityize($feed->toString) . "\n";
+
+	return Apache2::Const::OK;
+}
+
+sub opensearch_osd {
+	my $version = shift;
+	my $lib = shift;
+	my $class = shift;
+	my $base = shift;
+
+	if ($version eq '1.0') {
+		print <
+
+  $base/1.0/$lib/-/$class/?searchTerms={searchTerms}&startPage={startPage}&startIndex={startIndex}&count={count}
+  http://a9.com/-/spec/opensearchrss/1.0/
+  $lib
+  Search $lib
+  Search the $lib OPAC by $class.
+  $lib book library
+  harry+potter
+  Mike Rylander for GPLS/PINES
+  feedback\@open-ils.org
+  open
+  false
+
+OSD
+	} else {
+		print <
+
+  $lib
+  Search the $lib OPAC by $class.
+  $lib book library
+  
+  
+  
+  
+  
+  
+  Search $lib
+  
+  Mike Rylander for GPLS/PINES
+  feedback\@open-ils.org
+  open
+  false
+  en-US
+  UTF-8
+  UTF-8
+
+OSD
+	}
+
+	return Apache2::Const::OK;
+}
+
+sub opensearch_feed {
+	my $apache = shift;
+	return Apache2::Const::DECLINED if (-e $apache->filename);
+
+	my $cgi = new CGI;
+	my $year = (gmtime())[5] + 1900;
+
+	my $host = $cgi->virtual_host || $cgi->server_name;
+
+	my $add_path = 0;
+	if ( $cgi->server_software !~ m|^Apache/2.2| ) {
+		my $rel_name = $cgi->url(-relative=>1);
+		$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
+	}
+
+	my $url = $cgi->url(-path_info=>$add_path);
+	my $root = (split 'opensearch', $url)[0];
+	my $base = (split 'opensearch', $url)[0] . 'opensearch';
+	my $unapi = (split 'opensearch', $url)[0] . 'unapi';
+
+	my $path = $cgi->path_info;
+	#warn "URL breakdown: $url ($rel_name) -> $root -> $base -> $path -> $unapi";
+
+	if ($path =~ m{^/?(1\.\d{1})/(?:([^/]+)/)?([^/]+)/osd.xml}o) {
+		
+		my $version = $1;
+		my $lib = uc($2);
+		my $class = $3;
+
+		if (!$lib || $lib eq '-') {
+		 	$lib = $actor->request(
+				'open-ils.actor.org_unit_list.search' => parent_ou => undef
+			)->gather(1)->[0]->shortname;
+		}
+
+		if ($class eq '-') {
+			$class = 'keyword';
+		}
+
+		return opensearch_osd($version, $lib, $class, $base);
+	}
+
+
+	my $page = $cgi->param('startPage') || 1;
+	my $offset = $cgi->param('startIndex') || 1;
+	my $limit = $cgi->param('count') || 10;
+
+	$page = 1 if ($page !~ /^\d+$/);
+	$offset = 1 if ($offset !~ /^\d+$/);
+	$limit = 10 if ($limit !~ /^\d+$/); $limit = 25 if ($limit > 25);
+
+	if ($page > 1) {
+		$offset = ($page - 1) * $limit;
+	} else {
+		$offset -= 1;
+	}
+
+	my ($version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = ('','','','','','','','');
+	(undef,$version,$org,$type,$class,$terms,$sort,$sortdir,$lang) = split '/', $path;
+
+	$lang = $cgi->param('searchLang') if $cgi->param('searchLang');
+	$lang = '' if ($lang eq '*');
+
+	$sort = $cgi->param('searchSort') if $cgi->param('searchSort');
+	$sort ||= '';
+	$sortdir = $cgi->param('searchSortDir') if $cgi->param('searchSortDir');
+	$sortdir ||= '';
+
+	$terms .= " " if ($terms && $cgi->param('searchTerms'));
+	$terms .= $cgi->param('searchTerms') if $cgi->param('searchTerms');
+
+	$class = $cgi->param('searchClass') if $cgi->param('searchClass');
+	$class ||= '-';
+
+	$type = $cgi->param('responseType') if $cgi->param('responseType');
+	$type ||= '-';
+
+	$org = $cgi->param('searchOrg') if $cgi->param('searchOrg');
+	$org ||= '-';
+
+
+	my $kwt = $cgi->param('kw');
+	my $tit = $cgi->param('ti');
+	my $aut = $cgi->param('au');
+	my $sut = $cgi->param('su');
+	my $set = $cgi->param('se');
+
+	$terms .= " " if ($terms && $kwt);
+	$terms .= "keyword: $kwt" if ($kwt);
+	$terms .= " " if ($terms && $tit);
+	$terms .= "title: $tit" if ($tit);
+	$terms .= " " if ($terms && $aut);
+	$terms .= "author: $aut" if ($aut);
+	$terms .= " " if ($terms && $sut);
+	$terms .= "subject: $sut" if ($sut);
+	$terms .= " " if ($terms && $set);
+	$terms .= "series: $set" if ($set);
+
+	if ($version eq '1.0') {
+		$type = 'rss2';
+	} elsif ($type eq '-') {
+		$type = 'atom';
+	}
+	my $flesh_feed = parse_feed_type($type);
+
+	$terms = decode_utf8($terms);
+	$lang = 'eng' if ($lang eq 'en-US');
+
+	$log->debug("OpenSearch terms: $terms");
+
+	my $org_unit = get_ou($org);
+
+	# Apostrophes break search and get indexed as spaces anyway
+	my $safe_terms = $terms;
+	$safe_terms =~ s{'}{ }go;
+
+	my $recs = $search->request(
+		'open-ils.search.biblio.multiclass.query' => {
+			org_unit	=> $org_unit->[0]->id,
+			offset		=> $offset,
+			limit		=> $limit,
+			sort		=> $sort,
+			sort_dir	=> $sortdir,
+            default_class => $class,
+			($lang ?    ( 'language' => $lang    ) : ()),
+		} => $safe_terms => 1
+	)->gather(1);
+
+	$log->debug("Hits for [$terms]: $recs->{count}");
+
+	my $feed = create_record_feed(
+		'record',
+		$type,
+		[ map { $_->[0] } @{$recs->{ids}} ],
+		$unapi,
+		$org,
+		undef,
+		$flesh_feed
+	);
+
+	$log->debug("Feed created...");
+
+	$feed->root($root);
+	$feed->lib($org);
+	$feed->search($safe_terms);
+	$feed->class($class);
+
+	$feed->title("Search results for [$terms] at ".$org_unit->[0]->name);
+
+	$feed->creator($host);
+	$feed->update_ts();
+
+	$feed->_create_node(
+		$feed->{item_xpath},
+		'http://a9.com/-/spec/opensearch/1.1/',
+		'totalResults',
+		$recs->{count},
+	);
+
+	$feed->_create_node(
+		$feed->{item_xpath},
+		'http://a9.com/-/spec/opensearch/1.1/',
+		'startIndex',
+		$offset + 1,
+	);
+
+	$feed->_create_node(
+		$feed->{item_xpath},
+		'http://a9.com/-/spec/opensearch/1.1/',
+		'itemsPerPage',
+		$limit,
+	);
+
+	$log->debug("...basic feed data added...");
+
+	$feed->link(
+		next =>
+		$base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int($offset + $limit + 1) . "&count=" . $limit =>
+		'application/opensearch+xml'
+	) if ($offset + $limit < $recs->{count});
+
+	$feed->link(
+		previous =>
+		$base . "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang&startIndex=" . int(($offset - $limit) + 1) . "&count=" . $limit =>
+		'application/opensearch+xml'
+	) if ($offset);
+
+	$feed->link(
+		self =>
+		$base .  "/$version/$org/$type/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
+		'application/opensearch+xml'
+	);
+
+	$feed->link(
+		alternate =>
+		$base .  "/$version/$org/rss2-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
+		'application/rss+xml'
+	);
+
+	$feed->link(
+		atom =>
+		$base .  "/$version/$org/atom-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
+		'application/atom+xml'
+	);
+
+	$feed->link(
+		'html' =>
+		$base .  "/$version/$org/html/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
+		'text/html'
+	);
+
+	$feed->link(
+		'html-full' =>
+		$base .  "/$version/$org/html-full/$class?searchTerms=$terms&searchSort=$sort&searchSortDir=$sortdir&searchLang=$lang" =>
+		'text/html'
+	);
+
+	$feed->link( 'unapi-server' => $unapi);
+
+	$log->debug("...feed links added...");
+
+#	$feed->link(
+#		opac =>
+#		$root . "../$lang/skin/default/xml/rresult.xml?rt=list&" .
+#			join('&', map { 'rl=' . $_->[0] } grep { ref $_ && defined $_->[0] } @{$recs->{ids}} ),
+#		'text/html'
+#	);
+
+	#print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . entityize($feed->toString) . "\n";
+	print $cgi->header( -type => $feed->type, -charset => 'UTF-8') . $feed->toString . "\n";
+
+	$log->debug("...and feed returned.");
+
+	return Apache2::Const::OK;
+}
+
+sub create_record_feed {
+	my $search = shift;
+	my $type = shift;
+	my $records = shift;
+	my $unapi = shift;
+
+	my $lib = uc(shift()) || '-';
+	my $depth = shift;
+	my $flesh = shift;
+
+	my $paging = shift;
+
+	my $cgi = new CGI;
+	my $base = $cgi->url;
+	my $host = $cgi->virtual_host || $cgi->server_name;
+
+    my ($year,$month,$day) = reverse( (localtime)[3,4,5] );
+    $year += 1900;
+    $month += 1;
+
+    my $tag_prefix = sprintf("tag:open-ils.org,$year-\%0.2d-\%0.2d", $month, $day);
+
+	my $flesh_feed = defined($flesh) ? $flesh : parse_feed_type($type);
+
+	$type =~ s/(-full|-uris)$//o;
+
+	my $feed = new OpenILS::WWW::SuperCat::Feed ($type);
+	$feed->base($base) if ($flesh);
+	$feed->unapi($unapi) if ($flesh);
+
+	$type = 'atom' if ($type eq 'html');
+	$type = 'marcxml' if (($type eq 'htmlholdings') || ($type eq 'marctxt') || ($type eq 'ris'));
+
+	#$records = $supercat->request( "open-ils.supercat.record.object.retrieve", $records )->gather(1);
+
+	my $count = 0;
+	for my $record (@$records) {
+		next unless($record);
+
+		#my $rec = $record->id;
+		my $rec = $record;
+
+		my $item_tag = "$tag_prefix:biblio-record_entry/$rec/$lib";
+		$item_tag = "$tag_prefix:metabib-metarecord/$rec/$lib" if ($search eq 'metarecord');
+		$item_tag = "$tag_prefix:isbn/$rec/$lib" if ($search eq 'isbn');
+		$item_tag .= "/$depth" if (defined($depth));
+
+		$item_tag = "$tag_prefix:authority-record_entry/$rec" if ($search eq 'authority');
+
+		my $xml = $supercat->request(
+			"open-ils.supercat.$search.$type.retrieve",
+			$rec
+		)->gather(1);
+		next unless $xml;
+
+		my $node = $feed->add_item($xml);
+		next unless $node;
+
+		$xml = '';
+		if ($lib && ($type eq 'marcxml' || $type eq 'atom') &&  $flesh > 0) {
+			my $r = $supercat->request( "open-ils.supercat.$search.holdings_xml.retrieve", $rec, $lib, $depth, $flesh_feed, $paging );
+			while ( !$r->complete ) {
+				$xml .= join('', map {$_->content} $r->recv);
+			}
+			$xml .= join('', map {$_->content} $r->recv);
+			$node->add_holdings($xml);
+		}
+
+		$node->id($item_tag);
+		#$node->update_ts(cleanse_ISO8601($record->edit_date));
+		$node->link(alternate => $feed->unapi . "?id=$item_tag&format=htmlholdings-full" => 'text/html') if ($flesh > 0);
+		$node->link(opac => $feed->unapi . "?id=$item_tag&format=opac") if ($flesh > 0);
+		$node->link(unapi => $feed->unapi . "?id=$item_tag") if ($flesh);
+		$node->link('unapi-id' => $item_tag) if ($flesh);
+	}
+
+	return $feed;
+}
+
+sub string_browse {
+	my $apache = shift;
+	return Apache2::Const::DECLINED if (-e $apache->filename);
+
+	my $cgi = new CGI;
+	my $year = (gmtime())[5] + 1900;
+
+	my $host = $cgi->virtual_host || $cgi->server_name;
+
+	my $add_path = 0;
+	if ( $cgi->server_software !~ m|^Apache/2.2| ) {
+		my $rel_name = $cgi->url(-relative=>1);
+		$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
+	}
+
+	my $url = $cgi->url(-path_info=>$add_path);
+	my $root = (split 'browse', $url)[0];
+	my $base = (split 'browse', $url)[0] . 'browse';
+	my $unapi = (split 'browse', $url)[0] . 'unapi';
+
+	my $path = $cgi->path_info;
+	$path =~ s/^\///og;
+
+	my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
+	#warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
+
+    return item_age_browse($apache) if ($axis eq 'item-age'); # short-circut to the item-age sub
+
+	my $status = [$cgi->param('status')];
+	my $cpLoc = [$cgi->param('copyLocation')];
+	$site ||= $cgi->param('searchOrg');
+	$page ||= $cgi->param('startPage') || 0;
+	$page_size ||= $cgi->param('count') || 9;
+
+	$page = 0 if ($page !~ /^-?\d+$/);
+	$page_size = 9 if $page_size !~ /^\d+$/;
+
+	my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
+	my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
+
+	unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
+		warn "something's wrong...";
+		warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
+		return undef;
+	}
+
+	$string = decode_utf8($string);
+	$string =~ s/\+/ /go;
+	$string =~ s/'//go;
+
+	my $tree = $supercat->request(
+		"open-ils.supercat.$axis.browse",
+		$string,
+		(($axis =~ /^authority/) ? () : ($site)),
+		$page_size,
+		$page,
+		$status,
+		$cpLoc
+	)->gather(1);
+
+    (my $norm_format = $format) =~ s/(-full|-uris)$//o;
+
+	my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
+	print $header.$content;
+	return Apache2::Const::OK;
+}
+
+sub string_startwith {
+	my $apache = shift;
+	return Apache2::Const::DECLINED if (-e $apache->filename);
+
+	my $cgi = new CGI;
+	my $year = (gmtime())[5] + 1900;
+
+	my $host = $cgi->virtual_host || $cgi->server_name;
+
+	my $add_path = 0;
+	if ( $cgi->server_software !~ m|^Apache/2.2| ) {
+		my $rel_name = $cgi->url(-relative=>1);
+		$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
+	}
+
+	my $url = $cgi->url(-path_info=>$add_path);
+	my $root = (split 'startwith', $url)[0];
+	my $base = (split 'startwith', $url)[0] . 'startwith';
+	my $unapi = (split 'startwith', $url)[0] . 'unapi';
+
+	my $path = $cgi->path_info;
+	$path =~ s/^\///og;
+
+	my ($format,$axis,$site,$string,$page,$page_size) = split '/', $path;
+	#warn " >>> $format -> $axis -> $site -> $string -> $page -> $page_size ";
+
+	my $status = [$cgi->param('status')];
+	my $cpLoc = [$cgi->param('copyLocation')];
+	$site ||= $cgi->param('searchOrg');
+	$page ||= $cgi->param('startPage') || 0;
+	$page_size ||= $cgi->param('count') || 9;
+
+	$page = 0 if ($page !~ /^-?\d+$/);
+	$page_size = 9 if $page_size !~ /^\d+$/;
+
+	my $prev = join('/', $base,$format,$axis,$site,$string,$page - 1,$page_size);
+	my $next = join('/', $base,$format,$axis,$site,$string,$page + 1,$page_size);
+
+	unless ($string and $axis and grep { $axis eq $_ } keys %browse_types) {
+		warn "something's wrong...";
+		warn " >>> format: $format -> axis: $axis -> site: $site -> string: $string -> page: $page -> page_size: $page_size ";
+		return undef;
+	}
+
+	$string = decode_utf8($string);
+	$string =~ s/\+/ /go;
+	$string =~ s/'//go;
+
+	my $tree = $supercat->request(
+		"open-ils.supercat.$axis.startwith",
+		$string,
+		(($axis =~ /^authority/) ? () : ($site)),
+		$page_size,
+		$page,
+		$status,
+		$cpLoc
+	)->gather(1);
+
+    (my $norm_format = $format) =~ s/(-full|-uris)$//o;
+
+	my ($header,$content) = $browse_types{$axis}{$norm_format}->($tree,$prev,$next,$format,$unapi,$base,$site);
+	print $header.$content;
+	return Apache2::Const::OK;
+}
+
+sub item_age_browse {
+	my $apache = shift;
+	return Apache2::Const::DECLINED if (-e $apache->filename);
+
+	my $cgi = new CGI;
+	my $year = (gmtime())[5] + 1900;
+
+	my $host = $cgi->virtual_host || $cgi->server_name;
+
+	my $add_path = 0;
+	if ( $cgi->server_software !~ m|^Apache/2.2| ) {
+		my $rel_name = $cgi->url(-relative=>1);
+		$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
+	}
+
+	my $url = $cgi->url(-path_info=>$add_path);
+	my $root = (split 'browse', $url)[0];
+	my $base = (split 'browse', $url)[0] . 'browse';
+	my $unapi = (split 'browse', $url)[0] . 'unapi';
+
+	my $path = $cgi->path_info;
+	$path =~ s/^\///og;
+
+	my ($format,$axis,$site,$page,$page_size) = split '/', $path;
+	#warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
+
+	unless ($axis eq 'item-age') {
+		warn "something's wrong...";
+		warn " >>> $format -> $axis -> $site -> $page -> $page_size ";
+		return undef;
+	}
+
+	my $status = [$cgi->param('status')];
+	my $cpLoc = [$cgi->param('copyLocation')];
+	$site ||= $cgi->param('searchOrg') || '-';
+	$page ||= $cgi->param('startPage') || 1;
+	$page_size ||= $cgi->param('count') || 10;
+
+	$page = 1 if ($page !~ /^-?\d+$/ || $page < 1);
+	$page_size = 10 if $page_size !~ /^\d+$/;
+
+	my $prev = join('/', $base,$format,$axis,$site,$page - 1,$page_size);
+	my $next = join('/', $base,$format,$axis,$site,$page + 1,$page_size);
+
+	my $recs = $supercat->request(
+		"open-ils.supercat.new_book_list",
+		$site,
+		$page_size,
+		$page,
+		$status,
+		$cpLoc
+	)->gather(1);
+
+    (my $norm_format = $format) =~ s/(-full|-uris)$//o;
+
+	my ($header,$content) = $browse_types{$axis}{$norm_format}->($recs,$prev,$next,$format,$unapi,$base,$site);
+	print $header.$content;
+	return Apache2::Const::OK;
+}
+
+our %qualifier_map = (
+
+    # Some EG qualifiers
+    'eg.site'               => 'site',
+    'eg.sort'               => 'sort',
+    'eg.direction'          => 'dir',
+    'eg.available'          => 'available',
+
+    # Title class:
+    'eg.title'              => 'title',
+    'dc.title'              => 'title',
+    'bib.titleabbreviated'  => 'title|abbreviated',
+    'bib.titleuniform'      => 'title|uniform',
+    'bib.titletranslated'   => 'title|translated',
+    'bib.titlealternative'  => 'title',
+    'bib.titleseries'       => 'series',
+    'eg.series'             => 'title',
+
+    # Author/Name class:
+    'eg.author'             => 'author',
+    'eg.name'               => 'author',
+    'creator'               => 'author',
+    'dc.creator'            => 'author',
+    'dc.contributer'        => 'author',
+    'dc.publisher'          => 'keyword',
+    'bib.name'              => 'author',
+    'bib.namepersonal'      => 'author|personal',
+    'bib.namepersonalfamily'=> 'author|personal',
+    'bib.namepersonalgiven' => 'author|personal',
+    'bib.namecorporate'     => 'author|corporate',
+    'bib.nameconference'    => 'author|conference',
+
+    # Subject class:
+    'eg.subject'            => 'subject',
+    'dc.subject'            => 'subject',
+    'bib.subjectplace'      => 'subject|geographic',
+    'bib.subjecttitle'      => 'keyword',
+    'bib.subjectname'       => 'subject|name',
+    'bib.subjectoccupation' => 'keyword',
+
+    # Keyword class:
+    'eg.keyword'            => 'keyword',
+    'srw.serverchoice'      => 'keyword',
+
+    # Identifiers:
+    'dc.identifier'         => 'keyword',
+
+    # Dates:
+    'bib.dateissued'        => undef,
+    'bib.datecreated'       => undef,
+    'bib.datevalid'         => undef,
+    'bib.datemodified'      => undef,
+    'bib.datecopyright'     => undef,
+
+    # Resource Type:
+    'dc.type'               => undef,
+
+    # Format:
+    'dc.format'             => undef,
+
+    # Genre:
+    'bib.genre'             => 'keyword',
+
+    # Target Audience:
+    'bib.audience'          => undef,
+
+    # Place of Origin:
+    'bib.originplace'       => undef,
+
+    # Language
+    'dc.language'           => 'lang',
+
+    # Edition
+    'bib.edition'           => 'keyword',
+
+    # Part:
+    'bib.volume'            => 'keyword',
+    'bib.issue'             => 'keyword',
+    'bib.startpage'         => 'keyword',
+    'bib.endpage'           => 'keyword',
+
+    # Issuance:
+    'bib.issuance'          => 'keyword',
+);
+
+our %qualifier_ids = (
+		eg => 'http://open-ils.org/spec/SRU/context-set/evergreen/v1',
+		dc => 'info:srw/cql-context-set/1/dc-v1.1',
+		bib => 'info:srw/cql-context-set/1/bib-v1.0',
+		srw	=> ''
+);
+
+our %nested_qualifier_map = (
+		eg => {
+			site		=> ['site','Evergreen Site Code (shortname)'],
+			sort		=> ['sort','Sort on relevance, title, author, pubdate, create_date or edit_date'],
+			direction	=> ['dir','Sort direction (asc|desc)'],
+			available	=> ['available','Filter to available (true|false)'],
+			title		=> ['title'],
+			author		=> ['author'],
+			name		=> ['author'],
+			subject		=> ['subject'],
+			keyword		=> ['keyword'],
+			series		=> ['series'],
+		},
+		dc => {
+			title		=> ['title'],
+			creator		=> ['author'],
+			contributor	=> ['author'],
+			publisher	=> ['keyword'],
+			subject		=> ['subject'],
+			identifier	=> ['keyword'],
+			type		=> [undef],
+			format		=> [undef],
+			language	=> ['lang'],
+		},
+		bib => {
+		# Title class:
+	        titleAbbreviated	=> ['title'],
+		    titleUniform		=> ['title'],
+			titleTranslated		=> ['title'],
+	        titleAlternative	=> ['title'],
+		    titleSeries			=> ['series'],
+
+    # Author/Name class:
+			name				=> ['author'],
+			namePersonal		=> ['author'],
+			namePersonalFamily	=> ['author'],
+			namePersonalGiven	=> ['author'],
+			nameCorporate		=> ['author'],
+			nameConference		=> ['author'],
+
+		# Subject class:
+			subjectPlace		=> ['subject'],
+			subjectTitle		=> ['keyword'],
+			subjectName			=> ['subject|name'],
+			subjectOccupation	=> ['keyword'],
+
+    # Keyword class:
+
+    # Dates:
+			dateIssued			=> [undef],
+			dateCreated			=> [undef],
+			dateValid			=> [undef],
+			dateModified		=> [undef],
+			dateCopyright		=> [undef],
+
+    # Genre:
+			genre				=> ['keyword'],
+
+    # Target Audience:
+			audience			=> [undef],
+
+    # Place of Origin:
+			originPlace			=> [undef],
+
+    # Edition
+			edition				=> ['keyword'],
+
+    # Part:
+			volume				=> ['keyword'],
+			issue				=> ['keyword'],
+			startPage			=> ['keyword'],
+			endPage				=> ['keyword'],
+
+    # Issuance:
+			issuance			=> ['keyword'],
+		},
+		srw	=> {
+			serverChoice		=> ['keyword'],
+		},
+);
+
+
+my $base_explain = <
+	
+		
+		
+		
+	
+
+	
+		
+		<description primary="true"/>
+	</databaseInfo>
+
+	<indexInfo>
+		<set identifier="info:srw/cql-context-set/1/cql-v1.2" name="cql"/>
+	</indexInfo>
+
+	<schemaInfo>
+		<schema
+				identifier="info:srw/schema/1/marcxml-v1.1"
+				location="http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
+				sort="true"
+				retrieve="true"
+				name="marcxml">
+			<title>MARC21Slim (marcxml)
+		
+	
+
+	
+		50
+		eg
+		keyword
+		all
+		marcxml
+		marcxml
+		50
+		relevant
+		stem
+		fuzzy
+		word
+	
+
+
+XML
+
+
+my $ex_doc;
+sub sru_search {
+	my $cgi = new CGI;
+
+	my $req = SRU::Request->newFromCGI( $cgi );
+	my $resp = SRU::Response->newFromRequest( $req );
+
+	# Find the org_unit shortname, if passed as part of the URL
+	# http://example.com/opac/extras/sru/SHORTNAME
+	my $url = $cgi->path_info;
+	my ($shortname, $holdings) = $url =~ m#/?([^/]*)(/holdings)?#;
+
+	if ( $resp->type eq 'searchRetrieve' ) {
+
+		# Older versions of Debian packages returned terms to us double-encoded,
+		# so we had to forcefully double-decode them a second time with
+		# an outer decode('utf8', $string) call; this seems to be resolved with
+		# Debian Lenny packages sometime between 2009-07-27 and 2010-02-15
+		my $cql_query = decode_utf8($req->query);
+		my $search_string = decode_utf8($req->cql->toEvergreen);
+
+		# Ensure the search string overrides the default site
+		if ($shortname and $search_string !~ m#site:#) {
+			$search_string .= " site:$shortname";
+		}
+
+        my $offset = $req->startRecord;
+        $offset-- if ($offset);
+        $offset ||= 0;
+
+        my $limit = $req->maximumRecords;
+        $limit ||= 10;
+
+        $log->info("SRU search string [$cql_query] converted to [$search_string]\n");
+
+ 		my $recs = $search->request(
+			'open-ils.search.biblio.multiclass.query' => {offset => $offset, limit => $limit} => $search_string => 1
+		)->gather(1);
+
+		my $bre = $supercat->request( 'open-ils.supercat.record.object.retrieve' => [ map { $_->[0] } @{$recs->{ids}} ] )->gather(1);
+
+		foreach my $record (@$bre) {
+			my $marcxml = $record->marc;
+			# Make the beast conform to a VDX-supported format
+			# See http://vdxipedia.oclc.org/index.php/Holdings_Parsing
+			# Trying to implement LIBSOL_852_A format; so much for standards
+			if ($holdings) {
+				my $bib_holdings = $supercat->request('open-ils.supercat.record.basic_holdings.retrieve', $record->id, $shortname || '-')->gather(1);
+				my $marc = MARC::Record->new_from_xml($marcxml, 'UTF8', 'XML');
+
+				# Force record leader to 'a' as our data is always UTF8
+				# Avoids marc8_to_utf8 from being invoked with horrible results
+				# on the off-chance the record leader isn't correct
+				my $ldr = $marc->leader;
+				substr($ldr, 9, 1, 'a');
+				$marc->leader($ldr);
+
+				# Expects the record ID in the 001
+				$marc->delete_field($_) for ($marc->field('001'));
+				if (!$marc->field('001')) {
+					$marc->insert_fields_ordered(
+						MARC::Field->new( '001', $record->id )
+					);
+				}
+				$marc->delete_field($_) for ($marc->field('852')); # remove any legacy 852s
+				foreach my $cn (keys %$bib_holdings) {
+					foreach my $cp (@{$bib_holdings->{$cn}->{'copies'}}) {
+						$marc->insert_fields_ordered(
+							MARC::Field->new(
+								'852', '4', '',
+								a => $cp->{'location'},
+								b => $bib_holdings->{$cn}->{'owning_lib'},
+								c => $cn,
+								d => $cp->{'circlib'},
+								g => $cp->{'barcode'},
+								n => $cp->{'status'},
+							)
+						);
+					}
+				}
+
+				# Ensure the data is encoded as UTF8 before we hand it off
+				$marcxml = encode_utf8($marc->as_xml_record());
+				$marcxml =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
+
+			}
+			$resp->addRecord(
+				SRU::Response::Record->new(
+					recordSchema    => 'info:srw/schema/1/marcxml-v1.1',
+					recordData => $marcxml,
+					recordPosition => ++$offset
+				)
+			);
+		}
+
+		$resp->numberOfRecords($recs->{count});
+
+	} elsif ( $resp->type eq 'explain' ) {
+		if (!$ex_doc) {
+			my $host = $cgi->virtual_host || $cgi->server_name;
+
+			my $add_path = 0;
+			if ( $cgi->server_software !~ m|^Apache/2.2| ) {
+				my $rel_name = $cgi->url(-relative=>1);
+				$add_path = 1 if ($cgi->url(-path_info=>1) !~ /$rel_name$/);
+			}
+			my $base = $cgi->url(-base=>1);
+			my $url = $cgi->url(-path_info=>$add_path);
+			$url =~ s/^$base\///o;
+
+			my $doc = $parser->parse_string($base_explain);
+			my $e = $doc->documentElement;
+			$e->findnodes('/z:explain/z:serverInfo/z:host')->shift->appendText( $host );
+			$e->findnodes('/z:explain/z:serverInfo/z:port')->shift->appendText( $cgi->server_port );
+			$e->findnodes('/z:explain/z:serverInfo/z:database')->shift->appendText( $url );
+
+			for my $name ( keys %OpenILS::WWW::SuperCat::nested_qualifier_map ) {
+
+				my $identifier = $OpenILS::WWW::SuperCat::qualifier_ids{ $name };
+
+				next unless $identifier;
+
+				my $set_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'set' );
+				$set_node->setAttribute( identifier => $identifier );
+				$set_node->setAttribute( name => $name );
+
+				$e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $set_node );
+
+				for my $index ( keys %{ $OpenILS::WWW::SuperCat::nested_qualifier_map{$name} } ) {
+					my $desc = $OpenILS::WWW::SuperCat::nested_qualifier_map{$name}{$index}[1] || $index;
+
+					my $name_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'name' );
+
+					my $map_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'map' );
+					$map_node->appendChild( $name_node );
+
+					my $title_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'title' );
+
+					my $index_node = $doc->createElementNS( 'http://explain.z3950.org/dtd/2.0/', 'index' );
+					$index_node->appendChild( $title_node );
+					$index_node->appendChild( $map_node );
+
+					$index_node->setAttribute( id => $name . '.' . $index );
+					$title_node->appendText( $desc );
+					$name_node->setAttribute( set => $name );
+					$name_node->appendText($index );
+
+					$e->findnodes('/z:explain/z:indexInfo')->shift->appendChild( $index_node );
+				}
+			}
+
+			$ex_doc = $e->toString;
+		}
+
+		$resp->record(
+			SRU::Response::Record->new(
+				recordSchema	=> 'info:srw/cql-context-set/2/zeerex-1.1',
+				recordData		=> $ex_doc
+			)
+		);
+	}
+
+	print $cgi->header( -type => 'application/xml' );
+	print $U->entityize($resp->asXML) . "\n";
+	return Apache2::Const::OK;
+}
+
+
+{
+    package CQL::BooleanNode;
+
+    sub toEvergreen {
+        my $self     = shift;
+        my $left     = $self->left();
+        my $right    = $self->right();
+        my $leftStr  = $left->toEvergreen;
+        my $rightStr = $right->toEvergreen();
+
+        my $op =  '||' if uc $self->op() eq 'OR';
+        $op ||=  '&&';
+
+        return  "$leftStr $rightStr";
+    }
+
+    package CQL::TermNode;
+
+    sub toEvergreen {
+        my $self      = shift;
+        my $qualifier = $self->getQualifier();
+        my $term      = $self->getTerm();
+        my $relation  = $self->getRelation();
+
+        my $query;
+        if ( $qualifier ) {
+			my ($qset, $qname) = split(/\./, $qualifier);
+
+			$log->debug("SRU toEvergreen: $qset, $qname   $OpenILS::WWW::SuperCat::nested_qualifier_map{$qset}{$qname}[0]\n");
+
+            if ( exists($OpenILS::WWW::SuperCat::nested_qualifier_map{$qset}{$qname}) ) {
+                $qualifier = $OpenILS::WWW::SuperCat::nested_qualifier_map{$qset}{$qname}[0] || 'kw';
+			}
+
+            my @modifiers = $relation->getModifiers();
+
+            my $base = $relation->getBase();
+            if ( grep { $base eq $_ } qw/= scr exact all/ ) {
+
+                my $quote_it = 1;
+                foreach my $m ( @modifiers ) {
+                    if( grep { $m->[ 1 ] eq $_ } qw/cql.fuzzy cql.stem cql.relevant cql.word/ ) {
+                        $quote_it = 0;
+                        last;
+                    }
+                }
+
+                $quote_it = 0 if ( $base eq 'all' );
+                $term = maybeQuote($term) if $quote_it;
+
+            } else {
+                croak( "Evergreen doesn't support the $base relations" );
+            }
+
+
+        } else {
+            $qualifier = "kw";
+        }
+
+        return "$qualifier:$term";
+    }
+}
+
+=head2 get_ou($org_unit)
+
+Returns an aou object for a given actor.org_unit shortname or ID.
+
+=cut
+
+sub get_ou {
+	my $org = shift || '-';
+	my $org_unit;
+
+	if ($org eq '-') {
+	 	$org_unit = $actor->request(
+			'open-ils.actor.org_unit_list.search' => parent_ou => undef
+		)->gather(1);
+	} elsif ($org !~ /^\d+$/o) {
+	 	$org_unit = $actor->request(
+			'open-ils.actor.org_unit_list.search' => shortname => uc($org)
+		)->gather(1);
+	} else {
+	 	$org_unit = $actor->request(
+			'open-ils.actor.org_unit_list.search' => id => $org
+		)->gather(1);
+	}
+
+	return $org_unit;
+}
+
+1;
+
+# vim: noet:ts=4:sw=4
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/SuperCat/Feed.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/SuperCat/Feed.pm
new file mode 100644
index 0000000000..cd11a7542a
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/SuperCat/Feed.pm
@@ -0,0 +1,852 @@
+package OpenILS::WWW::SuperCat::Feed;
+use strict; use warnings;
+use vars qw/$parser/;
+use OpenSRF::EX qw(:try);
+use XML::LibXML;
+use XML::LibXSLT;
+use OpenSRF::Utils::SettingsClient;
+use CGI;
+use DateTime;
+use DateTime::Format::Mail;
+
+
+sub exists {
+	my $class = shift;
+	my $type = shift;
+
+	return 1 if UNIVERSAL::can("OpenILS::WWW::SuperCat::Feed::$type" => 'new');
+	return 0;
+}
+
+sub new {
+	my $class = shift;
+	my $type = shift;
+	if ($type) {
+		$class .= '::'.$type;
+		return $class->new;
+	}
+	throw OpenSRF::EX::ERROR ("I need a feed type!") ;
+}
+
+sub build {
+	my $class = shift;
+	my $xml = shift;
+	return undef unless $xml;
+
+	$parser = new XML::LibXML if (!$parser);
+
+	my $self = { doc => $parser->parse_string($xml), items => [] };
+
+	$self = bless $self => $class;
+	$self->{count} = 0;
+	return $self;
+}
+
+sub type {
+	my $self = shift;
+	my $type = shift;
+	$self->{type} = $type if ($type);
+	return $self->{type};
+}
+
+sub count {
+	my $self = shift;
+	return $self->{count};
+}
+
+sub search {
+	my $self = shift;
+	my $search = shift;
+	$self->{search} = $search if ($search);
+	return $self->{search};
+}
+
+sub class {
+	my $self = shift;
+	my $search = shift;
+	$self->{class} = $search if ($search);
+	return $self->{class};
+}
+
+sub Sort {
+	my $self = shift;
+	my $search = shift;
+	$self->{sort} = $search if ($search);
+	return $self->{sort};
+}
+
+sub SortDir {
+	my $self = shift;
+	my $search = shift;
+	$self->{sort_dir} = $search if ($search);
+	return $self->{sort_dir};
+}
+
+sub lang {
+	my $self = shift;
+	my $search = shift;
+	$self->{lang} = $search if ($search);
+	return $self->{lang};
+}
+
+sub lib {
+	my $self = shift;
+	my $lib = shift;
+	$self->{lib} = $lib if ($lib);
+	return $self->{lib};
+}
+
+sub base {
+	my $self = shift;
+	my $base = shift;
+	$self->{base} = $base if ($base);
+	return $self->{base};
+}
+
+sub root {
+	my $self = shift;
+	my $root = shift;
+	$self->{root} = $root if ($root);
+	return $self->{root};
+}
+
+sub unapi {
+	my $self = shift;
+	my $unapi = shift;
+	$self->{unapi} = $unapi if ($unapi);
+	return $self->{unapi};
+}
+
+sub push_item {
+	my $self = shift;
+	$self->{count} += scalar(@_);
+	push @{ $self->{items} }, @_;
+}
+
+sub items {
+	my $self = shift;
+	return @{ $self->{items} } if (wantarray);
+	return $self->{items};
+}
+
+sub _add_node {
+	my $self = shift;
+
+	my $xpath = shift;
+	my $new = shift;
+
+	for my $node ($self->{doc}->findnodes($xpath)) {
+		$node->appendChild($new);
+		last;
+	}
+}
+
+sub _create_node {
+	my $self = shift;
+
+	my $xpath = shift;
+	my $ns = shift;
+	my $name = shift;
+	my $text = shift;
+	my $attrs = shift;
+
+	for my $node ($self->{doc}->findnodes($xpath)) {
+		my $new = $self->{doc}->createElement($name) if (!$ns);
+		$new = $self->{doc}->createElementNS($ns,$name) if ($ns);
+
+		$new->appendChild( $self->{doc}->createTextNode( $text ) )
+			if (defined $text);
+
+		if (ref($attrs)) {
+			for my $key (keys %$attrs) {
+				next unless $$attrs{$key};
+				$new->setAttribute( $key => $$attrs{$key} );
+			}
+		}
+
+		$node->appendChild( $new );
+
+		return $new;
+	}
+}
+
+sub add_item {
+	my $self = shift;
+	my $class = ref($self) || $self;
+	$class .= '::item';
+
+	my $item_xml = shift;
+	my $entry = $class->new($item_xml);
+	return undef unless $entry;
+
+	$entry->base($self->base);
+	$entry->unapi($self->unapi);
+
+	$self->push_item($entry);
+	return $entry;
+}
+
+sub add_holdings {
+	my $self = shift;
+	my $holdings_xml = shift;
+
+	return $self unless ($holdings_xml);
+
+	$parser = new XML::LibXML if (!$parser);
+	my $new_doc = $parser->parse_string($holdings_xml);
+
+	for my $root ( $self->{doc}->findnodes($self->{holdings_xpath}) ) {
+		$root->appendChild($new_doc->documentElement);
+		last;
+	}
+	return $self;
+}
+
+sub composeDoc {
+	my $self = shift;
+	for my $root ( $self->{doc}->findnodes($self->{item_xpath}) ) {
+		for my $item ( $self->items ) {
+			$root->appendChild( $item->{doc}->documentElement );
+		}
+		last;
+	}
+}
+
+sub toString {
+	my $self = shift;
+	$self->composeDoc;
+	return $self->{doc}->toString(1);
+}
+
+sub id {};
+sub link {};
+sub title {};
+sub update_ts {};
+sub creator {};
+
+#----------------------------------------------------------
+
+package OpenILS::WWW::SuperCat::Feed::atom;
+use base 'OpenILS::WWW::SuperCat::Feed';
+use OpenSRF::Utils qw/:datetime/;
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::build('');
+	$self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', undef);
+	$self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', 'atom');
+	$self->{type} = 'application/atom+xml';
+	$self->{item_xpath} = '/atom:feed';
+	return $self;
+}
+
+sub title {
+	my $self = shift;
+	my $text = shift;
+	$self->_create_node('/atom:feed','http://www.w3.org/2005/Atom','title', $text);
+}
+
+sub update_ts {
+	my $self = shift;
+	# ATOM demands RFC-3339 compliant datetime formats
+	my $text = shift || gmtime_ISO8601();
+	$self->_create_node($self->{item_xpath},'http://www.w3.org/2005/Atom','updated', $text);
+}
+
+sub creator {
+	my $self = shift;
+	my $text = shift;
+	$self->_create_node('/atom:feed','http://www.w3.org/2005/Atom','author');
+	$self->_create_node('/atom:feed/atom:author', 'http://www.w3.org/2005/Atom','name', $text);
+}
+
+sub link {
+	my $self = shift;
+	my $type = shift;
+	my $id = shift;
+	my $mime = shift || "application/x-$type+xml";
+	my $title = shift;
+
+	$type = 'self' if ($type eq 'atom');
+
+	$self->_create_node(
+		$self->{item_xpath},
+		'http://www.w3.org/2005/Atom',
+		'link',
+		undef,
+		{ rel => $type,
+		  href => $id,
+		  title => $title,
+		  type => $mime,
+		}
+	);
+}
+
+sub id {
+	my $self = shift;
+	my $id = shift;
+
+	$self->_create_node( $self->{item_xpath}, 'http://www.w3.org/2005/Atom', 'id', $id );
+}
+
+package OpenILS::WWW::SuperCat::Feed::atom::item;
+use base 'OpenILS::WWW::SuperCat::Feed::atom';
+
+sub new {
+	my $class = shift;
+	my $xml = shift;
+	my $self = $class->SUPER::build($xml);
+	$self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', undef);
+	$self->{doc}->documentElement->setNamespace('http://www.w3.org/2005/Atom', 'atom');
+	$self->{item_xpath} = '/atom:entry';
+	$self->{holdings_xpath} = '/atom:entry';
+	$self->{type} = 'application/atom+xml';
+	return $self;
+}
+
+
+#----------------------------------------------------------
+
+package OpenILS::WWW::SuperCat::Feed::rss2;
+use base 'OpenILS::WWW::SuperCat::Feed';
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::build('');
+	$self->{type} = 'application/rss+xml';
+	$self->{item_xpath} = '/rss/channel';
+	return $self;
+}
+
+sub title {
+	my $self = shift;
+	my $text = shift;
+	$self->_create_node('/rss/channel',undef,'title', $text);
+	# RSS2 demands a /channel/description element; just dupe title until we give
+	# users the ability to provide a description for their bookbags
+	$self->_create_node('/rss/channel',undef,'description', $text);
+}
+
+sub update_ts {
+	my $self = shift;
+	# RSS2 demands RFC-822 compliant datetime formats
+	my $text = shift || DateTime::Format::Mail->format_datetime(DateTime->now());
+	$self->_create_node($self->{item_xpath},undef,'lastBuildDate', $text);
+}
+
+sub creator {
+	my $self = shift;
+	my $text = shift;
+	$self->_create_node('/rss/channel', undef,'generator', $text);
+}
+
+sub link {
+	my $self = shift;
+	my $type = shift;
+	my $id = shift;
+	my $mime = shift || "application/x-$type+xml";
+
+	if ($type eq 'rss2' or $type eq 'alternate') {
+		# Just link to ourself using standard RSS2 link element
+		$self->_create_node(
+			$self->{item_xpath},
+			undef,
+			'link',
+			$id,
+			undef
+		);
+	} else {
+		# Alternate link: use XHTML link element
+		$self->_create_node(
+			$self->{item_xpath},
+			'http://www.w3.org/1999/xhtml',
+			'xhtml:link',
+			$id,
+			{ rel => $type,
+			  type => $mime,
+			}
+		);
+	}
+}
+
+sub id {
+	my $self = shift;
+	my $id = shift;
+
+	$self->_create_node($self->{item_xpath}, undef,'guid', $id);
+}
+
+package OpenILS::WWW::SuperCat::Feed::rss2::item;
+use base 'OpenILS::WWW::SuperCat::Feed::rss2';
+
+sub new {
+	my $class = shift;
+	my $xml = shift;
+	my $self = $class->SUPER::build($xml);
+	$self->{type} = 'application/rss+xml';
+	$self->{item_xpath} = '/item';
+	$self->{holdings_xpath} = '/item';
+	return $self;
+}
+
+sub update_ts {
+	my $self = shift;
+	# RSS2 demands RFC-822 compliant datetime formats
+	my $text = shift;
+	if (!$text) {
+		# No date passed in, default to now
+		$text = DateTime::Format::Mail->format_datetime(DateTime->now());
+	} elsif ($text =~ m/^\s*(\d{4})\.?\s*$/o) {
+		# Publication date is just a year, convert accordingly
+		my $year = DateTime->new(year=>$1);
+		$text = DateTime::Format::Mail->format_datetime($year);
+	}
+	$self->_create_node($self->{item_xpath},undef,'pubDate', $text);
+}
+
+sub id {
+	my $self = shift;
+	my $id = shift;
+
+	$self->_create_node(
+		$self->{item_xpath},
+		undef,
+		'guid',
+		$id,
+		{
+			isPermaLink=>"false"
+		}
+	);
+}
+
+#----------------------------------------------------------
+
+package OpenILS::WWW::SuperCat::Feed::mods;
+use base 'OpenILS::WWW::SuperCat::Feed';
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::build('');
+	$self->{type} = 'application/xml';
+	$self->{item_xpath} = '/mods:modsCollection';
+	return $self;
+}
+
+package OpenILS::WWW::SuperCat::Feed::mods::item;
+use base 'OpenILS::WWW::SuperCat::Feed::mods';
+
+sub new {
+	my $class = shift;
+	my $xml = shift;
+	my $self = $class->SUPER::build($xml);
+	$self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/', 'mods');
+	$self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/', undef, 1);
+	$self->{type} = 'application/xml';
+	$self->{holdings_xpath} = '/mods:mods';
+	return $self;
+}
+
+my $linkid = 1;
+
+sub link {
+	my $self = shift;
+	my $type = shift;
+	my $id = shift;
+
+	if ($type eq 'unapi' || $type eq 'opac') {
+		$self->_create_node(
+			'mods:mods',
+            undef,
+			'relatedItem',
+			undef,
+			{ type => 'otherFormat', id => 'link-'.$linkid }
+		);
+		$self->_create_node(
+			"mods:mods/relatedItem[\@id='link-$linkid']",
+            undef,
+			'recordIdentifier',
+			$id
+		);
+		$linkid++;
+	}
+}
+
+#----------------------------------------------------------
+
+package OpenILS::WWW::SuperCat::Feed::mods3;
+use base 'OpenILS::WWW::SuperCat::Feed::mods';
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::build('');
+	$self->{type} = 'application/xml';
+	$self->{item_xpath} = '/mods:modsCollection';
+	return $self;
+}
+
+package OpenILS::WWW::SuperCat::Feed::mods3::item;
+use base 'OpenILS::WWW::SuperCat::Feed::mods::item';
+
+sub new {
+	my $class = shift;
+	my $xml = shift;
+	my $self = $class->SUPER::build($xml);
+	$self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/v3', 'mods');
+	$self->{doc}->documentElement->setNamespace('http://www.loc.gov/mods/v3', undef, 1);
+	$self->{type} = 'application/xml';
+	$self->{holdings_xpath} = '/mods:mods';
+	return $self;
+}
+
+sub link {
+	my $self = shift;
+	my $type = shift;
+	my $id = shift;
+
+	if ($type eq 'unapi' || $type eq 'opac') {
+		$self->_create_node(
+			'mods:mods',
+			undef,
+			'relatedItem',
+			undef,
+			{ type => 'otherFormat', id => 'link-'.$linkid }
+		);
+		$self->_create_node(
+			"mods:mods/relatedItem[\@id='link-$linkid']",
+			undef,
+			'recordIdentifier',
+			$id
+		);
+		$linkid++;
+	}
+}
+
+
+#----------------------------------------------------------
+
+package OpenILS::WWW::SuperCat::Feed::mods32;
+use base 'OpenILS::WWW::SuperCat::Feed::mods3';
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::build('');
+	$self->{type} = 'application/xml';
+	$self->{item_xpath} = '/mods:modsCollection';
+	return $self;
+}
+
+package OpenILS::WWW::SuperCat::Feed::mods32::item;
+use base 'OpenILS::WWW::SuperCat::Feed::mods3::item';
+
+#----------------------------------------------------------
+
+package OpenILS::WWW::SuperCat::Feed::mods33;
+use base 'OpenILS::WWW::SuperCat::Feed::mods3';
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::build('');
+	$self->{type} = 'application/xml';
+	$self->{item_xpath} = '/mods:modsCollection';
+	return $self;
+}
+
+package OpenILS::WWW::SuperCat::Feed::mods33::item;
+use base 'OpenILS::WWW::SuperCat::Feed::mods3::item';
+
+
+#----------------------------------------------------------
+
+package OpenILS::WWW::SuperCat::Feed::marcxml;
+use base 'OpenILS::WWW::SuperCat::Feed';
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::build('');
+	$self->{type} = 'application/xml';
+	$self->{item_xpath} = '/marc:collection';
+	return $self;
+}
+sub link {
+	my $self = shift;
+	my $type = shift;
+	my $id = shift;
+
+	if ($type eq 'unapi') {
+		$self->_create_node(
+			'marc:collection',
+			'http://www.w3.org/1999/xhtml',
+			'xhtml:link',
+			undef,
+			{ rel => 'unapi-server', href => $id, title => "unapi" }
+		);
+		$linkid++;
+	}
+}
+
+
+package OpenILS::WWW::SuperCat::Feed::marcxml::item;
+use base 'OpenILS::WWW::SuperCat::Feed::marcxml';
+
+sub new {
+	my $class = shift;
+	my $xml = shift;
+	my $self = $class->SUPER::build($xml);
+	return undef unless $self;
+	$self->{doc}->documentElement->setNamespace('http://www.loc.gov/MARC21/slim', undef);
+	$self->{type} = 'application/xml';
+	$self->{holdings_xpath} = '/*[local-name()="record"]';
+	return $self;
+}
+
+sub link {
+	my $self = shift;
+	my $type = shift;
+	my $id = shift;
+
+	if ($type eq 'opac') {
+		$self->_create_node(
+			'*[local-name()="record"]',
+			'http://www.w3.org/1999/xhtml',
+			'xhtml:link',
+			undef,
+			{ rel => 'otherFormat', href => $id, title => "Dynamic Details" }
+		);
+		$linkid++;
+	} elsif ($type eq 'unapi-id') {
+		$self->_create_node(
+			'*[local-name()="record"]',
+			'http://www.w3.org/1999/xhtml',
+			'xhtml:abbr',
+			undef,
+			{  title => $id, class => "unapi-id" }
+		);
+		$linkid++;
+	}
+}
+
+
+#----------------------------------------------------------
+
+package OpenILS::WWW::SuperCat::Feed::html;
+use base 'OpenILS::WWW::SuperCat::Feed::atom';
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::new;
+	$self->type('text/html');
+	return $self;
+}
+
+our ($_parser, $_xslt, $xslt_file);
+
+sub toString {
+	my $self = shift;
+	my $base = $self->base || '';
+	my $root = $self->root || '';
+	my $search = $self->search || '';
+	my $class = $self->class || '';
+	my $lib = $self->lib || '-';
+
+	$self->composeDoc;
+
+        $_parser ||= new XML::LibXML;
+        $_xslt ||= new XML::LibXSLT;
+
+	$xslt_file ||=
+                OpenSRF::Utils::SettingsClient
+       	                ->new
+               	        ->config_value( dirs => 'xsl' ).
+                "/ATOM2XHTML.xsl";
+
+        # parse the MODS xslt ...
+        my $atom2html_xslt = $_xslt->parse_stylesheet( $_parser->parse_file($xslt_file) );
+
+	my $new_doc = $atom2html_xslt->transform(
+		$self->{doc},
+		base_dir => "'$root'",
+		lib => "'$lib'",
+		searchTerms => "'$search'",
+		searchClass => "'$class'",
+	);
+
+	return $new_doc->toString(1); 
+}
+
+
+package OpenILS::WWW::SuperCat::Feed::html::item;
+use base 'OpenILS::WWW::SuperCat::Feed::atom::item';
+
+#----------------------------------------------------------
+
+package OpenILS::WWW::SuperCat::Feed::htmlcard;
+use base 'OpenILS::WWW::SuperCat::Feed::marcxml';
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::new;
+	$self->type('text/html');
+	$self->{xsl} = "/MARC21slim2HTMLCard.xsl";
+	return $self;
+}
+
+our ($_parser, $_xslt, $xslt_file);
+
+sub toString {
+	my $self = shift;
+	my $base = $self->base || '';
+	my $root = $self->root || '';
+	my $search = $self->search || '';
+	my $sort = $self->Sort || '';
+	my $sort_dir = $self->SortDir || '';
+	my $lang = $self->lang || '';
+	my $lib = $self->lib || '-';
+
+	$self->composeDoc;
+
+        $_parser ||= new XML::LibXML;
+        $_xslt ||= new XML::LibXSLT;
+
+	$xslt_file =
+                OpenSRF::Utils::SettingsClient
+       	                ->new
+               	        ->config_value( dirs => 'xsl' ).$self->{xsl};
+
+        # parse the MODS xslt ...
+        my $atom2html_xslt = $_xslt->parse_stylesheet( $_parser->parse_file($xslt_file) );
+
+	my $new_doc = $atom2html_xslt->transform(
+		$self->{doc},
+		base_dir => "'$root'",
+		lib => "'$lib'",
+		searchTerms => "'$search'",
+		searchSort => "'$sort'",
+		searchSortDir => "'$sort_dir'",
+		searchLang => "'$lang'",
+	);
+
+	return $new_doc->toString(1); 
+}
+
+package OpenILS::WWW::SuperCat::Feed::htmlcard::item;
+use base 'OpenILS::WWW::SuperCat::Feed::marcxml::item';
+
+package OpenILS::WWW::SuperCat::Feed::htmlholdings;
+use base 'OpenILS::WWW::SuperCat::Feed::htmlcard';
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::new;
+	$self->{xsl} = "/MARC21slim2HTMLCard-holdings.xsl";
+	return $self;
+}
+
+package OpenILS::WWW::SuperCat::Feed::htmlholdings::item;
+use base 'OpenILS::WWW::SuperCat::Feed::htmlcard::item';
+
+
+package OpenILS::WWW::SuperCat::Feed::marctxt;
+use base 'OpenILS::WWW::SuperCat::Feed::marcxml';
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::new;
+	$self->{type} = 'text/plain';
+	$self->{xsl} = "/MARC21slim2MARCtxt.xsl";
+	return $self;
+}
+
+
+our ($_parser, $_xslt, $xslt_file);
+
+sub toString {
+	my $self = shift;
+	my $base = $self->base || '';
+	my $root = $self->root || '';
+	my $search = $self->search || '';
+	my $class = $self->class || '';
+	my $lib = $self->lib || '-';
+
+	$self->composeDoc;
+
+        $_parser ||= new XML::LibXML;
+        $_xslt ||= new XML::LibXSLT;
+
+	$xslt_file ||=
+                OpenSRF::Utils::SettingsClient
+       	                ->new
+               	        ->config_value( dirs => 'xsl' ).
+                $self->{xsl};
+
+        # parse the MARC text xslt ...
+        my $marctxt_xslt = $_xslt->parse_stylesheet( $_parser->parse_file($xslt_file) );
+
+	my $new_doc = $marctxt_xslt->transform(
+		$self->{doc},
+		base_dir => "'$root'",
+		lib => "'$lib'",
+		searchTerms => "'$search'",
+		searchClass => "'$class'",
+	);
+
+	return $marctxt_xslt->output_string($new_doc); 
+}
+
+
+package OpenILS::WWW::SuperCat::Feed::marctxt::item;
+use base 'OpenILS::WWW::SuperCat::Feed::marcxml::item';
+
+
+package OpenILS::WWW::SuperCat::Feed::ris;
+use base 'OpenILS::WWW::SuperCat::Feed::marcxml';
+
+sub new {
+	my $class = shift;
+	my $self = $class->SUPER::new;
+	$self->{type} = 'text/plain';
+	$self->{xsl} = "/MARC21slim2RIS.xsl";
+	return $self;
+}
+
+
+our ($_parser, $_xslt, $xslt_file);
+
+sub toString {
+	my $self = shift;
+	my $base = $self->base || '';
+	my $root = $self->root || '';
+	my $search = $self->search || '';
+	my $class = $self->class || '';
+	my $lib = $self->lib || '-';
+
+	$self->composeDoc;
+
+        $_parser ||= new XML::LibXML;
+        $_xslt ||= new XML::LibXSLT;
+
+	$xslt_file ||=
+                OpenSRF::Utils::SettingsClient
+       	                ->new
+               	        ->config_value( dirs => 'xsl' ).
+                $self->{xsl};
+
+        # parse the MARC text xslt ...
+        my $ris_xslt = $_xslt->parse_stylesheet( $_parser->parse_file($xslt_file) );
+
+	my $new_doc = $ris_xslt->transform(
+		$self->{doc},
+		base_dir => "'$root'",
+		lib => "'$lib'",
+		searchTerms => "'$search'",
+		searchClass => "'$class'",
+	);
+
+	return $ris_xslt->output_string($new_doc); 
+}
+
+
+package OpenILS::WWW::SuperCat::Feed::ris::item;
+use base 'OpenILS::WWW::SuperCat::Feed::marcxml::item';
+
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/TemplateBatchBibUpdate.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/TemplateBatchBibUpdate.pm
new file mode 100644
index 0000000000..8f9f0ce046
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/TemplateBatchBibUpdate.pm
@@ -0,0 +1,671 @@
+package OpenILS::WWW::TemplateBatchBibUpdate;
+use strict;
+use warnings;
+use bytes;
+
+use Apache2::Log;
+use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use APR::Table;
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::RequestUtil;
+use CGI;
+use Data::Dumper;
+use Text::CSV;
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::Utils qw/:datetime/;
+use OpenSRF::Utils::Cache;
+use OpenSRF::System;
+use OpenSRF::AppSession;
+use XML::LibXML;
+use XML::LibXSLT;
+
+use Encode;
+use Unicode::Normalize;
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::Logger qw/$logger/;
+
+use MARC::Record;
+use MARC::File::XML;
+
+use UNIVERSAL::require;
+
+our @formats = qw/USMARC UNIMARC XML BRE/;
+
+# set the bootstrap config and template include directory when
+# this module is loaded
+my $bootstrap;
+
+sub import {
+    my $self = shift;
+    $bootstrap = shift;
+}
+
+
+sub child_init {
+    OpenSRF::System->bootstrap_client( config_file => $bootstrap );
+    Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL"));
+}
+
+sub handler {
+    my $r = shift;
+    my $cgi = new CGI;
+
+    my $authid = $cgi->cookie('ses') || $cgi->param('ses');
+    my $usr = verify_login($authid);
+    return show_template($r) unless ($usr);
+
+    my $template = $cgi->param('template');
+    return show_template($r) unless ($template);
+
+
+    my $rsource = $cgi->param('recordSource');
+    # find some IDs ...
+    my @records;
+
+    if ($rsource eq 'r') {
+        @records = map { $_ ? ($_) : () } $cgi->param('recid');
+    }
+
+    if ($rsource eq 'c') { # try for a file
+        my $file = $cgi->param('idfile');
+        if ($file) {
+            my $col = $cgi->param('idcolumn') || 0;
+            my $csv = new Text::CSV;
+
+            while (<$file>) {
+                $csv->parse($_);
+                my @data = $csv->fields;
+                my $id = $data[$col];
+                $id =~ s/\D+//o;
+                next unless ($id);
+                push @records, $id;
+            }
+        }
+    }
+
+    my $e = OpenSRF::AppSession->connect('open-ils.cstore');
+    $e->request('open-ils.cstore.transaction.begin')->gather(1);
+
+    # still no records ...
+    my $container = $cgi->param('containerid');
+    if ($rsource eq 'b') {
+        if ($container) {
+            my $bucket = $e->request(
+                'open-ils.cstore.direct.container.biblio_record_entry_bucket.retrieve',
+                $container
+            )->gather(1);
+            unless($bucket) {
+                $e->request('open-ils.cstore.transaction.rollback')->gather(1);
+                $e->disconnect;
+                $r->log->error("No such bucket $container");
+                $logger->error("No such bucket $container");
+                return Apache2::Const::NOT_FOUND;
+            }
+            my $recs = $e->request(
+                'open-ils.cstore.direct.container.biblio_record_entry_bucket_item.search.atomic',
+                { bucket => $container }
+            )->gather(1);
+            @records = map { ($_->target_biblio_record_entry) } @$recs;
+        }
+    }
+
+    unless (@records) {
+        $e->request('open-ils.cstore.transaction.rollback')->gather(1);
+        $e->disconnect;
+        return show_template($r);
+    }
+
+    # we have a template and some record ids, so...
+
+    # insert the template record
+    my $min_id = $e->request(
+        'open-ils.cstore.json_query',
+        { select => { bre => [{ column => 'id', transform => 'min', aggregate => 1}] }, from => 'bre' }
+    )->gather(1)->{id} - 1;
+
+    warn "new template bib id = $min_id\n";
+
+    my $tmpl_rec = Fieldmapper::biblio::record_entry->new;
+    $tmpl_rec->id($min_id);
+    $tmpl_rec->deleted('t');
+    $tmpl_rec->active('f');
+    $tmpl_rec->marc($template);
+    $tmpl_rec->creator($usr->id);
+    $tmpl_rec->editor($usr->id);
+
+    warn "about to create bib $min_id\n";
+    $e->request('open-ils.cstore.direct.biblio.record_entry.create', $tmpl_rec )->gather(1);
+
+    # create the new container for the records and the template
+    my $bucket = Fieldmapper::container::biblio_record_entry_bucket->new;
+    $bucket->owner($usr->id);
+    $bucket->btype('template_merge');
+
+    my $bname = $cgi->param('bname') || 'Temporary Merge Bucket '. localtime() . ' ' . $usr->id;
+    $bucket->name($bname);
+
+    $bucket = $e->request('open-ils.cstore.direct.container.biblio_record_entry_bucket.create', $bucket )->gather(1);
+
+    # create items in the bucket
+    my $item = Fieldmapper::container::biblio_record_entry_bucket_item->new;
+    $item->bucket($bucket->id);
+    $item->target_biblio_record_entry($min_id);
+
+    $e->request('open-ils.cstore.direct.container.biblio_record_entry_bucket_item.create', $item )->gather(1);
+
+    my %seen;
+    for my $r (@records) {
+        next if ($seen{$r});
+        $item->target_biblio_record_entry($r);
+        $e->request('open-ils.cstore.direct.container.biblio_record_entry_bucket_item.create', $item )->gather(1);
+        $seen{$r}++;
+    }
+
+    $e->request('open-ils.cstore.transaction.commit')->gather(1);
+    $e->disconnect;
+
+    # fire the background bucket processor
+    my $cache_key = OpenSRF::AppSession
+        ->create('open-ils.cat')
+        ->request('open-ils.cat.container.template_overlay.background', $authid, $bucket->id)
+        ->gather(1);
+
+    return show_processing_template($r, $bucket->id, \@records, $cache_key);
+}
+
+sub verify_login {
+        my $auth_token = shift;
+        return undef unless $auth_token;
+
+        my $user = OpenSRF::AppSession
+                ->create("open-ils.auth")
+                ->request( "open-ils.auth.session.retrieve", $auth_token )
+                ->gather(1);
+
+        if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) {
+                return undef;
+        }
+
+        return $user if ref($user);
+        return undef;
+}
+
+sub show_processing_template {
+    my $r = shift;
+    my $bid = shift;
+    my $recs = shift;
+    my $cache_key = shift;
+
+    my $rec_string = @$recs;
+
+    $r->content_type('text/html');
+    $r->print(<
+
+    
+        Merging records...
+        
+
+        
+
+        
+        
+
+        
+    
+
+    
+        

+
+        
+            
+                
+            
+            
+                
+                
+            
+            
+                
+                
+            
+            
+                
+                
+            
+        

+                StatusRecord Count
Success
Failure

+
+        

+
+    
+
+HTML
+
+    return Apache2::Const::OK;
+}
+
+
+sub show_template {
+    my $r = shift;
+
+    $r->content_type('text/html');
+    $r->print(<<'HTML');
+
+
+    
+        Merge Template Builder
+        
+
+        
+
+        
+        
+
+        
+    
+
+    
+
+        

+                
+
+            
+
+            
+            
+
+            
+
+                
+                    
+                
+                
+                    
+                
+                
+                    
+                
+            
Bucket named: 
+                        

+                            
+                        

+                    

+                        Column  of: 
+                        
+                        

+                        

+                        Columns are numbered starting at 0.  For instance, when looking at a CSV file in Excel, the column labeled A is the same as column 0, and the column labeled B is the same as column 1.
+                    
Record ID: 

+
+             (After setting up your template below.)
+
+            

+            

+
+        
 
+
+        

+        
+            
+                
+                
+            
+        
Update Template Preview:

+
+        
+
+        

+        

+            
+                
+                    
+                        
+                        
+                        
+                    
+                    
+                        
+                        
+                        
+                    
+                    
+                        
+                        
+                    
+                    
+                        
+                        
+                        
+                    
+                    
+                        
+                        
+                        
+                    
+                    
+                        
+                    
+                    
+                        
+                        
+                    
+                        
+                        
+                        
+                    
+                    
+                        
+                    
+                
+            
Rule SetupDataHelp
Action (Rule Type)
+                            
+                        How to change the existing records
MARC Tag
+                        Three characters, no spaces, no indicators, etc. eg: 245
Subfields (optional)No spaces, no delimiters, eg: abcnp
MARC DataMARC-Breaker formatted data with indicators and subfield delimiters, eg:
245 04$aThe End
Advanced Matching Restriction (Optional)
Subfield
+                        A single subfield code, no delimiters, eg: a
Regular ExpressionSee the Perl documentation
+                            for an explanation of Regular Expressions.
+                        

+                            
+                        

+        

+        

+        

+
+    
+
+HTML
+
+    return Apache2::Const::OK;
+}
+
+1;
+
+
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/Vandelay.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Vandelay.pm
new file mode 100644
index 0000000000..314b2e3153
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Vandelay.pm
@@ -0,0 +1,148 @@
+package OpenILS::WWW::Vandelay;
+use strict;
+use warnings;
+use bytes;
+
+use Apache2::Log;
+use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND FORBIDDEN :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use APR::Table;
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::RequestUtil;
+use CGI;
+use Data::Dumper;
+use Text::CSV;
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::Utils::Cache;
+use OpenSRF::System;
+use OpenSRF::AppSession;
+use XML::LibXML;
+
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::Logger qw/$logger/;
+
+use MARC::Record;
+use MARC::File::XML;
+
+use MIME::Base64;
+use Digest::MD5 qw/md5_hex/;
+use OpenSRF::Utils::SettingsClient;
+
+use UNIVERSAL::require;
+
+our @formats = qw/USMARC UNIMARC XML BRE/;
+my $MAX_FILE_SIZE = 10737418240; #10G
+my $FILE_READ_SIZE = 4096;
+
+# set the bootstrap config and template include directory when
+# this module is loaded
+my $bootstrap;
+
+sub import {
+        my $self = shift;
+        $bootstrap = shift;
+}
+
+
+sub child_init {
+        OpenSRF::System->bootstrap_client( config_file => $bootstrap );
+}
+
+sub spool_marc {
+	my $r = shift;
+	my $cgi = new CGI;
+
+	my $auth = $cgi->param('ses') || $cgi->cookie('ses');
+
+	unless(verify_login($auth)) {
+        $logger->error("authentication failed on vandelay record import: $auth");
+	    return Apache2::Const::FORBIDDEN;
+    }
+
+    my $data_fingerprint = '';
+	my $purpose = $cgi->param('purpose') || '';
+	my $infile = $cgi->param('marc_upload') || '';
+    my $bib_source = $cgi->param('bib_source') || '';
+    my $provider = $cgi->param('provider') || '';
+    my $picklist = $cgi->param('picklist') || '';
+    my $create_po = $cgi->param('create_po') || '';
+    my $activate_po = $cgi->param('activate_po') || '';
+    my $ordering_agency = $cgi->param('ordering_agency') || '';
+    my $create_assets = $cgi->param('create_assets') || '';
+
+    $logger->debug("purpose = $purpose, infile = $infile, bib_source = $bib_source ".
+        "provider = $provider, picklist = $picklist, create_po = $create_po, ordering_agency = $ordering_agency");
+
+	my $conf = OpenSRF::Utils::SettingsClient->new;
+	my $dir = $conf->config_value(
+        apps => 'open-ils.vandelay' => app_settings => databases => 'importer');
+
+    unless(-w $dir) {
+        $logger->error("We need some place to store our MARC files");
+	    return Apache2::Const::FORBIDDEN;
+    }
+
+    if($infile and -e $infile) {
+        my ($total_bytes, $buf, $bytes) = (0);
+	    $data_fingerprint = md5_hex(time."$$".rand());
+        my $outfile = "$dir/$data_fingerprint.mrc";
+
+        unless(open(OUTFILE, ">$outfile")) {
+            $logger->error("unable to open MARC file [$outfile] for writing: $@");
+	        return Apache2::Const::FORBIDDEN;
+        }
+
+        while($bytes = sysread($infile, $buf, $FILE_READ_SIZE)) {
+            $total_bytes += $bytes;
+            if($total_bytes >= $MAX_FILE_SIZE) {
+                close(OUTFILE);
+                unlink $outfile;
+                $logger->error("import exceeded upload size: $MAX_FILE_SIZE");
+	            return Apache2::Const::FORBIDDEN;
+            }
+            print OUTFILE $buf;
+        }
+
+        close(OUTFILE);
+
+	    OpenSRF::Utils::Cache->new->put_cache(
+		    'vandelay_import_spool_' . $data_fingerprint,
+		    {   purpose => $purpose, 
+                path => $outfile,
+                bib_source => $bib_source,
+                provider => $provider,
+                picklist => $picklist,
+                create_po => $create_po,
+                create_assets => $create_assets,
+                ordering_agency => $ordering_agency
+            }
+	    );
+    }
+
+    $logger->info("uploaded MARC batch with key $data_fingerprint");
+    $r->content_type('text/plain; charset=utf-8');
+	print "$data_fingerprint";
+	return Apache2::Const::OK;
+}
+
+sub verify_login {
+        my $auth_token = shift;
+        return undef unless $auth_token;
+
+        my $user = OpenSRF::AppSession
+                ->create("open-ils.auth")
+                ->request( "open-ils.auth.session.retrieve", $auth_token )
+                ->gather(1);
+
+        if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) {
+                return undef;
+        }
+
+        return $user if ref($user);
+        return undef;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/Web.pm.in b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Web.pm.in
new file mode 100644
index 0000000000..4087b09b79
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/Web.pm.in
@@ -0,0 +1,102 @@
+package OpenILS::WWW::Web;
+use strict;
+use warnings;
+
+use Apache2::Log;
+use Apache2::Const -compile => qw(OK REDIRECT :log);
+use APR::Const     -compile => qw(:error SUCCESS);
+use Apache2::RequestRec ();
+use Apache2::RequestIO  ();
+use Apache2::RequestUtil;
+
+#use CGI ();
+use Template;
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::System;
+
+my $main_ttk       = "opac/logic/page_router.ttk";
+my $error_ttk      = "opac/pages/error.ttk";
+my $init_ttk       = "opac/logic/page_init.ttk";
+my $bootstrap      = "@sysconfdir@/opensrf_core.xml";
+my $child_init_ttk = "opac/logic/child_init.ttk";
+
+my $includes = [];    # [  '/pines/cvs/ILS/Open-ILS/src/templates' ];
+
+sub import {
+    my ( $self, $tdir ) = @_;
+    $includes = [$tdir];
+}
+
+my $plugin_base = 'OpenILS::Template::Plugin';
+
+sub handler {
+
+    my $apache = shift;
+    print "Content-type: text/html; charset=utf-8\n\n";
+
+    _process_template(
+        apache      => $apache,
+        template    => $main_ttk,
+        pre_process => $init_ttk
+    );
+
+    return Apache2::Const::OK;
+}
+
+sub child_init_handler {
+    _process_template( template => $child_init_ttk );
+}
+
+sub _process_template {
+
+    my %params      = @_;
+    my $ttk         = $params{template}    || return undef;
+    my $apache      = $params{apache}      || undef;
+    my $pre_process = $params{pre_process} || undef;
+    my $param_hash  = $params{params}      || {};
+
+    my $template;
+
+    $template = Template->new(
+        {
+            OUTPUT       => $apache,
+            ABSOLUTE     => 1,
+            RELATIVE     => 1,
+            PLUGIN_BASE  => $plugin_base,
+            PRE_PROCESS  => $pre_process,
+            INCLUDE_PATH => $includes,
+            PRE_CHOMP    => 1,
+            POST_CHOMP   => 1,
+        }
+    );
+
+    try {
+
+        if ( !$template->process( $ttk, $param_hash ) ) {
+            warn "Error Occured: " . $template->error();
+            my $err = $template->error();
+            $err =~ s/\n/\/g;
+            warn "Error processing template $ttk\n";
+            my $string =
+                "
Unable to process template:

 " 
+              . $err
+              . "!!!";
+            $template->process( $error_ttk, { error => $string } );
+        }
+
+    }
+    catch Error with {
+        my $e = shift;
+        warn "Error processing template $ttk:  $e - $@ \n";
+        print "


Error

 $e 

 $@ 
";
+        return;
+    };
+
+}
+
+# This module appears obsolete (probably superceded by EGWeb.pm
+# The template files it references do not exist in the codebase.
+# File is not referenced elsewhere in the codebase.  Candidate for deletion.
+
+1;
diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/XMLRPCGateway.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/XMLRPCGateway.pm
new file mode 100644
index 0000000000..ea80f1d0fa
--- /dev/null
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/XMLRPCGateway.pm
@@ -0,0 +1,156 @@
+package OpenILS::WWW::XMLRPCGateway;
+use strict; use warnings;
+
+use CGI;
+use Apache2::Log;
+use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::RequestUtil;
+use Data::Dumper;
+use UNIVERSAL::require;
+
+use XML::LibXML;
+use OpenSRF::EX qw(:try);
+use OpenSRF::System;
+use OpenSRF::Utils::Cache;
+use OpenSRF::Utils::Logger qw/$logger/;
+use OpenSRF::Utils::SettingsClient;
+
+use RPC::XML qw/smart_encode/;
+use RPC::XML::Parser;
+use RPC::XML::Function;
+use RPC::XML::Method;
+use RPC::XML::Procedure;
+
+$RPC::XML::ENCODING = 'utf-8';
+
+my $services; 						# allowed services
+my $CLASS_KEY = '__class__';	# object wrapper class key
+my $PAYLOAD_KEY = '__data__';	# object wrapper payload key
+my $bs_config; 					# bootstrap config
+my $__inited = 0; 				# has child_init run?
+
+
+# set the bootstrap config when this module is loaded
+sub import { $bs_config = $_[1]; }
+
+
+# Bootstrap and load config settings
+sub child_init {
+	$__inited = 1;
+	OpenSRF::System->bootstrap_client( config_file => $bs_config );
+	my $sclient	= OpenSRF::Utils::SettingsClient->new();
+	my $idl = $sclient->config_value("IDL");
+	$services = $sclient->config_value("xml-rpc", "allowed_services", "service");
+	$services = ref $services ? $services : [ $services ];
+	$logger->debug("XML-RPC: allowed services @$services");
+	OpenILS::Utils::Fieldmapper->require;
+	Fieldmapper->import(IDL => $idl);
+}
+
+
+sub handler {
+
+	my $r		= shift;
+	my $cgi	= CGI->new;
+	my $service = $r->path_info;
+	$service =~ s#^/##;
+
+	child_init() unless $__inited; # ?
+
+	return Apache2::Const::NOT_FOUND unless grep { $_ eq $service } @$services;
+
+	my $request = RPC::XML::Parser->new->parse($cgi->param('POSTDATA'));
+
+	my @args;
+	push( @args, unwrap_perl($_->value) ) for @{$request->args};
+	my $method = $request->name;
+
+	warn "XML-RPC: service=$service, method=$method, args=@args\n";
+	$logger->debug("XML-RPC: service=$service, method=$method, args=@args");
+
+	my $perl = run_request( $service, $method, @args );
+	my $resp = RPC::XML::response->new(smart_encode($perl));
+
+	print "Content-type: application/xml; charset=utf-8\n\n";
+	print $resp->as_string;
+	return Apache2::Const::OK;
+}
+
+
+sub run_request {
+    my( $service, $method, @args ) = @_;
+    my $ses = OpenSRF::AppSession->create( $service );
+    #my $data = $ses->request($method, @args)->gather(1);
+
+    my $data = [];
+    my $req = $ses->request($method, @args);
+    while( my $resp = $req->recv( timeout => 600 ) ) {
+        if( $req->failed ) {
+            push( @$data, $req->failed );
+            last;
+        }
+        push( @$data, $resp->content );
+    }
+
+    return [] if scalar(@$data) == 0;
+    return wrap_perl($$data[0]) 
+        if scalar(@$data) == 1 and $method !~ /.atomic$/og;
+    return wrap_perl($data);
+}
+
+# These should probably be moved out to a library somewhere
+
+sub wrap_perl {
+   my $obj = shift;
+   my $ref = ref($obj);
+
+   if ($ref =~ /^Fieldmapper/o) {
+      $ref = $obj->json_hint;
+      $obj = $obj->to_bare_hash;
+   }
+
+   if( $ref eq 'HASH' ) {
+      $obj->{$_} = wrap_perl( $obj->{$_} ) for (keys %$obj);
+   } elsif( $ref eq 'ARRAY' ) {
+      $obj->[$_] = wrap_perl( $obj->[$_] ) for(0..scalar(@$obj) - 1 );
+   } elsif( $ref ) {
+      if(UNIVERSAL::isa($obj, 'HASH')) {
+         $obj->{$_} = wrap_perl( $obj->{$_} ) for (keys %$obj);
+         bless($obj, 'HASH'); # so our parser won't add the hints
+      } elsif(UNIVERSAL::isa($obj, 'ARRAY')) {
+         $obj->[$_] = wrap_perl( $obj->[$_] ) for(0..scalar(@$obj) - 1);
+         bless($obj, 'ARRAY'); # so our parser won't add the hints
+      }
+      $obj = { $CLASS_KEY => $ref, $PAYLOAD_KEY => $obj };
+   }
+   return $obj;
+}
+
+
+
+sub unwrap_perl {
+   my $obj = shift;
+   my $ref = ref($obj);
+   if( $ref eq 'HASH' ) {
+      if( defined($obj->{$CLASS_KEY})) {
+         my $class = $obj->{$CLASS_KEY};
+         if( $obj = unwrap_perl($obj->{$PAYLOAD_KEY}) ) {
+            return bless(\$obj, $class) unless ref($obj);
+            return bless( $obj, $class );
+         }
+         return undef;
+      }
+      $obj->{$_} = unwrap_perl( $obj->{$_} ) for (keys %$obj);
+   } elsif( $ref eq 'ARRAY' ) {
+      $obj->[$_] = unwrap_perl($obj->[$_]) for(0..scalar(@$obj) - 1);
+   }
+   return $obj;
+}
+
+
+
+
+1;
diff --git a/Open-ILS/src/support-scripts/test-scripts/circ_rules.pl b/Open-ILS/src/support-scripts/test-scripts/circ_rules.pl
index 1bee02a056..398d0e8ca3 100755
--- a/Open-ILS/src/support-scripts/test-scripts/circ_rules.pl
+++ b/Open-ILS/src/support-scripts/test-scripts/circ_rules.pl
@@ -1,6 +1,6 @@
 #/usr/bin/perl
 use strict; use warnings;
-use lib q|../../../perlmods/|;
+use lib q|../../../perlmods/lib/|;
 use Time::HiRes qw/time/;
 use OpenILS::Application::Circ::ScriptBuilder;
 require '../oils_header.pl';
diff --git a/Open-ILS/src/support-scripts/test-scripts/ftp.pl b/Open-ILS/src/support-scripts/test-scripts/ftp.pl
index 932c719c77..a2f5310396 100755
--- a/Open-ILS/src/support-scripts/test-scripts/ftp.pl
+++ b/Open-ILS/src/support-scripts/test-scripts/ftp.pl
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -IOpen-ILS/src/perlmods 
+#!/usr/bin/perl -IOpen-ILS/src/perlmods/lib/
 
 use strict; use warnings;
 
diff --git a/Open-ILS/src/support-scripts/test-scripts/ftp_ls.pl b/Open-ILS/src/support-scripts/test-scripts/ftp_ls.pl
index 61cb80044d..a0cb57c359 100755
--- a/Open-ILS/src/support-scripts/test-scripts/ftp_ls.pl
+++ b/Open-ILS/src/support-scripts/test-scripts/ftp_ls.pl
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -IOpen-ILS/src/perlmods 
+#!/usr/bin/perl -IOpen-ILS/src/perlmods/lib
 
 use strict; use warnings;
 
diff --git a/Open-ILS/src/support-scripts/test-scripts/net_ssh2_ls.pl b/Open-ILS/src/support-scripts/test-scripts/net_ssh2_ls.pl
index b51e669a3b..3022b54c8b 100755
--- a/Open-ILS/src/support-scripts/test-scripts/net_ssh2_ls.pl
+++ b/Open-ILS/src/support-scripts/test-scripts/net_ssh2_ls.pl
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -IOpen-ILS/src/perlmods 
+#!/usr/bin/perl -IOpen-ILS/src/perlmods/lib
 
 use strict; use warnings;
 
diff --git a/configure.ac b/configure.ac
index d1019a7d55..329203ee54 100644
--- a/configure.ac
+++ b/configure.ac
@@ -374,7 +374,10 @@ AC_CONFIG_FILES([Makefile
          Open-ILS/xul/staff_client/Makefile
          Open-ILS/src/extras/eg_config
          Open-ILS/src/extras/fast-extract
-         Open-ILS/src/perlmods/OpenILS/Utils/Cronscript.pm],
+         Open-ILS/src/perlmods/Makefile
+         Open-ILS/src/perlmods/lib/OpenILS/WWW/Method.pm
+         Open-ILS/src/perlmods/lib/OpenILS/WWW/Web.pm
+         Open-ILS/src/perlmods/lib/OpenILS/Utils/Cronscript.pm],
         [
             if test -e "./Open-ILS/src/extras/eg_config"; then chmod 755 Open-ILS/src/extras/eg_config; fi;
             if test -e "./Open-ILS/src/extras/fast-extract"; then chmod 755 Open-ILS/src/extras/fast-extract; fi;