pax_global_header00006660000000000000000000000064141412241570014513gustar00rootroot0000000000000052 comment=641189cf042c5180be29031f762e5a99123b0c67 plr-REL8_4_5/000077500000000000000000000000001414122415700130335ustar00rootroot00000000000000plr-REL8_4_5/.dir-locals.el000066400000000000000000000007321414122415700154660ustar00rootroot00000000000000;;; Directory Local Variables ;;; For more information see (info "(emacs) Directory Variables") ((nil (bug-reference-bug-regexp . "#\\(?2:[0-9]+\\)") (bug-reference-url-format . "https://github.com/postgres-plr/plr/issues/%s")) (c-mode (c-basic-offset . 4) (c-file-style . "bsd") (fill-column . 78) (indent-tabs-mode . t) (tab-width . 4)) (ess-r-mode (ess-style . RStudio)) (sql-mode (sql-indent-offset . 2) (fill-column . 78) (indent-tabs-mode))) plr-REL8_4_5/.editorconfig000066400000000000000000000004121414122415700155050ustar00rootroot00000000000000# EditorConfig is awesome: https://EditorConfig.org # top-most EditorConfig file root = true [*] trim_trailing_whitespace = true [*.out] trim_trailing_whitespace = false [*.{c,h}] indent_style = tab indent_size = 4 [*.sql] indent_style = space indent_size = 2 plr-REL8_4_5/.github/000077500000000000000000000000001414122415700143735ustar00rootroot00000000000000plr-REL8_4_5/.github/workflows/000077500000000000000000000000001414122415700164305ustar00rootroot00000000000000plr-REL8_4_5/.github/workflows/build.yml000066400000000000000000000075261414122415700202640ustar00rootroot00000000000000name: plr CI on: [push, pull_request] jobs: master: runs-on: ubuntu-latest steps: - name: Echo site details run: echo building master - name: Checkout code uses: actions/checkout@v2 - name: checkout postgres run: | sudo apt-get update -qq sudo apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E298A3A825C0D65DFD57CBB651716619E084DAB9 sudo add-apt-repository "deb https://cloud.r-project.org/bin/linux/ubuntu $(lsb_release -cs)-cran40/" sudo apt-get install -qq r-base-dev acl bison flex libssl-dev sudo /etc/init.d/postgresql stop sudo apt-get remove --purge postgresql\* sudo rm -rf /etc/postgresql /var/lib/postgresql git clone https://github.com/postgres/postgres.git pushd postgres ./configure make sudo make install export PATH=/usr/local/pgsql/bin:$PATH initdb -D data pg_ctl -D data -l logfile start popd - name: Script run: | export USE_PGXS=1 export PATH=/usr/local/pgsql/bin:$PATH SHLIB_LINK=-lgcov PG_CPPFLAGS="-fprofile-arcs -ftest-coverage -O0" make # USE_PGXS=1 is not required in Travis, and it is required in Github Actions sudo USE_PGXS=1 PATH=/usr/local/pgsql/bin:$PATH make install psql --version R --version make installcheck || (cat regression.diffs && false) env: USE_PGXS: 1 build: runs-on: ubuntu-latest env: PG: ${{ matrix.pg }} strategy: matrix: pg: [13, 12, 11, 10, 9.6, 9.5] include: - pg: 13 - pg: 12 - pg: 11 - pg: 10 - pg: 9.6 - pg: 9.5 steps: - name: Echo site details run: echo PG $PG - name: Checkout code uses: actions/checkout@v2 - name: Before Script run: | echo Building plr with PostgreSQL $PG sudo sh -c 'echo "deb http://apt.postgresql.org/pub/repos/apt/ $(lsb_release -cs)-pgdg main" > /etc/apt/sources.list.d/pgdg.list' wget --quiet -O - https://www.postgresql.org/media/keys/ACCC4CF8.asc | sudo apt-key add - sudo apt-get update -qq sudo apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E298A3A825C0D65DFD57CBB651716619E084DAB9 sudo add-apt-repository "deb https://cloud.r-project.org/bin/linux/ubuntu $(lsb_release -cs)-cran40/" sudo apt-get install -qq r-base-dev acl sudo /etc/init.d/postgresql stop sudo apt-get remove --purge postgresql\* sudo rm -rf /etc/postgresql /var/lib/postgresql sudo apt-get install postgresql-$PG sudo apt-get install postgresql-server-dev-$PG echo 'local all postgres trust' | sudo tee /etc/postgresql/$PG/main/pg_hba.conf > /dev/null # Builds under "runner" # Github Actions require elevated priviledges sudo setfacl -Rm u:postgres:rwx,d:u:runner:rwx /home/runner sudo pg_ctlcluster $PG main reload - name: Script run: | sudo pg_lsclusters export USE_PGXS=1 SHLIB_LINK=-lgcov PG_CPPFLAGS="-fprofile-arcs -ftest-coverage -O0" make # USE_PGXS=1 is not required in Travis, and it is required in Github Actions sudo USE_PGXS=1 make install /usr/lib/postgresql/$PG/bin/pg_config psql --version R --version make installcheck PGUSER=postgres || (cat regression.diffs && false) - name: After Success # success() returns true, when none of the previous steps have failed or been canceled. if: ${{ success() }} # Uploads code coverage to codecov.io run: bash <(curl -s https://codecov.io/bash) plr-REL8_4_5/.github/workflows/schedule.yml000066400000000000000000000026431414122415700207540ustar00rootroot00000000000000# This is a basic workflow to help you get started with Actions name: plr daily on: schedule: # * is a special character in YAML so you have to quote this string - cron: '30 1 * * *' jobs: master: runs-on: ubuntu-latest steps: - name: Echo site details run: echo building master - name: Checkout code uses: actions/checkout@v2 - name: checkout postgres run: | sudo apt-get update -qq sudo apt-get install -qq r-base-dev acl bison flex libssl-dev sudo /etc/init.d/postgresql stop sudo apt-get remove --purge postgresql\* sudo rm -rf /etc/postgresql /var/lib/postgresql git clone https://github.com/postgres/postgres.git pushd postgres ./configure make sudo make install export PATH=/usr/local/pgsql/bin:$PATH initdb -D data pg_ctl -D data -l logfile start popd - name: Script run: | export USE_PGXS=1 export PATH=/usr/local/pgsql/bin:$PATH SHLIB_LINK=-lgcov PG_CPPFLAGS="-fprofile-arcs -ftest-coverage -O0" make # USE_PGXS=1 is not required in Travis, and it is required in Github Actions sudo USE_PGXS=1 PATH=/usr/local/pgsql/bin:$PATH make install psql --version make installcheck || (cat regression.diffs && false) env: USE_PGXS: 1 plr-REL8_4_5/.travis.yml000066400000000000000000000023061414122415700151450ustar00rootroot00000000000000os: - linux language: c sudo : required env: - PG=12 - PG=11 - PG=10 - PG=9.6 - PG=9.5 before_script: - sudo sh -c 'echo "deb http://apt.postgresql.org/pub/repos/apt/ $(lsb_release -cs)-pgdg main" > /etc/apt/sources.list.d/pgdg.list' - wget --quiet -O - https://www.postgresql.org/media/keys/ACCC4CF8.asc | sudo apt-key add - - sudo apt-get update -qq - sudo apt-get install -qq r-base-dev acl - sudo /etc/init.d/postgresql stop - sudo apt-get remove --purge postgresql\* - sudo rm -rf /etc/postgresql /var/lib/postgresql - sudo apt-get install postgresql-$PG - sudo apt-get install postgresql-server-dev-$PG - echo 'local all postgres trust' | sudo tee /etc/postgresql/$PG/main/pg_hba.conf > /dev/null - setfacl -Rm u:postgres:rwx,d:u:travis:rwx $HOME - sudo pg_ctlcluster $PG main reload script: - sudo pg_lsclusters - export USE_PGXS=1 - SHLIB_LINK=-lgcov PG_CPPFLAGS="-fprofile-arcs -ftest-coverage -O0" make - sudo make install - /usr/lib/postgresql/$PG/bin/pg_config - psql --version - make installcheck PGUSER=postgres || (cat regression.diffs && false) after_success: - bash <(curl -s https://codecov.io/bash) plr-REL8_4_5/LICENSE000066400000000000000000000432541414122415700140500ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Lesser General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 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. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. plr-REL8_4_5/Makefile000077500000000000000000000052461414122415700145050ustar00rootroot00000000000000# location of R library ifdef R_HOME r_libdir1x = ${R_HOME}/bin${R_ARCH} r_libdir2x = ${R_HOME}/lib${R_ARCH} # location of R includes r_includespec = -I${R_HOME}/include rhomedef = ${R_HOME} else R_HOME := $(shell pkg-config --variable=rhome libR) r_libdir1x := $(shell pkg-config --variable=rlibdir libR) r_libdir2x := $(shell pkg-config --variable=rlibdir libR) r_includespec := $(shell pkg-config --cflags-only-I libR) rhomedef := $(shell pkg-config --variable=rhome libR) endif ifneq (,${R_HOME}) EXTENSION = plr MODULE_big = plr PG_CPPFLAGS += $(r_includespec) SRCS += plr.c pg_conversion.c pg_backend_support.c pg_userfuncs.c pg_rsupport.c OBJS := $(SRCS:.c=.o) SHLIB_LINK += -L$(r_libdir1x) -L$(r_libdir2x) -lR DATA = plr--8.4.5.sql plr--unpackaged--8.4.5.sql plr--8.3.0.18--8.4.sql plr--8.4.1--8.4.2.sql plr--8.4.3--8.4.4.sql \ plr--8.4--8.4.1.sql plr--8.4.2--8.4.3.sql plr--8.4.4--8.4.5.sql REGRESS = plr bad_fun opt_window do out_args plr_transaction opt_window_frame ifdef USE_PGXS ifndef PG_CONFIG PG_CONFIG := pg_config endif PGXS := $(shell $(PG_CONFIG) --pgxs) include $(PGXS) else subdir = contrib/plr top_builddir = ../.. include $(top_builddir)/src/Makefile.global include $(top_srcdir)/contrib/contrib-global.mk endif ifeq ($(PORTNAME), darwin) DYSUFFIX = dylib DLPREFIX = libR else ifeq ($(PORTNAME), win32) DLPREFIX = R else DLPREFIX = libR endif endif # we can only build PL/R if libR is available # Since there is no official way to determine this, # we see if there is a file that is named like a shared library. ifneq ($(PORTNAME), darwin) ifneq (,$(wildcard $(r_libdir1x)/$(DLPREFIX)*$(DLSUFFIX)*)$(wildcard $(r_libdir2x)/$(DLPREFIX)*$(DLSUFFIX)*)) shared_libr = yes; endif else ifneq (,$(wildcard $(r_libdir1x)/$(DLPREFIX)*$(DYSUFFIX)*)$(wildcard $(r_libdir2x)/$(DLPREFIX)*$(DYSUFFIX)*)) shared_libr = yes endif endif # If we don't have a shared library and the platform doesn't allow it # to work without, we have to skip it. ifneq (,$(findstring yes, $(shared_libr)$(allow_nonpic_in_shlib))) override CPPFLAGS := -I"$(srcdir)" -I"$(r_includespec)" $(CPPFLAGS) override CPPFLAGS += -DPKGLIBDIR=\"$(pkglibdir)\" -DDLSUFFIX=\"$(DLSUFFIX)\" override CPPFLAGS += -DR_HOME_DEFAULT=\"$(rhomedef)\" else # can't build all: @echo ""; \ echo "*** Cannot build PL/R because libR is not a shared library." ; \ echo "*** You might have to rebuild your R installation. Refer to"; \ echo "*** the documentation for details."; \ echo "" endif # can't build - cannot find libR else # can't build - no R_HOME all: @echo ""; \ echo "*** Cannot build PL/R because R_HOME cannot be found." ; \ echo "*** Refer to the documentation for details."; \ echo "" endif plr-REL8_4_5/README.md000077500000000000000000000035271414122415700143240ustar00rootroot00000000000000### PL/R - PostgreSQL support for R as a procedural language (PL) [![GitHub license](https://img.shields.io/github/license/postgres-plr/plr.svg?cacheSeconds=2592000)](https://github.com/postgres-plr/plr/blob/master/LICENSE) [![AppVeyor build status](https://ci.appveyor.com/api/projects/status/github/postgres-plr/plr?svg=true)](https://ci.appveyor.com/project/davecramer/plr-daun5 "Get your fresh Windows build here!") [![Travis build Status](https://travis-ci.org/postgres-plr/plr.png)](https://travis-ci.org/postgres-plr/plr) [![Code coverage](https://img.shields.io/codecov/c/github/postgres-plr/plr.svg?logo=codecov&cacheSeconds=2592000)](https://codecov.io/github/postgres-plr/plr) [![Chat on Slack](https://img.shields.io/badge/Slack-chat-orange.svg?logo=slack&cacheSeconds=2592000)](https://postgresteam.slack.com/messages/CJQUZ1475/ "Join the conversation!") Copyright (c) 2003-2021 by Joseph E. Conway ALL RIGHTS RESERVED Joe Conway Based on pltcl by Jan Wieck and inspired by REmbeddedPostgres by Duncan Temple Lang http://www.omegahat.org/RSPostgres/ ### License - GPL V2 see [LICENSE](LICENSE) for details ### Changes - See [changelog](changelog.md) for release notes for latest docs #### Installation: - See [installation](userguide.md#installation) for the most up-to-date instructions. #### Documentation: - See [userguide](userguide.md) for complete documentation. ### Notes: - R headers are required. Download and install R prior to building PL/R. - R must have been built with the ```--enable-R-shlib``` option when it was configured, in order for the libR shared object library to be available. - R_HOME must be defined in the environment of the user under which PostgreSQL is started, before the postmaster is started. Otherwise PL/R will refuse to load. -- Joe Conway plr-REL8_4_5/appveyor.yml000066400000000000000000000155301414122415700154270ustar00rootroot00000000000000image: Visual Studio 2015 configuration: Release platform: x64 clone_depth: 1 environment: PGUSER: postgres PGPASSWORD: Password12! rversion: 4.1.0 matrix: - pg: master PlatformToolset: v141 configuration: Debug APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2017 - pg: REL_13_0 PlatformToolset: v141 configuration: Release APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2017 - pg: REL_12_0 PlatformToolset: v141 configuration: Release APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2017 - pg: 9.6.13-1 PlatformToolset: v120 - pg: 11.11-2 PlatformToolset: v140 - pg: 12.6-2 PlatformToolset: v141 APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2017 - pg: 13.2-2 PlatformToolset: v141 APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2017 matrix: allow_failures: - pg: master init: # Make %x64% available for caching - ps: iex ((new-object net.webclient).DownloadString('https://raw.githubusercontent.com/appveyor/ci/master/scripts/enable-rdp.ps1')) - if %PLATFORM%==x64 ( set pf=%ProgramFiles%&& set x64=-x64) else set pf=%ProgramFiles(x86)% - set exe=postgresql-%pg%-windows%x64%.exe - setx /m exe %exe% install: - if not exist R-%rversion%-win.exe appveyor downloadfile https://cran.r-project.org/bin/windows/base/old/%rversion%/R-%rversion%-win.exe - R-%rversion%-win.exe /VERYSILENT # We could have used RTools many R users have, but let's use msys64 existing on Appveyor intead #- if not exist Rtools35.exe appveyor downloadfile https://cran.r-project.org/bin/windows/Rtools/Rtools35.exe #- Rtools35.exe /VERYSILENT - Set mingw=C:\msys64\mingw # # From the EnterpriseDB version name, # if any, strip off the: right-most part dot, then numbers, then one hyphen, then numbers. - ps: $env:pgversion = $env:pg -replace "[.]\d+-\d+$", "" # - echo pgversion=%pgversion% - set pgroot=%pf%\PostgreSQL\%pgversion% - echo %pgroot% - SET R_HOME=%ProgramFiles%\R\R-%rversion% - set RBIN=%PLATFORM:x86=i386% - SET sed=C:\msys64\usr\bin\sed # R in the path is not required: msvc compilation # R in the path is required: find Rscript - set PATH=%R_HOME%\bin\%rbin%;%PATH% # environment variable "postgresrcroot" is required for msvc.diff.R - set postgresrcroot=C:\projects\postgresql - ps: | # notmatch - if no "dot is found" in pg name, then pg is a: git: branch, tag, or commit. if ("${env:pg}" -notmatch "[.]") { $env:Path += ";C:\msys64\usr\bin;C:\msys64\mingw64\bin;C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\bin\amd64" git config --global advice.detachedHead false # # git commit # if(("${env:pg}" -cmatch "^[a-z0-9]+$") -and ("${env:pghint}" -eq "commit")) { git clone -q https://git.postgresql.org/git/postgresql.git c:\projects\postgresql pushd c:\projects\postgresql git checkout -q ${env:pg} -b ${env:pg} popd # # git branch or tag(detached head) # PostgreSQL case - git branches and tags have at least one capital letter - but expect mostly CAPS # } else { git clone -q --depth 1 --branch ${env:pg} https://git.postgresql.org/git/postgresql.git c:\projects\postgresql } gendef - "$env:R_HOME\bin\$env:rbin\R.dll" > "R$env:PLATFORM.def" 2> $null lib "/def:R$env:PLATFORM.def" "/out:R$env:PLATFORM.lib" "/MACHINE:$env:PLATFORM" pushd c:\projects\postgresql cmd /c mklink /J contrib\plr $env:APPVEYOR_BUILD_FOLDER Rscript --vanilla "${env:APPVEYOR_BUILD_FOLDER}\msvc.diff.R" perl contrib\plr\buildsetup.pl popd $env:PROJ="C:\projects\postgresql\pgsql.sln" $env:dll="c:\projects\postgresql\$env:CONFIGURATION\plr\plr.dll" } else { $env:PROJ="plr.vcxproj" $env:dll="$($env:PLATFORM.replace('x86', '.'))\$env:CONFIGURATION\plr.dll" if (-not (Test-Path "$env:pgroot\bin")) { if (-not (Test-Path "$env:exe")) { Start-FileDownload "http://get.enterprisedb.com/postgresql/$env:exe" } & ".\$env:exe" --unattendedmodeui none --mode unattended --superpassword "$env:PGPASSWORD" --servicepassword "$env:PGPASSWORD" | Out-Null Stop-Service "postgresql$env:x64-$env:pgversion" } } #on_failure: # - ps: $blockRdp = $true; iex ((new-object net.webclient).DownloadString('https://raw.githubusercontent.com/appveyor/ci/master/scripts/enable-rdp.ps1')) cache: - '%exe%' - R-%rversion%-win.exe build_script: - msbuild /p:PlatformToolset=%PlatformToolset% /p:configuration=%CONFIGURATION% /p:platform=%PLATFORM% %PROJ% /verbosity:minimal /logger:"C:\Program Files\AppVeyor\BuildAgent\Appveyor.MSBuildLogger.dll" after_build: - appveyor AddMessage Packing -Category Information - md tmp\share\extension - copy *.sql tmp\share\extension\ - copy *.control tmp\share\extension\ - copy LICENSE tmp\PLR_LICENSE - md tmp\lib - md tmp\symbols - copy %dll% tmp\lib - copy %dll:.dll=.pdb% tmp\symbols - set zip=plr-%APPVEYOR_REPO_COMMIT:~0,8%-pg%pgversion%-R%rversion%-%PLATFORM%-%CONFIGURATION%.zip - 7z a -r %zip% .\tmp\* > nul - ps: | if ("$env:pg" -notmatch "[.]") { pushd c:\projects\postgresql\src\tools\msvc perl install.pl "$env:pgroot" popd } test_script: - path %pgroot%\bin;%PATH% - ps: | if ("$env:pg" -notmatch "[.]") { Set-Content -path pg.pass -value "$env:pgpassword" -encoding ascii initdb -A md5 -U "$env:PGUSER" --pwfile=pg.pass C:\pgdata pg_ctl register -S demand -N "postgresql$env:x64-$env:pgversion" -D c:\pgdata } else { Add-AppveyorMessage "Copying the extension files to the PostgreSQL directories." -Category Information 7z x "$env:zip" "-o$env:pgroot" } - appveyor AddMessage "Starting the database server." -Category Information - setx /M PATH "%R_HOME%\bin\%rbin%;%PATH%" - net start postgresql%x64%-%pgversion% - ps: | Add-AppveyorTest Regression -Framework pg_regress -FileName sql\ -Outcome Running if (("9.3", "9.4").Contains("$env:pgversion")) { $env:psqlopt="--psqldir" } else { $env:psqlopt="--bindir" } $env:Outcome="Passed" $elapsed=(Measure-Command { pg_regress "$env:psqlopt=$env:pgroot\bin" --dbname=pl_regression plr ` bad_fun opt_window do out_args plr_transaction opt_window_frame 2>&1 | %{ if ($_ -is [System.Management.Automation.ErrorRecord]) { $_.Exception.Message } else { $_ } } | Out-Default if ($LASTEXITCODE -ne 0) { $env:Outcome="Failed" } }).TotalMilliseconds Update-AppVeyorTest Regression -Framework pg_regress -FileName sql\ -Outcome "$env:Outcome" -Duration $elapsed if ("$env:Outcome" -ne "Passed") { type regression.diffs $host.SetShouldExit($LastExitCode) } artifacts: - path: '*.zip' deploy: provider: GitHub release: $(appveyor_repo_tag_name) draft: false prerelease: false auth_token: secure: sFXG3dBiC2S9bnHbDfg2fS0OdaxiSr6fGSlMQvQPb0lJGyKM3E5UZum4rik60zyi on: appveyor_repo_tag: true plr-REL8_4_5/buildsetup.pl000066400000000000000000000012471414122415700155540ustar00rootroot00000000000000# first part of postgres build.pl, just doesn't run msbuild use strict; BEGIN { chdir("../../..") if (-d "../msvc" && -d "../../../src"); } use lib "src/tools/msvc"; use Cwd; use Mkvcbuild; # buildenv.pl is for specifying the build environment settings # it should contain lines like: # $ENV{PATH} = "c:/path/to/bison/bin;$ENV{PATH}"; if (-e "src/tools/msvc/buildenv.pl") { do "src/tools/msvc/buildenv.pl"; } elsif (-e "./buildenv.pl") { do "./buildenv.pl"; } # set up the project our $config; do "config_default.pl"; do "config.pl" if (-f "src/tools/msvc/config.pl"); # print "PATH: $_\n" foreach (split(';',$ENV{PATH})); Mkvcbuild::mkvcbuild($config); plr-REL8_4_5/changelog.md000066400000000000000000000565671414122415700153270ustar00rootroot00000000000000# Changelog All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). ## [Unreleased] ## [8.4.5] - 2021-11-03 ### Fixed - added sql upgrade path to fix ## [8.4.4] - 2021-09-29 ### Fixed - changed files names to be consistent with extension version ## [8.4.3] - 2021-08-31 ### Fixed - reverted part of PR#88. postgres has reverted the changes to hex_decode that made it necessary (#120) ## [8.4.2] - 2021-05-28 ### Added - Added support for transactions in procedures. [@petere](https://github.com/petere/plr/commit/1b275d1337f724e0330ecc027186a052509260fa) - Added support for pg custom type (tuple) arguments in window functions ### Changed - Changed R version to 4.10. ## [8.4.1] ### Added - Accept composite argument type. [@ikasou](https://github.com/ikasou) ### Changed - Internal change to postgres api required code change. No noticeable change to users - R can pass to PG arrays of any dimensions. - Major duplicate code removal in R to PG conversion. ## [8.4] - 2019-05-28 ### Added - PostgreSQL 12 support. [@davecramer](https://github.com/davecramer) - Inline language handler and basic syntax checking validator. - Multiple OUT arguments / return RECORD. - pg.throwlog & pg.throwwarning (#9). - AppVeyor build artifacts & CodeCov coverage. ### Changed - No need for R_HOME on Windows (provided registry setting is correct). - Special case optimization for window functions with unbounded frame (#18). - User guide and changelog converted to Markdown. - Streamline arguments list building in plr_convertargs. - throw_pg_notice renamed to throw_pg_log that takes level as well. - Checked whether argument converts to float successfully, use NaN otherwise. Affects PostgreSQL < 11 on Windows (platform toolset v120 and below). - REALSXP vector/array to numeric[] conversion. ### Removed - SGML docs. ### Fixed - Safeguard function body parsing to prevent possible backend crash. - r_typenames() tolerates non-canonical table names. #### CHANGE LOG: 8.3.0.17 TO 8.3.0.18 - Internal code changes to accommodate PostgreSQL V11 internal API Changes #### CHANGE LOG: 8.3.0.16 TO 8.3.0.17 - no changes release simply to add binaries #### CHANGE LOG: 8.3.0.15 TO 8.3.0.16 - Update for PostgreSQL 9.5 dev compatibility - Update copyrights - Add check and throw an error when don't have an expectedDesc. - Remove autocommit setting -- it has been removed in PostgreSQL 9.5, and it has been ineffective for a long time. Reported by Peter E. - Fix RPM spec file #### CHANGE LOG: 8.3.0.14 TO 8.3.0.15 - Update for PostgreSQL 9.3 compatibility - Ensure certain errors in R code do not crash postgres - Unbreak compilation with older versions of postgres not having rangetypes - Allow use of OUT parameters #### CHANGE LOG: 8.3.0.13.1 TO 8.3.0.14 - Update copyright for 2013 - Remove hack to take signal back from R interpreter (Mark Kirkwood) - Set R_SignalHandlers = 0, the proper way to prevent R from taking signals in the first place (Mark Kirkwood) - Adjust RPM spec file - As of pg9.2 the syntax "LANGUAGE 'C'" no longer works. Use "LANGUAGE C" instead. - The MacPorts installation has the header filed distributed across two different directories, so there is no single "rincludedir" to query from pkg-config. Instead, do it the proper way and ask pkg-config for the cflags, which should work for all installation variants. (Peter Eisentraut) #### CHANGE LOG: 8.3.0.13 TO 8.3.0.13.1 - Fix CREATE FUNCTION statements so that they work with PostgreSQL 9.2.x #### CHANGE LOG: 8.3.0.12 TO 8.3.0.13 - Fix Makefile so that msvc scripts can process it successfully - Add support for pgsql 9.1 CREATE EXTENSION - Put in safeguard to prevent attempted return of non-data (e.g. closure) types from R unless the pg return type is BYTEA - Correct thinko from earlier pass-by-val array optimization - Fix crashbug related to conversion of R data.frame to Postgres array on function return - Add plr_version() function: outputs a version string - New feature: allow PL/R functions to be declared and used as WINDOW functions - Minor fixes for compiler warnings by updated gcc - Fix missing calls to UNPROTECT. Report and patch by Ben Leiting. - Take SIGINT back into Postgres control from R. Report and test case by Terry Schmitt. - Don't try to free an array element value when the array element is NULL - Allow pg.spi.prepare/pg.spi.execp to use parameters which are 1D arrays #### CHANGE LOG: 8.3.0.11 TO 8.3.0.12 - Fix Windows only, latent crashbug. Only actually crashes on new Win64 port, but only by luck #### CHANGE LOG: 8.3.0.10 TO 8.3.0.11 - Minor improvements to how/when SPI is connected which reduces unnecessary memory context switching/thrashing - Special case array marshaling, in and out, for int4 and float8 arrays if certain conditions are met. This results in dramatic performance improvement when, for example, passing very large float8 arrays on a 64 bit machine from pg to R. - Fix crashbug where array datum is NULL under certain circumstances - Fix failure under recursive SPI calls - Fix crashbug where error message used dangling pointer - Add plr.spec thanks to Tom Payne. Based on CentOS 5.5, but builds fine on Fedora 13. - silence compiler warning #### CHANGE LOG: 8.3.0.9 TO 8.3.0.10 - Fixed array data type columns incorrectly converted when part of a return tuple - Ensure input datum gets detoasted prior to copying to R object for bytea inputs #### CHANGE LOG: 8.3.0.8 TO 8.3.0.9 - Make PL/R compile under MSVC to produce usable win32 binaries - Updated copyright notices for 2010 - Remove obsolete info from README and point to web site instead - Consolidate and reorder all header files in order to avoid namespace conflicts between postgres/R/Win32 - Rather than referencing pkglib_path and Dynamic_library_path, reference my_exec_path instead. This is because the former are not exported in win32 and the latter is. Instead get Dynamic_library_path by calling GetConfigOptionByName() and pkglib_path by calling get_pkglib_path(). - Recognize hex input since bytea output is formatted that way by default starting with PostgreSQL 9.0 - Avoid dynamic assignments with array constructors since MSVC cannot handle them. - Workaround fact that "char **environ" is not available on win32 for plr_environ() #### CHANGE LOG: 8.3.0.7 TO 8.3.0.8 #### CHANGE LOG: 8.2.0.9 TO 8.2.0.10 - Makefile fix for Mac OSX per kostas savvidis - Added RPostgreSQL compatability functions - Added ability to send serialized R objects to Postgres as bytea return values - Added ability to convert bytea arguments from Postgres back into the original R object - Added function to unserialize bytea value in order to restore object outside of R (useful for image data) - Work on this release was carried out in collaboration with the Chief Information Officer Branch, Treasury Board Secretariat, of the Canadian Government #### CHANGE LOG: 8.3.0.6 TO 8.3.0.7 #### CHANGE LOG: 8.2.0.8 TO 8.2.0.9 #### CHANGE LOG: 0.6.2.9 TO 0.6.2.10 - Fixed "Rdevices.h" not found error related to R-2.8.x - Fixed crashbug reported by Jeff Hamann. When a data frame had a factor column with a value in the first row, but NA in a subsequent row, a non-trapped R error would cause a segfault (PL/R's bug, not R) - Corrected Makefile for use on Gentoo per Ian Stakenvicius - Add facility to create pdf version of docs #### CHANGE LOG: 8.3.0.5-BETA TO 8.3.0.6 #### CHANGE LOG: 8.2.0.7 TO 8.2.0.8 #### CHANGE LOG: 0.6.2.8 TO 0.6.2.9 - Fix Makefile for include directory names with embedded spaces - Eliminate warnings that started with R-2.6.0 related to lack of const declarations - Add --no-restore to startup options - Fix old bug related to Rversion.h appearing after user of R_VERSION in precompiler tests. Led to Rembedded.h not getting included - Added explicit define for KillAllDevices as it has been removed from Rdevices.h as of R-2.7.0 #### CHANGE LOG: 8.3.0.4-BETA TO 8.3.0.5-BETA #### CHANGE LOG: 8.2.0.6 TO 8.2.0.7 #### CHANGE LOG: 0.6.2.7 TO 0.6.2.8 - fix for non-portable use of setenv #### CHANGE LOG: 8.3.0.3-BETA TO 8.3.0.4-BETA #### CHANGE LOG: 8.2.0.5 TO 8.2.0.6 #### CHANGE LOG: 0.6.2.6 TO 0.6.2.7 - If R_HOME environment variable is not defined, attempt to find it using pkg-config. (idea from Dirk Eddelbuettel) - In any case, create define for default R_HOME based on pkg-config. Use the default R_HOME during R interpreter init if the environment variable is unset. (idea from Dirk Eddelbuettel) - Use PGdlLIMPORT instead of dlLIMPORT if it is defined. - Switch to Rf_isVectorList instead of IS_LIST for spi_execp argument test. Prior to R-2.4.0, the latter allows bad arguments to get past, causing a segfault in an R internal type coersion function. (found by Steve Singer) - New spi cursor manipulation functions (patch courtesy of Steve Singer). - Force R interpreter non-interactive mode. Fixes some cases that previously appeared to be hung postgres backends in certain errors occured in R (R was actually waiting for user input). On some platforms this situation caused segfaults instead. (found by Jie Zhang) - When a plr function source is empty, plr tries to find a function by the same name within the R interpreter environment. If the function could not be found, it would cause a hang or segfault. This was not easily trapped in the R interpreter. Now, build and compile the equivalent plr source. This allows the R interpreter to trap the error properly when the function does not exist. (found by Jie Zhang) - PG_VERSION_NUM if available. (patch courtesy of Neal Conway) - Plug memory leak in POP_PLERRCONTEXT. (patch courtesy of Steve Singer) #### CHANGE LOG: 8.3.0.2-BETA TO 8.3.0.3-BETA #### CHANGE LOG: 8.2.0.4 TO 8.2.0.5 #### CHANGE LOG: 0.6.2.5 TO 0.6.2.6 - modify Makefile so that the build works on win32 without workarounds - strip or replace embedded carriage returns to prevent R engine syntax errors - Win32 Binaries and installers courtesy of Mike Leahy #### CHANGE LOG: 8.3.0.1-BETA TO 8.3.0.2-BETA #### CHANGE LOG: 8.2.0.3 TO 8.2.0.4 #### CHANGE LOG: 0.6.2.4 TO 0.6.2.5 - add dlLIMPORT to Dynamic_library_path declaration for Win32 support (thanks to Mike Leahy for the critical clues) - add pkglib_path[] declaration for Win32 support - modify debug code for PROTECT/UNPROTECT - add missing UNPROTECT(1) in spi code -- fix for "stack imbalance" warning - see the docs for notes on Windows installation. #### CHANGE LOG: 8.3.0-BETA TO 8.3.0.1-BETA #### CHANGE LOG: 8.2.0.2 TO 8.2.0.3 #### CHANGE LOG: 0.6.2.3 TO 0.6.2.4 - fix crash related to mishandling of R parse errors; thanks to Steve Singer for report and test case #### CHANGE LOG: 8.2.0.1-BETA TO 8.3.0-BETA - preserve callers memory context rather than assuming query memory context - register plr_atexit using atexit() so that when R interpreter exit()'s on failure to initialize (e.g. if R_HOME is incorrect) we throw an error instead of killing the postgres backend unexpectedly - fix crash related to HeapTupleHeaderGetCmin() no longer working as before - replace call to R function lcons() with explicit call to Rf_lcons() since postgres also has an lcons() function (Neil Conway) - use PG_DETOAST_DATUM() on array arguments to ensure they get detoasted if needed - R and Postgres attempt to define symbols with the same name in their header files. Change to workaround alternative that is less of a kludge (Neil Conway) - fix for R_VERSION >= 2.5.0, R_ParseVector has extra arguments #### CHANGE LOG: 8.2.0.1-BETA TO 8.2.0.2 - preserve callers memory context rather than assuming query memory context - register plr_atexit using atexit() so that when R interpreter exit()'s on failure to initialize (e.g. if R_HOME is incorrect) we throw an error instead of killing the postgres backend unexpectedly - replace call to R function lcons() with explicit call to Rf_lcons() since postgres also has an lcons() function (Neil Conway) - use PG_DETOAST_DATUM() on array arguments to ensure they get detoasted if needed - R and Postgres attempt to define symbols with the same name in their header files. Change to workaround alternative that is less of a kludge (Neil Conway) - fix for R_VERSION >= 2.5.0, R_ParseVector has extra arguments #### CHANGE LOG: 0.6.2.2-ALPHA TO 0.6.2.3 - preserve callers memory context rather than assuming query memory context - register plr_atexit using atexit() so that when R interpreter exit()'s on failure to initialize (e.g. if R_HOME is incorrect) we throw an error instead of killing the postgres backend unexpectedly - replace call to R function lcons() with explicit call to Rf_lcons() since postgres also has an lcons() function (Neil Conway) - use PG_DETOAST_DATUM() on array arguments to ensure they get detoasted if needed - fix for R_VERSION >= 2.5.0, R_ParseVector has extra arguments #### CHANGE LOG: 8.2.0-BETA TO 8.2.0.1-BETA *Security related fix (thanks to Jeffrey R. Greco):* - plr_modules table must now exist in the same schema as the language handler of the first executing PL/R function - added to install script: REVOKE EXECUTE ON FUNCTION install_rcmd (text) FROM PUBLIC #### CHANGE LOG: 0.6.2.1-ALPHA TO 0.6.2.2-ALPHA *Security related fix (thanks to Jeffrey R. Greco):* - plr_modules table must now exist in the same schema as the language handler of the first executing PL/R function - added to install script: REVOKE EXECUTE ON FUNCTION install_rcmd (text) FROM PUBLIC #### CHANGE LOG: 0.6.2-ALPHA TO 8.2.0-BETA *Update:* - Modify to work properly with PostgreSQL 8.2 (soon-to-be-beta) and R 2.3.x. - Support for previous versions of PostgreSQL removed. From this point forward PL/R releases will be kept in sync with PostgreSQL major releases - Added support for NULL array elements Security related fix (thanks to Jeffrey R. Greco): - plr_modules table must now exist in the same schema as the executing PL/R function #### CHANGE LOG: 0.6.2-ALPHA TO 0.6.2.1-ALPHA - Security related fix (thanks to Jeffrey R. Greco): - plr_modules table must now exist in the same schema as the executing PL/R function #### CHANGE LOG: 0.6.1-ALPHA TO 0.6.2-ALPHA *Update:* - Modify to work properly with PostgreSQL 8.1beta and R 2.1.x. *Bug fixes:* - Adjust makefiles to ensure PKGLIBDIR and dlSUFFIX are defined to non-empty strings before trying to use them. - Fix crash bug when plr.so could not be found by expand_dynamic_library_name(). - Add missing include for "utils/memutils.h". - Fix problem of $libdir not being found on pgxs builds. - Eliminate installcheck override warning. #### CHANGE LOG: 0.6.0B-ALPHA TO 0.6.1-ALPHA *Update:* - Modify to work properly with PostgreSQL 8.0.0 and R 2.0.x. *Bug fixes:* - Initialize flinfo struct properly - Fix improper casting of factor levels to integers. Original works fine on 32 bit Intel systems, but causes compiler warnings and segfaults on 64 bit systems. - Added PGXS makefile - Fix resource leak -- one PROTECT() was missing its compliment UNPROTECT in pg_conversion. #### CHANGE LOG: 0.6.0-ALPHA TO 0.6.0B-ALPHA *Packaging fix:* - Package now untars to ./plr instead of ./plr-0.6.0, allowing `make installcheck` to work properly. #### CHANGE LOG: 0.5.4-ALPHA TO 0.6.0-ALPHA *Bug fixes:* - Handle dropped columns correctly. - Adjust Makefile for dylib suffix expected on libR on Mac OS X machines. - Transform '_' to '.' in data.frame column names derived from Postgres tuples for R < 1.9.0. *Enhancements:* - Several adjustments to stay current with Postgres 7.5 and R-1.9.0. - Add support for explicit argument names (requires Postgres 7.5devel). *Documentation:* - Update sgml to DocBook V4.2. - Add tip regarding /etc/ld.so.conf & ldconfig. - Mention explicit argument support. - Correct instances of "returns record" to "returns setof record". - Add mention of load_r_typenames() (was missing entirely). #### CHANGE LOG: 0.5.3-ALPHA TO 0.5.4-ALPHA *Bug fixes:* - Added additional R interpreter clean shutdown actions. #### CHANGE LOG: 0.5.2-ALPHA TO 0.5.3-ALPHA *Bug fixes:* - Detect R version. Starting with R version 1.8.0 eliminate the need to use declarations from non-exported R headers. #### CHANGE LOG: 0.5.1-ALPHA TO 0.5.2-ALPHA *Bug fixes:* - Fix portability issue when compiling for pg7.3 with older gcc versions. Documentation: - Document pg.state.firstpass #### CHANGE LOG: 0.5.0-ALPHA TO 0.5.1-ALPHA *Bug fixes:* - Fix crash bug -- if ERROR occurred during SQL call, e.g. while using pg.spi.exec, R never got the chance to clean up properly. In some cases this would lead to a crash. Now sections that might possibly generate elog/ereports beneath plr's control while executing code called from the R interpreter are wrapped in "if (sigsetjmp(Warn_restart...". This grabs back control before it is returned to the postmaster, and allows us to call R's "error()" function. Now we can allow the R interpreter to gracefully clean up and exit with an error flagged. On the other side of the R eval call, we grab the error flag, and generate another error. - Fix for Rtmp[pid] directories left unremoved on backend exit -- add an exit callback using Postgres on_proc_exit() function. The callback function then calls Rstd_CleanUp(). - Match change to PL/pgSQL by Tom Lane. When compiling a plr trigger function, include the OID of the table the trigger is attached to in the hashkey. This ensures that we will create separate compiled trees for each table the trigger is used with, avoiding possible datatype-mismatch problems if the tables have different rowtypes. - Minor documentation improvments #### CHANGE LOG: 0.4.5-ALPHA TO 0.5.0-ALPHA Author's Note: This release is probably the last alpha release. With the addition of trigger support, I think PL/R is (nearly?) feature complete. Note that there are some significant changes to semantics with respect to NULLs and NAs in this release. I'm very interested in feedback -- please find my email address in README.plr to report bugs, obvious omissions, etc. I'd also be interested in hearing how PL/R is being used. Enhancements: - Added trigger support, and corresponding documentation and regression test support - Adapted error reporting to new PostgreSQL 7.4 style, including error codes and nested contexts - Backported PostgreSQL 7.4 backend error reporting functions and enabled when building against Postgres 7.3 - Modified compiled function caching to uniquely cache polymorphic functions based on runtime argument types Behavior changes/Bug fixes: - Fix behavior of empty vector return values when pg return type is a pg array. Did return NULL; now returns empty pg array of correct data type. - Fix behavior of NULL arguments for Postgres scalars and arrays. Did produce a single element vector with the element value of NA. Now produces a true R NULL object instead. - Fix behavior of NULL fields in Postgres composite types used as arguments. Now produces R object with NA in the corresponding column position. - Fix behavior when returning R data.frames or matrixes as Postgres composite types. Now correctly converts R "NA" values to Postgres "NULL" values in the result set. - Minor adjustment of returning of empty arrays; fix case of empty multidimensional arrays and data.frames - Adjust to change in call interface of get_fn_expr_rettype and get_fn_expr_argtype in PostgreSQL 7.4devel. - Changes needed to fix compilation under Postgres 7.3. - Now have two regression expected files -- one for 7.3 and one for 7.4. - Remove dims and dimnames attribute from data.frames created by pg_tuple_get_r_frame(). This fixes a problem that lm() was having with plr created data.frames, and appears to be correct based on the docs and data.frames created by R itself (examined using dput()). - Remove the preloaded TYPEOIDS and provide instead a new function, load_r_typenames(), that provides the same global variables in the R interpreter. But instead of making *every* connection pay the price, now it can be used on demand only when needed. - Reworked initialization functions -- now use plr_init when using the postgresql.conf preload_libraries parameter - Fixed problem with plr_SPI_context global not handling reentrancy correctly, leading to crash when throw_pg_notice was called from a nested plr function. LOG: 0.4.4-ALPHA TO 0.4.5-ALPHA *Bug fixes:* - Adjust to a change in the call interface of get_fn_expr_rettype() and get_fn_expr_argtype in PostgreSQL 7.4devel. #### CHANGE LOG: 0.4.2-ALPHA TO 0.4.4-ALPHA *Bug fixes:* - Changed declaration of environ to something (hopefully) more portable Documentation: - Fixed synchronization of actual function names with those in the text/examples. #### CHANGE LOG: 0.4.0-ALPHA TO 0.4.2-ALPHA *Enhancements:* - Remove the --gui=none argument from the embedded interpreter initialization. This allows use of a graphics device such as jpeg, so that charts can be rendered and spooled to disk for, e.g., pickup by a PHP script. *Bug fixes:* - Add missing include (exposed by recent Postgres 7.4devel change) #### CHANGE LOG: 0.3.1-ALPHA TO 0.4.0-ALPHA *Enhancements:* - Added support for Postgres 7.4 polymorphic array types as arguments and return types - Added function reload_plr_modules to reload plr_modules after a change - Added function plr_environ to display environment variables *Bug fixes:* - Fix crashbug in load_r_cmd affecting functions loaded via plr_modules and install_rcmd() Documentation: - Updated installation notes for R 1.7.0 and Red Hat 9 - Updated PostgreSQL Support Functions with new functions reload_plr_modules and plr_environ - Updated PostgreSQL Support Functions: existing array* function names changed to plr_array* to avoid conflict with PostgreSQL 7.4devel built in functions #### CHANGE LOG: 0.3.0-ALPHA TO 0.3.1-ALPHA *Bug fixes:* - Minor change to regression test Documentation: - Note passage of regression test under PostgreSQL 7.4devel and R 1.7devel #### CHANGE LOG: 0.1.0-ALPHA TO 0.3.0-ALPHA *Enhancements:* - Added case to allow returning setof scalar datatype -- until now, had to use record or define one column tuple type. - Added support for 3D PostgreSQL arrays as input arguments to PL/R functions. - Added support for returning 3D arrays. Specifically, if the R return value is a 3D array, and the PL/R function is declared to return an array type, the returned array will also be 3D. - Change start_interp from static to extern so that it can be called by the Postmaster during startup. This allows PL/R and R itself to be loaded and initialized before backends are forked, saving the startup time for each backend. *Bug fixes:* - Check for R_HOME defined in the environment and refuse to start if it isn't. If we don't, R will, and when it unexpectedly exits, we segfault. - Fix bug that allowed function returning record or tupletype, but not setof, to return all the rows instead of just one. - Fix bug that allowed function returning tuptype in targetlist to crash instead of just complaining about bad context. - Fix crash bug -- trap NULL msg pointer passed to throw_pg_notice(and error). - Fix bug: integer argument with value = 0 was converted to NA in R. Now appropriately passes the 0 value as-is. *Documentation:* - Adjust return type mapping table for "setof" scalar and composite. - Crossref module install with global data section. - Document '' (that is, empty string) used as function body if PostgreSQL and R function names match. - Added tip regarding setting R_HOME for postgres user before starting the postmaster. - Improve docs by moving "overview" to first, and renaming and improving old "intro", new "install" chapter. - References to arg[] changed to _arg and tip added. - Updated documentation for 3D array support. [Unreleased]: https://github.com/postgres-plr/plr/compare/REL8_4..HEAD [8.4]: https://github.com/postgres-plr/plr/compare/REL8_3_0_18...REL8_4 plr-REL8_4_5/compilingplr.md000066400000000000000000000067501414122415700160640ustar00rootroot00000000000000I successfully did the following recently in order to build 64 bit PL/R on Windows 10: ---------------- dumpbin /exports R.dll > R.dump.csv Note that I used the csv extension so OpenOffice would import the file into a spreadsheet conveniently. Edit R.dump.csv to produce a one column file of symbols called R.def. cat R.dump.csv | tr -s ' ' | cut -d ' ' -f 5 > R.def Add the following two lines to the top of the file: LIBRARY R EXPORTS Then run the following using R.def lib /def:R.def /out:R.lib move R.lib to the bin dir of R run build from postgres/src/tools/msvc run install to install postgresql initdb to create the cluster start postgres using pg_ctl -D data -l logfile start_ vcregress plcheck will run the tests I had to edit the test sql to comment out the loading of plr.sql to get the test to pass Very important do make sure that your path points to the right location IF YOU INSTALLED R IN Program Files\R\R... the PATH MUST HAVE C:\Program Files\R\R\bin\x64 or C:\Program Files\R\R\bin\i386 msvc.diff ```diff diff --git a/src/tools/msvc/Mkvcbuild.pm b/src/tools/msvc/Mkvcbuild.pm index fe905d3..97200bb 100644 --- a/src/tools/msvc/Mkvcbuild.pm +++ b/src/tools/msvc/Mkvcbuild.pm @@ -46,7 +46,7 @@ my @contrib_excludes = ( 'ltree_plpython', 'pgcrypto', 'sepgsql', 'brin', 'test_extensions', 'test_pg_dump', - 'snapshot_too_old'); + 'snapshot_too_old','plr'); # Set of variables for frontend modules my $frontend_defines = { 'initdb' => 'FRONTEND' }; @@ -453,6 +453,15 @@ sub mkvcbuild $pgcrypto->AddLibrary('ws2_32.lib'); my $mf = Project::read_file('contrib/pgcrypto/Makefile'); GenerateContribSqlFiles('pgcrypto', $mf); + my $plr = $solution->AddProject('plr','dll','plr'); + $plr->AddFiles( + 'src\pl\plr','plr.c','pg_conversion.c','pg_backend_support.c','pg_userfuncs.c','pg_rsupport.c' + ); + $plr->AddReference($postgres); + $plr->AddLibrary('C:\Program Files\R\R-3.3.1\bin\R.lib'); + $plr->AddIncludeDir('C:\Program Files\R\R-3.3.1\include'); + my $mfplr = Project::read_file('src/pl/plr/Makefile'); + GenerateContribSqlFiles('plr', $mfplr); foreach my $subdir ('contrib', 'src/test/modules') { @@ -822,14 +831,14 @@ sub GenerateContribSqlFiles if (Solution::IsNewer("contrib/$n/$out", "contrib/$n/$in")) { - print "Building $out from $in (contrib/$n)...\n"; - my $cont = Project::read_file("contrib/$n/$in"); + print "Building $out from $in (src/pl/$n)...\n"; + my $cont = Project::read_file("src/pl/$n/$in"); my $dn = $out; $dn =~ s/\.sql$//; $cont =~ s/MODULE_PATHNAME/\$libdir\/$dn/g; my $o; - open($o, ">contrib/$n/$out") - || croak "Could not write to contrib/$n/$d"; + open($o, ">src/pl/$n/$out") + || croak "Could not write to src/pl/$n/$d"; print $o $cont; close($o); } diff --git a/src/tools/msvc/vcregress.pl b/src/tools/msvc/vcregress.pl index b4f9464..9593d36 100644 --- a/src/tools/msvc/vcregress.pl +++ b/src/tools/msvc/vcregress.pl @@ -222,7 +222,7 @@ sub plcheck { chdir "../../pl"; - foreach my $pl (glob("*")) + foreach my $pl (glob("plr")) { next unless -d "$pl/sql" && -d "$pl/expected"; my $lang = $pl eq 'tcl' ? 'pltcl' : $pl; @@ -260,6 +260,7 @@ sub plcheck "../../../$Config/pg_regress/pg_regress", "--bindir=../../../$Config/psql", "--dbname=pl_regression", @lang_args, @tests); + print join(" ", @args) . "\n"; system(@args); my $status = $? >> 8; exit $status if $status; ``` plr-REL8_4_5/expected/000077500000000000000000000000001414122415700146345ustar00rootroot00000000000000plr-REL8_4_5/expected/bad_fun.out000066400000000000000000000004231414122415700167620ustar00rootroot00000000000000-- should error out but should not crash PG CREATE OR REPLACE FUNCTION r_bad_fun() RETURNS int4 AS $BODY$ deadbeef <- function(,bad) {} 42 $BODY$ LANGUAGE plr; ERROR: R interpreter parse error DETAIL: R parse error caught in "{ deadbeef <- function(,bad) {} 42 }". plr-REL8_4_5/expected/do.out000066400000000000000000000001761414122415700157730ustar00rootroot00000000000000do language plr ' pg.throwlog("Hello, world!") '; do language plr ' pg.thrownotice("Hello, world!") '; NOTICE: Hello, world! plr-REL8_4_5/expected/opt_window.out000066400000000000000000000014201414122415700175530ustar00rootroot00000000000000create or replace function fast_win(a int4, b bigint) returns bool AS $$ ##is.null(farg2) || pg.throwerror('Constants shall not be passes with the frame') identical(parent.frame(), .GlobalEnv) && pg.throwerror('Parent env is global') exists('plr_window_frame', parent.frame(), inherits=FALSE) || pg.throwerror('No window frame data found') a == farg1[prownum] $$ window language plr; select s, p, fast_win(NULLIF(s, 4), 123) over w from ( select s, s % 2 as p from generate_series(1,10) s ) foo window w as (partition by p order by s rows between unbounded preceding and unbounded following) order by s; s | p | fast_win ----+---+---------- 1 | 1 | t 2 | 0 | t 3 | 1 | t 4 | 0 | 5 | 1 | t 6 | 0 | t 7 | 1 | t 8 | 0 | t 9 | 1 | t 10 | 0 | t (10 rows) plr-REL8_4_5/expected/opt_window_frame.out000066400000000000000000000014361414122415700207340ustar00rootroot00000000000000create or replace function fast_win_frame(r int, t record) returns bool AS $$ identical(parent.frame(), .GlobalEnv) && pg.throwerror('Parent env is global') exists('plr_window_frame', parent.frame(), inherits=FALSE) || pg.throwerror('No window frame data found') r == farg2[[prownum,2]][3] $$ window language plr; select s.r, s.p, fast_win_frame(NULLIF(r,4), (s.r, s.q)) over w from (select r, r % 2 as p, array_fill(case when r=7 then 77 else r end, ARRAY[3]) as q from generate_series(1,10) r) s window w as (partition by p order by r rows between unbounded preceding and unbounded following) order by s.r; r | p | fast_win_frame ----+---+---------------- 1 | 1 | t 2 | 0 | t 3 | 1 | t 4 | 0 | 5 | 1 | t 6 | 0 | t 7 | 1 | f 8 | 0 | t 9 | 1 | t 10 | 0 | t (10 rows) plr-REL8_4_5/expected/out_args.out000066400000000000000000000024171414122415700172140ustar00rootroot00000000000000-- this is non-SRF returning record --create or replace function out_float8(out x float8, in a float8, out y float8[]) as $$ create or replace function out_float8(out x anyelement, in a anyelement, out y anyarray) as $$ list(a, rep(a, 3)) $$ language plr; select * from out_float8(42.5); -- NUMERICOID x | y ------+------------------ 42.5 | {42.5,42.5,42.5} (1 row) select * from out_float8(42.5::float8); x | y ------+------------------ 42.5 | {42.5,42.5,42.5} (1 row) select * from out_float8(42.5::int2); x | y ----+------------ 43 | {43,43,43} (1 row) -- SRF create or replace function out__float8(out x float8, in a float8[], out y float8) returns setof record as $$ data.frame(a, a*2) $$ language plr; select * from out__float8(ARRAY[123,NULL,42.5]); x | y ------+----- 123 | 246 | 42.5 | 85 (3 rows) -- window function can't return setof create or replace function out_fun_win(out x2 float8, in a float8, out p2 float8) AS $$ list(x=a*2, y=a+2) $$ window language plr; select s, bar.* from ( select s, row_to_json(out_fun_win(s) over ()) j from generate_series(1,2) s ) foo , lateral json_to_record(j) as bar(x2 float8, p2 float8); s | x2 | p2 ---+----+---- 1 | 2 | 3 2 | 4 | 4 (2 rows) plr-REL8_4_5/expected/plr.out000077500000000000000000001261731414122415700161770ustar00rootroot00000000000000-- install extension create extension plr; -- make sure we get the notices set client_min_messages to notice; -- check version SELECT plr_version(); plr_version ------------- 8.4 (1 row) -- make typenames available in the global namespace select load_r_typenames(); load_r_typenames ------------------ OK (1 row) CREATE TABLE plr_modules ( modseq int4, modsrc text ); INSERT INTO plr_modules VALUES (0, 'pg.test.module.load <-function(msg) {print(msg)}'); select reload_plr_modules(); reload_plr_modules -------------------- OK (1 row) -- -- plr_modules test -- create or replace function pg_test_module_load(text) returns text as 'pg.test.module.load(arg1)' language 'plr'; select pg_test_module_load('hello world'); pg_test_module_load --------------------- hello world (1 row) -- -- user defined R function test -- select install_rcmd('pg.test.install <-function(msg) {print(msg)}'); install_rcmd -------------- OK (1 row) create or replace function pg_test_install(text) returns text as 'pg.test.install(arg1)' language 'plr'; select pg_test_install('hello world'); pg_test_install ----------------- hello world (1 row) -- -- test simple input/output types -- CREATE OR REPLACE FUNCTION rint2(i int2) RETURNS int2 AS $$ return (as.integer(i)) $$ LANGUAGE plr; select rint2(1::int2); rint2 ------- 1 (1 row) select rint2(NULL); rint2 ------- (1 row) CREATE OR REPLACE FUNCTION rint4(i int4) RETURNS int4 AS $$ return (as.integer(i)) $$ LANGUAGE plr; select rint4(1::int4); rint4 ------- 1 (1 row) select rint4(NULL); rint4 ------- (1 row) CREATE OR REPLACE FUNCTION rint8(i int8) RETURNS int8 AS $$ return (as.integer(i)) $$ LANGUAGE plr; select rint8(1::int8); rint8 ------- 1 (1 row) select rint8(NULL); rint8 ------- (1 row) CREATE OR REPLACE FUNCTION rbool(b bool) RETURNS bool AS $$ return (as.logical(b)) $$ LANGUAGE plr; select rbool('t'); rbool ------- t (1 row) select rbool('f'); rbool ------- f (1 row) select rbool(NULL); rbool ------- (1 row) CREATE OR REPLACE FUNCTION rfloat(inout f anyelement, out isnull boolean, out isna boolean, out isnan boolean) AS $$ list(as.numeric(f), is.null(f), is.na(f), is.nan(f)) $$ LANGUAGE plr; select rfloat(1::int4); rfloat ----------- (1,f,f,f) (1 row) select rfloat(1::float4); rfloat ----------- (1,f,f,f) (1 row) select rfloat(NULL::float4); rfloat -------- (,t,,) (1 row) select rfloat('NaN'::float4); rfloat ------------- (NaN,f,t,t) (1 row) select rfloat(1::float8); rfloat ----------- (1,f,f,f) (1 row) select rfloat(NULL::float8); rfloat -------- (,t,,) (1 row) select rfloat('NaN'::float8); rfloat ------------- (NaN,f,t,t) (1 row) select rfloat(1); -- numeric rfloat ----------- (1,f,f,f) (1 row) -- -- a variety of plr functions -- create or replace function throw_notice(text) returns text as 'pg.thrownotice(arg1)' language 'plr'; select throw_notice('hello'); NOTICE: hello throw_notice -------------- (1 row) create or replace function paste(_text,_text,text) returns text[] as 'paste(arg1,arg2, sep = arg3)' language 'plr'; select paste('{hello, happy}','{world, birthday}',' '); paste ---------------------------------- {"hello world","happy birthday"} (1 row) create or replace function vec(_float8) returns _float8 as 'arg1' language 'plr'; select vec('{1.23, 1.32}'::float8[]); vec ------------- {1.23,1.32} (1 row) create or replace function vec(float, float) returns _float8 as 'c(arg1,arg2)' language 'plr'; select vec(1.23, 1.32); vec ------------- {1.23,1.32} (1 row) create or replace function echo(text) returns text as 'print(arg1)' language 'plr'; select echo('hello'); echo ------- hello (1 row) create or replace function reval(text) returns text as 'eval(parse(text = arg1))' language 'plr'; select reval('a <- sd(c(1,2,3)); b <- mean(c(1,2,3)); a + b'); reval ------- 3 (1 row) create or replace function "commandArgs"() returns text[] as '' language 'plr'; select "commandArgs"(); commandArgs ------------------------------------------------ {PL/R,--slave,--silent,--no-save,--no-restore} (1 row) create or replace function vec(float) returns text as 'c(arg1)' language 'plr'; select vec(1.23); vec ------ 1.23 (1 row) create or replace function reval(_text) returns text as 'eval(parse(text = arg1))' language 'plr'; select round(reval('{"sd(c(1.12,1.23,1.18,1.34))"}'::text[])::numeric,8); round ------------ 0.09322911 (1 row) create or replace function print(text) returns text as '' language 'plr'; select print('hello'); print ------- hello (1 row) create or replace function cube(int) returns float as 'sq <- function(x) {return(x * x)}; return(arg1 * sq(arg1))' language 'plr'; select cube(3); cube ------ 27 (1 row) create or replace function sd(_float8) returns float as 'sd(arg1)' language 'plr'; select round(sd('{1.23,1.31,1.42,1.27}'::_float8)::numeric,8); round ------------ 0.08180261 (1 row) create or replace function sd(_float8) returns float as '' language 'plr'; select round(sd('{1.23,1.31,1.42,1.27}'::_float8)::numeric,8); round ------------ 0.08180261 (1 row) create or replace function mean(_float8) returns float as '' language 'plr'; select mean('{1.23,1.31,1.42,1.27}'::_float8); mean -------- 1.3075 (1 row) create or replace function sprintf(text,text,text) returns text as 'sprintf(arg1,arg2,arg3)' language 'plr'; select sprintf('%s is %s feet tall', 'Sven', '7'); sprintf --------------------- Sven is 7 feet tall (1 row) -- -- test aggregates -- do language plpgsql $body$ declare version_12plus bool; begin select current_setting('server_version_num')::integer >= 120000 into version_12plus; if(version_12plus) then create table foo(f0 int, f1 text, f2 float8); else execute $$create table foo(f0 int, f1 text, f2 float8) with oids;$$; end if; end $body$; insert into foo values(1,'cat1',1.21); insert into foo values(2,'cat1',1.24); insert into foo values(3,'cat1',1.18); insert into foo values(4,'cat1',1.26); insert into foo values(5,'cat1',1.15); insert into foo values(6,'cat2',1.15); insert into foo values(7,'cat2',1.26); insert into foo values(8,'cat2',1.32); insert into foo values(9,'cat2',1.30); create or replace function r_median(_float8) returns float as 'median(arg1)' language 'plr'; select r_median('{1.23,1.31,1.42,1.27}'::_float8); r_median ---------- 1.29 (1 row) CREATE AGGREGATE median (sfunc = plr_array_accum, basetype = float8, stype = _float8, finalfunc = r_median); select f1, median(f2) from foo group by f1 order by f1; f1 | median ------+-------- cat1 | 1.21 cat2 | 1.28 (2 rows) create or replace function r_gamma(_float8) returns float as 'gamma(arg1)' language 'plr'; select round(r_gamma('{1.23,1.31,1.42,1.27}'::_float8)::numeric,8); round ------------ 0.91075486 (1 row) CREATE AGGREGATE gamma (sfunc = plr_array_accum, basetype = float8, stype = _float8, finalfunc = r_gamma); select f1, round(gamma(f2)::numeric,8) from foo group by f1 order by f1; f1 | round ------+------------ cat1 | 0.91557649 cat2 | 0.93304093 (2 rows) -- -- test returning vectors, arrays, matricies, and dataframes -- as scalars, arrays, and records -- create or replace function test_vt() returns text as 'array(1:10,c(2,5))' language 'plr'; select test_vt(); test_vt --------- 1 (1 row) create or replace function test_vi() returns int as 'array(1:10,c(2,5))' language 'plr'; select test_vi(); test_vi --------- 1 (1 row) create or replace function test_mt() returns text as 'as.matrix(array(1:10,c(2,5)))' language 'plr'; select test_mt(); test_mt --------- 1 (1 row) create or replace function test_mi() returns int as 'as.matrix(array(1:10,c(2,5)))' language 'plr'; select test_mi(); test_mi --------- 1 (1 row) create or replace function test_dt() returns text as 'as.data.frame(array(1:10,c(2,5)))[[1]]' language 'plr'; select test_dt(); test_dt --------- 1 (1 row) create or replace function test_di() returns int as 'as.data.frame(array(1:10,c(2,5)))[[1]]' language 'plr'; select test_di() as error; error ------- 1 (1 row) create or replace function test_vta() returns text[] as 'array(1:10,c(2,5))' language 'plr'; select test_vta(); test_vta ---------------------------- {{1,3,5,7,9},{2,4,6,8,10}} (1 row) create or replace function test_via() returns int[] as 'array(1:10,c(2,5))' language 'plr'; select test_via(); test_via ---------------------------- {{1,3,5,7,9},{2,4,6,8,10}} (1 row) create or replace function test_mta() returns text[] as 'as.matrix(array(1:10,c(2,5)))' language 'plr'; select test_mta(); test_mta ---------------------------- {{1,3,5,7,9},{2,4,6,8,10}} (1 row) create or replace function test_mia() returns int[] as 'as.matrix(array(1:10,c(2,5)))' language 'plr'; select test_mia(); test_mia ---------------------------- {{1,3,5,7,9},{2,4,6,8,10}} (1 row) create or replace function test_dia() returns int[] as 'as.data.frame(array(1:10,c(2,5)))' language 'plr'; select test_dia(); test_dia ---------------------------- {{1,3,5,7,9},{2,4,6,8,10}} (1 row) create or replace function test_dta() returns text[] as 'as.data.frame(array(1:10,c(2,5)))' language 'plr'; select test_dta(); test_dta ---------------------------- {{1,3,5,7,9},{2,4,6,8,10}} (1 row) create or replace function test_dta1() returns text[] as 'as.data.frame(array(letters[1:10], c(2,5)))' language 'plr'; select test_dta1(); test_dta1 --------------------------- {{a,c,e,g,i},{b,d,f,h,j}} (1 row) create or replace function test_dta2() returns text[] as 'as.data.frame(data.frame(letters[1:10],1:10))' language 'plr'; select test_dta2(); test_dta2 ---------------------------------------------------------------- {{a,1},{b,2},{c,3},{d,4},{e,5},{f,6},{g,7},{h,8},{i,9},{j,10}} (1 row) -- generates expected error create or replace function test_dia1() returns int[] as 'as.data.frame(array(letters[1:10], c(2,5)))' language 'plr'; create or replace function test_dia1_wrap() returns text as $body$ begin select test_dia1() as error; return 'failed'; exception when invalid_text_representation then return 'ok'; end; $body$ language plpgsql; select test_dia1_wrap(); test_dia1_wrap ---------------- ok (1 row) create or replace function test_dtup() returns setof record as 'data.frame(letters[1:10],1:10)' language 'plr'; select * from test_dtup() as t(f1 text, f2 int); f1 | f2 ----+---- a | 1 b | 2 c | 3 d | 4 e | 5 f | 6 g | 7 h | 8 i | 9 j | 10 (10 rows) create or replace function test_mtup() returns setof record as 'as.matrix(array(1:15,c(5,3)))' language 'plr'; select * from test_mtup() as t(f1 int, f2 int, f3 int); f1 | f2 | f3 ----+----+---- 1 | 6 | 11 2 | 7 | 12 3 | 8 | 13 4 | 9 | 14 5 | 10 | 15 (5 rows) create or replace function test_vtup() returns setof record as 'as.vector(array(1:15,c(5,3)))' language 'plr'; select * from test_vtup() as t(f1 int); f1 ---- 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 (15 rows) create or replace function test_vint() returns setof int as 'as.vector(array(1:15,c(5,3)))' language 'plr'; select * from test_vint(); test_vint ----------- 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 (15 rows) -- -- try again with named tuple types -- CREATE TYPE dtup AS (f1 text, f2 int); CREATE TYPE mtup AS (f1 int, f2 int, f3 int); CREATE TYPE vtup AS (f1 int); create or replace function test_dtup1() returns setof dtup as 'data.frame(letters[1:10],1:10)' language 'plr'; select * from test_dtup1(); f1 | f2 ----+---- a | 1 b | 2 c | 3 d | 4 e | 5 f | 6 g | 7 h | 8 i | 9 j | 10 (10 rows) create or replace function test_dtup2() returns setof dtup as 'data.frame(c("c","qw","ax","h","k","ax","l","t","b","u"),1:10)' language 'plr'; select * from test_dtup2(); f1 | f2 ----+---- c | 1 qw | 2 ax | 3 h | 4 k | 5 ax | 6 l | 7 t | 8 b | 9 u | 10 (10 rows) create or replace function test_mtup1() returns setof mtup as 'as.matrix(array(1:15,c(5,3)))' language 'plr'; select * from test_mtup1(); f1 | f2 | f3 ----+----+---- 1 | 6 | 11 2 | 7 | 12 3 | 8 | 13 4 | 9 | 14 5 | 10 | 15 (5 rows) create or replace function test_vtup1() returns setof vtup as 'as.vector(array(1:15,c(5,3)))' language 'plr'; select * from test_vtup1(); f1 ---- 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 (15 rows) -- -- test pg R support functions (e.g. SPI_exec) -- create or replace function pg_quote_ident(text) returns text as 'pg.quoteident(arg1)' language 'plr'; select pg_quote_ident('Hello World'); pg_quote_ident ---------------- "Hello World" (1 row) create or replace function pg_quote_literal(text) returns text as 'pg.quoteliteral(arg1)' language 'plr'; select pg_quote_literal('Hello''World'); pg_quote_literal ------------------ 'Hello''World' (1 row) create or replace function test_spi_t(text) returns text as '(pg.spi.exec(arg1))[[1]]' language 'plr'; select test_spi_t('select oid, typname from pg_type where typname = ''oid'' or typname = ''text'''); test_spi_t ------------ 25 (1 row) create or replace function test_spi_ta(text) returns text[] as 'pg.spi.exec(arg1)' language 'plr'; select test_spi_ta('select oid, typname from pg_type where typname = ''oid'' or typname = ''text'''); test_spi_ta ---------------------- {{25,text},{26,oid}} (1 row) create or replace function test_spi_tup(text) returns setof record as 'pg.spi.exec(arg1)' language 'plr'; select * from test_spi_tup('select oid, typname from pg_type where typname = ''oid'' or typname = ''text''') as t(typeid oid, typename name); typeid | typename --------+---------- 25 | text 26 | oid (2 rows) create or replace function fetch_pgoid(text) returns int as 'pg.reval(arg1)' language 'plr'; select fetch_pgoid('BYTEAOID'); fetch_pgoid ------------- 17 (1 row) create or replace function test_spi_prep(text) returns text as 'sp <<- pg.spi.prepare(arg1, c(NAMEOID, NAMEOID)); print("OK")' language 'plr'; select test_spi_prep('select oid, typname from pg_type where typname = $1 or typname = $2'); test_spi_prep --------------- OK (1 row) create or replace function test_spi_execp(text, text, text) returns setof record as 'pg.spi.execp(pg.reval(arg1), list(arg2,arg3))' language 'plr'; select * from test_spi_execp('sp','oid','text') as t(typeid oid, typename name); typeid | typename --------+---------- 25 | text 26 | oid (2 rows) create or replace function test_spi_lastoid(text) returns text as $$ version_12plus <- pg.spi.exec("select current_setting('server_version_num')::integer < 120000") pg.spi.exec(arg1) ifelse(version_12plus, pg.spi.lastoid()/pg.spi.lastoid(), 1) $$ language 'plr'; select test_spi_lastoid('insert into foo values(10,''cat3'',3.333)') as "ONE"; ONE ----- 1 (1 row) -- -- test NULL handling -- CREATE OR REPLACE FUNCTION r_test (float8) RETURNS float8 AS 'arg1' LANGUAGE 'plr'; select r_test(null) is null as "NULL"; NULL ------ t (1 row) CREATE OR REPLACE FUNCTION r_max (integer, integer) RETURNS integer AS 'if (is.null(arg1) && is.null(arg2)) return(NA);if (is.null(arg1)) return(arg2);if (is.null(arg2)) return(arg1);if (arg1 > arg2) return(arg1);arg2' LANGUAGE 'plr'; select r_max(1,2) as "TWO"; TWO ----- 2 (1 row) select r_max(null,2) as "TWO"; TWO ----- 2 (1 row) select r_max(1,null) as "ONE"; ONE ----- 1 (1 row) select r_max(null,null) is null as "NULL"; NULL ------ t (1 row) -- -- test tuple arguments -- create or replace function get_foo(int) returns foo as 'select * from foo where f0 = $1' language 'sql'; create or replace function test_foo(foo) returns foo as 'return(arg1)' language 'plr'; select * from test_foo(get_foo(1)); f0 | f1 | f2 ----+------+------ 1 | cat1 | 1.21 (1 row) -- -- test 2D array argument -- create or replace function test_in_m_tup(_int4) returns setof record as 'arg1' language 'plr'; select * from test_in_m_tup('{{1,3,5},{2,4,6}}') as t(f1 int, f2 int, f3 int); f1 | f2 | f3 ----+----+---- 1 | 3 | 5 2 | 4 | 6 (2 rows) -- -- test 3D array argument -- create or replace function arr3d(_int4,int4,int4,int4) returns int4 as ' if (arg2 < 1 || arg3 < 1 || arg4 < 1) return(NA) if (arg2 > dim(arg1)[1] || arg3 > dim(arg1)[2] || arg4 > dim(arg1)[3]) return(NA) return(arg1[arg2,arg3,arg4]) ' language 'plr' STRICT; select arr3d('{{{111,112},{121,122},{131,132}},{{211,212},{221,222},{231,232}}}',2,3,1) as "231"; 231 ----- 231 (1 row) -- for sake of comparison, see what normal pgsql array operations produces select f1[2][3][1] as "231" from (select '{{{111,112},{121,122},{131,132}},{{211,212},{221,222},{231,232}}}'::int4[] as f1) as t; 231 ----- 231 (1 row) -- out-of-bounds, returns null select arr3d('{{{111,112},{121,122},{131,132}},{{211,212},{221,222},{231,232}}}',1,4,1) is null as "NULL"; NULL ------ t (1 row) select f1[1][4][1] is null as "NULL" from (select '{{{111,112},{121,122},{131,132}},{{211,212},{221,222},{231,232}}}'::int4[] as f1) as t; NULL ------ t (1 row) select arr3d('{{{111,112},{121,122},{131,132}},{{211,212},{221,222},{231,232}}}',0,1,1) is null as "NULL"; NULL ------ t (1 row) select f1[0][1][1] is null as "NULL" from (select '{{{111,112},{121,122},{131,132}},{{211,212},{221,222},{231,232}}}'::int4[] as f1) as t; NULL ------ t (1 row) -- -- test 3D array return value -- create or replace function arr3d(_int4) returns int4[] as 'return(arg1)' language 'plr' STRICT; select arr3d('{{{111,112},{121,122},{131,132}},{{211,212},{221,222},{231,232}}}'); arr3d ------------------------------------------------------------------- {{{111,112},{121,122},{131,132}},{{211,212},{221,222},{231,232}}} (1 row) -- -- Trigger support tests -- -- -- test that NULL return value suppresses the change -- create or replace function rejectfoo() returns trigger as 'return(NULL)' language plr; create trigger footrig before insert or update or delete on foo for each row execute procedure rejectfoo(); select count(*) from foo; count ------- 10 (1 row) insert into foo values(11,'cat99',1.89); select count(*) from foo; count ------- 10 (1 row) update foo set f1 = 'zzz'; select count(*) from foo; count ------- 10 (1 row) delete from foo; select count(*) from foo; count ------- 10 (1 row) drop trigger footrig on foo; -- -- test that returning OLD/NEW as appropriate allow the change unmodified -- create or replace function acceptfoo() returns trigger as ' switch (pg.tg.op, INSERT = return(pg.tg.new), UPDATE = return(pg.tg.new), DELETE = return(pg.tg.old)) ' language plr; create trigger footrig before insert or update or delete on foo for each row execute procedure acceptfoo(); select count(*) from foo; count ------- 10 (1 row) insert into foo values(11,'cat99',1.89); select count(*) from foo; count ------- 11 (1 row) update foo set f1 = 'zzz' where f0 = 11; select * from foo where f0 = 11; f0 | f1 | f2 ----+-----+------ 11 | zzz | 1.89 (1 row) delete from foo where f0 = 11; select count(*) from foo; count ------- 10 (1 row) drop trigger footrig on foo; -- -- test that returning modifed tuple successfully modifies the result -- create or replace function modfoo() returns trigger as ' if (pg.tg.op == "INSERT") { retval <- pg.tg.new retval$f1 <- "xxx" } if (pg.tg.op == "UPDATE") { retval <- pg.tg.new retval$f1 <- "aaa" } if (pg.tg.op == "DELETE") retval <- pg.tg.old return(retval) ' language plr; create trigger footrig before insert or update or delete on foo for each row execute procedure modfoo(); select count(*) from foo; count ------- 10 (1 row) insert into foo values(11,'cat99',1.89); select * from foo where f0 = 11; f0 | f1 | f2 ----+-----+------ 11 | xxx | 1.89 (1 row) update foo set f1 = 'zzz' where f0 = 11; select * from foo where f0 = 11; f0 | f1 | f2 ----+-----+------ 11 | aaa | 1.89 (1 row) delete from foo where f0 = 11; select count(*) from foo; count ------- 10 (1 row) drop trigger footrig on foo; -- -- test statement level triggers and verify all arguments come -- across correctly -- create or replace function foonotice() returns trigger as ' msg <- paste(pg.tg.name,pg.tg.relname,pg.tg.when,pg.tg.level,pg.tg.op,pg.tg.args[1],pg.tg.args[2]) pg.thrownotice(msg) ' language plr; create trigger footrig after insert or update or delete on foo for each row execute procedure foonotice(); select count(*) from foo; count ------- 10 (1 row) insert into foo values(11,'cat99',1.89); NOTICE: footrig foo AFTER ROW INSERT NA NA select count(*) from foo; count ------- 11 (1 row) update foo set f1 = 'zzz' where f0 = 11; NOTICE: footrig foo AFTER ROW UPDATE NA NA select * from foo where f0 = 11; f0 | f1 | f2 ----+-----+------ 11 | zzz | 1.89 (1 row) delete from foo where f0 = 11; NOTICE: footrig foo AFTER ROW DELETE NA NA select count(*) from foo; count ------- 10 (1 row) drop trigger footrig on foo; create trigger footrig after insert or update or delete on foo for each statement execute procedure foonotice('hello','world'); select count(*) from foo; count ------- 10 (1 row) insert into foo values(11,'cat99',1.89); NOTICE: footrig foo AFTER STATEMENT INSERT hello world select count(*) from foo; count ------- 11 (1 row) update foo set f1 = 'zzz' where f0 = 11; NOTICE: footrig foo AFTER STATEMENT UPDATE hello world select * from foo where f0 = 11; f0 | f1 | f2 ----+-----+------ 11 | zzz | 1.89 (1 row) delete from foo where f0 = 11; NOTICE: footrig foo AFTER STATEMENT DELETE hello world select count(*) from foo; count ------- 10 (1 row) drop trigger footrig on foo; -- Test cursors: creating, scrolling forward, closing CREATE OR REPLACE FUNCTION cursor_fetch_test(integer,boolean) RETURNS SETOF integer AS 'plan<-pg.spi.prepare("SELECT * FROM generate_series(1,10)"); cursor<-pg.spi.cursor_open("curs",plan); dat<-pg.spi.cursor_fetch(cursor,arg2,arg1); pg.spi.cursor_close(cursor); return (dat);' language 'plr'; SELECT * FROM cursor_fetch_test(1,true); cursor_fetch_test ------------------- 1 (1 row) SELECT * FROM cursor_fetch_test(2,true); cursor_fetch_test ------------------- 1 2 (2 rows) SELECT * FROM cursor_fetch_test(20,true); cursor_fetch_test ------------------- 1 2 3 4 5 6 7 8 9 10 (10 rows) --Test cursors: scrolling backwards CREATE OR REPLACE FUNCTION cursor_direction_test() RETURNS SETOF integer AS'plan<-pg.spi.prepare("SELECT * FROM generate_series(1,10)"); cursor<-pg.spi.cursor_open("curs",plan); dat<-pg.spi.cursor_fetch(cursor,TRUE,as.integer(3)); dat2<-pg.spi.cursor_fetch(cursor,FALSE,as.integer(3)); pg.spi.cursor_close(cursor); return (dat2);' language 'plr'; SELECT * FROM cursor_direction_test(); cursor_direction_test ----------------------- 2 1 (2 rows) --Test cursors: Passing arguments to a plan CREATE OR REPLACE FUNCTION cursor_fetch_test_arg(integer) RETURNS SETOF integer AS 'plan<-pg.spi.prepare("SELECT * FROM generate_series(1,$1)",c(INT4OID)); cursor<-pg.spi.cursor_open("curs",plan,list(arg1)); dat<-pg.spi.cursor_fetch(cursor,TRUE,arg1); pg.spi.cursor_close(cursor); return (dat);' language 'plr'; SELECT * FROM cursor_fetch_test_arg(3); cursor_fetch_test_arg ----------------------- 1 2 3 (3 rows) --Test bytea arguments and return values: serialize/unserialize create or replace function test_serialize(text) returns bytea as ' mydf <- pg.spi.exec(arg1) return (mydf) ' language 'plr'; create or replace function restore_df(bytea) returns setof record as ' return (arg1) ' language 'plr'; select * from restore_df((select test_serialize('select oid, typname from pg_type where typname in (''oid'',''name'',''int4'')'))) as t(oid oid, typname name) order by oid; oid | typname -----+--------- 19 | name 23 | int4 26 | oid (3 rows) --Test WINDOW functions -- create test table CREATE TABLE test_data ( fyear integer, firm float8, eps float8 ); -- insert data for test INSERT INTO test_data SELECT (b.f + 1) % 10 + 2000 AS fyear, floor((b.f+1)/10) + 50 AS firm, f::float8/100 AS eps FROM generate_series(-200,199,1) b(f); CREATE OR REPLACE FUNCTION r_regr_slope(float8, float8) RETURNS float8 AS $BODY$ slope <- NA y <- farg1 x <- farg2 if (fnumrows==9) try (slope <- lm(y ~ x)$coefficients[2]) return(slope) $BODY$ LANGUAGE plr WINDOW; SELECT *, round((r_regr_slope(eps, lag_eps) OVER w)::numeric,6) AS slope_R FROM (SELECT firm, fyear, eps, lag(eps) OVER (ORDER BY firm, fyear) AS lag_eps FROM test_data) AS a WHERE eps IS NOT NULL WINDOW w AS (ORDER BY firm, fyear ROWS 8 PRECEDING); firm | fyear | eps | lag_eps | slope_r ------+-------+-------+---------+---------- 31 | 1991 | -2 | | 31 | 1992 | -1.99 | -2 | 31 | 1993 | -1.98 | -1.99 | 31 | 1994 | -1.97 | -1.98 | 31 | 1995 | -1.96 | -1.97 | 31 | 1996 | -1.95 | -1.96 | 31 | 1997 | -1.94 | -1.95 | 31 | 1998 | -1.93 | -1.94 | 31 | 1999 | -1.92 | -1.93 | 1.000000 31 | 2000 | -1.91 | -1.92 | 1.000000 32 | 1991 | -1.9 | -1.91 | 1.000000 32 | 1992 | -1.89 | -1.9 | 1.000000 32 | 1993 | -1.88 | -1.89 | 1.000000 32 | 1994 | -1.87 | -1.88 | 1.000000 32 | 1995 | -1.86 | -1.87 | 1.000000 32 | 1996 | -1.85 | -1.86 | 1.000000 32 | 1997 | -1.84 | -1.85 | 1.000000 32 | 1998 | -1.83 | -1.84 | 1.000000 32 | 1999 | -1.82 | -1.83 | 1.000000 32 | 2000 | -1.81 | -1.82 | 1.000000 33 | 1991 | -1.8 | -1.81 | 1.000000 33 | 1992 | -1.79 | -1.8 | 1.000000 33 | 1993 | -1.78 | -1.79 | 1.000000 33 | 1994 | -1.77 | -1.78 | 1.000000 33 | 1995 | -1.76 | -1.77 | 1.000000 33 | 1996 | -1.75 | -1.76 | 1.000000 33 | 1997 | -1.74 | -1.75 | 1.000000 33 | 1998 | -1.73 | -1.74 | 1.000000 33 | 1999 | -1.72 | -1.73 | 1.000000 33 | 2000 | -1.71 | -1.72 | 1.000000 34 | 1991 | -1.7 | -1.71 | 1.000000 34 | 1992 | -1.69 | -1.7 | 1.000000 34 | 1993 | -1.68 | -1.69 | 1.000000 34 | 1994 | -1.67 | -1.68 | 1.000000 34 | 1995 | -1.66 | -1.67 | 1.000000 34 | 1996 | -1.65 | -1.66 | 1.000000 34 | 1997 | -1.64 | -1.65 | 1.000000 34 | 1998 | -1.63 | -1.64 | 1.000000 34 | 1999 | -1.62 | -1.63 | 1.000000 34 | 2000 | -1.61 | -1.62 | 1.000000 35 | 1991 | -1.6 | -1.61 | 1.000000 35 | 1992 | -1.59 | -1.6 | 1.000000 35 | 1993 | -1.58 | -1.59 | 1.000000 35 | 1994 | -1.57 | -1.58 | 1.000000 35 | 1995 | -1.56 | -1.57 | 1.000000 35 | 1996 | -1.55 | -1.56 | 1.000000 35 | 1997 | -1.54 | -1.55 | 1.000000 35 | 1998 | -1.53 | -1.54 | 1.000000 35 | 1999 | -1.52 | -1.53 | 1.000000 35 | 2000 | -1.51 | -1.52 | 1.000000 36 | 1991 | -1.5 | -1.51 | 1.000000 36 | 1992 | -1.49 | -1.5 | 1.000000 36 | 1993 | -1.48 | -1.49 | 1.000000 36 | 1994 | -1.47 | -1.48 | 1.000000 36 | 1995 | -1.46 | -1.47 | 1.000000 36 | 1996 | -1.45 | -1.46 | 1.000000 36 | 1997 | -1.44 | -1.45 | 1.000000 36 | 1998 | -1.43 | -1.44 | 1.000000 36 | 1999 | -1.42 | -1.43 | 1.000000 36 | 2000 | -1.41 | -1.42 | 1.000000 37 | 1991 | -1.4 | -1.41 | 1.000000 37 | 1992 | -1.39 | -1.4 | 1.000000 37 | 1993 | -1.38 | -1.39 | 1.000000 37 | 1994 | -1.37 | -1.38 | 1.000000 37 | 1995 | -1.36 | -1.37 | 1.000000 37 | 1996 | -1.35 | -1.36 | 1.000000 37 | 1997 | -1.34 | -1.35 | 1.000000 37 | 1998 | -1.33 | -1.34 | 1.000000 37 | 1999 | -1.32 | -1.33 | 1.000000 37 | 2000 | -1.31 | -1.32 | 1.000000 38 | 1991 | -1.3 | -1.31 | 1.000000 38 | 1992 | -1.29 | -1.3 | 1.000000 38 | 1993 | -1.28 | -1.29 | 1.000000 38 | 1994 | -1.27 | -1.28 | 1.000000 38 | 1995 | -1.26 | -1.27 | 1.000000 38 | 1996 | -1.25 | -1.26 | 1.000000 38 | 1997 | -1.24 | -1.25 | 1.000000 38 | 1998 | -1.23 | -1.24 | 1.000000 38 | 1999 | -1.22 | -1.23 | 1.000000 38 | 2000 | -1.21 | -1.22 | 1.000000 39 | 1991 | -1.2 | -1.21 | 1.000000 39 | 1992 | -1.19 | -1.2 | 1.000000 39 | 1993 | -1.18 | -1.19 | 1.000000 39 | 1994 | -1.17 | -1.18 | 1.000000 39 | 1995 | -1.16 | -1.17 | 1.000000 39 | 1996 | -1.15 | -1.16 | 1.000000 39 | 1997 | -1.14 | -1.15 | 1.000000 39 | 1998 | -1.13 | -1.14 | 1.000000 39 | 1999 | -1.12 | -1.13 | 1.000000 39 | 2000 | -1.11 | -1.12 | 1.000000 40 | 1991 | -1.1 | -1.11 | 1.000000 40 | 1992 | -1.09 | -1.1 | 1.000000 40 | 1993 | -1.08 | -1.09 | 1.000000 40 | 1994 | -1.07 | -1.08 | 1.000000 40 | 1995 | -1.06 | -1.07 | 1.000000 40 | 1996 | -1.05 | -1.06 | 1.000000 40 | 1997 | -1.04 | -1.05 | 1.000000 40 | 1998 | -1.03 | -1.04 | 1.000000 40 | 1999 | -1.02 | -1.03 | 1.000000 40 | 2000 | -1.01 | -1.02 | 1.000000 41 | 1991 | -1 | -1.01 | 1.000000 41 | 1992 | -0.99 | -1 | 1.000000 41 | 1993 | -0.98 | -0.99 | 1.000000 41 | 1994 | -0.97 | -0.98 | 1.000000 41 | 1995 | -0.96 | -0.97 | 1.000000 41 | 1996 | -0.95 | -0.96 | 1.000000 41 | 1997 | -0.94 | -0.95 | 1.000000 41 | 1998 | -0.93 | -0.94 | 1.000000 41 | 1999 | -0.92 | -0.93 | 1.000000 41 | 2000 | -0.91 | -0.92 | 1.000000 42 | 1991 | -0.9 | -0.91 | 1.000000 42 | 1992 | -0.89 | -0.9 | 1.000000 42 | 1993 | -0.88 | -0.89 | 1.000000 42 | 1994 | -0.87 | -0.88 | 1.000000 42 | 1995 | -0.86 | -0.87 | 1.000000 42 | 1996 | -0.85 | -0.86 | 1.000000 42 | 1997 | -0.84 | -0.85 | 1.000000 42 | 1998 | -0.83 | -0.84 | 1.000000 42 | 1999 | -0.82 | -0.83 | 1.000000 42 | 2000 | -0.81 | -0.82 | 1.000000 43 | 1991 | -0.8 | -0.81 | 1.000000 43 | 1992 | -0.79 | -0.8 | 1.000000 43 | 1993 | -0.78 | -0.79 | 1.000000 43 | 1994 | -0.77 | -0.78 | 1.000000 43 | 1995 | -0.76 | -0.77 | 1.000000 43 | 1996 | -0.75 | -0.76 | 1.000000 43 | 1997 | -0.74 | -0.75 | 1.000000 43 | 1998 | -0.73 | -0.74 | 1.000000 43 | 1999 | -0.72 | -0.73 | 1.000000 43 | 2000 | -0.71 | -0.72 | 1.000000 44 | 1991 | -0.7 | -0.71 | 1.000000 44 | 1992 | -0.69 | -0.7 | 1.000000 44 | 1993 | -0.68 | -0.69 | 1.000000 44 | 1994 | -0.67 | -0.68 | 1.000000 44 | 1995 | -0.66 | -0.67 | 1.000000 44 | 1996 | -0.65 | -0.66 | 1.000000 44 | 1997 | -0.64 | -0.65 | 1.000000 44 | 1998 | -0.63 | -0.64 | 1.000000 44 | 1999 | -0.62 | -0.63 | 1.000000 44 | 2000 | -0.61 | -0.62 | 1.000000 45 | 1991 | -0.6 | -0.61 | 1.000000 45 | 1992 | -0.59 | -0.6 | 1.000000 45 | 1993 | -0.58 | -0.59 | 1.000000 45 | 1994 | -0.57 | -0.58 | 1.000000 45 | 1995 | -0.56 | -0.57 | 1.000000 45 | 1996 | -0.55 | -0.56 | 1.000000 45 | 1997 | -0.54 | -0.55 | 1.000000 45 | 1998 | -0.53 | -0.54 | 1.000000 45 | 1999 | -0.52 | -0.53 | 1.000000 45 | 2000 | -0.51 | -0.52 | 1.000000 46 | 1991 | -0.5 | -0.51 | 1.000000 46 | 1992 | -0.49 | -0.5 | 1.000000 46 | 1993 | -0.48 | -0.49 | 1.000000 46 | 1994 | -0.47 | -0.48 | 1.000000 46 | 1995 | -0.46 | -0.47 | 1.000000 46 | 1996 | -0.45 | -0.46 | 1.000000 46 | 1997 | -0.44 | -0.45 | 1.000000 46 | 1998 | -0.43 | -0.44 | 1.000000 46 | 1999 | -0.42 | -0.43 | 1.000000 46 | 2000 | -0.41 | -0.42 | 1.000000 47 | 1991 | -0.4 | -0.41 | 1.000000 47 | 1992 | -0.39 | -0.4 | 1.000000 47 | 1993 | -0.38 | -0.39 | 1.000000 47 | 1994 | -0.37 | -0.38 | 1.000000 47 | 1995 | -0.36 | -0.37 | 1.000000 47 | 1996 | -0.35 | -0.36 | 1.000000 47 | 1997 | -0.34 | -0.35 | 1.000000 47 | 1998 | -0.33 | -0.34 | 1.000000 47 | 1999 | -0.32 | -0.33 | 1.000000 47 | 2000 | -0.31 | -0.32 | 1.000000 48 | 1991 | -0.3 | -0.31 | 1.000000 48 | 1992 | -0.29 | -0.3 | 1.000000 48 | 1993 | -0.28 | -0.29 | 1.000000 48 | 1994 | -0.27 | -0.28 | 1.000000 48 | 1995 | -0.26 | -0.27 | 1.000000 48 | 1996 | -0.25 | -0.26 | 1.000000 48 | 1997 | -0.24 | -0.25 | 1.000000 48 | 1998 | -0.23 | -0.24 | 1.000000 48 | 1999 | -0.22 | -0.23 | 1.000000 48 | 2000 | -0.21 | -0.22 | 1.000000 49 | 1991 | -0.2 | -0.21 | 1.000000 49 | 1992 | -0.19 | -0.2 | 1.000000 49 | 1993 | -0.18 | -0.19 | 1.000000 49 | 1994 | -0.17 | -0.18 | 1.000000 49 | 1995 | -0.16 | -0.17 | 1.000000 49 | 1996 | -0.15 | -0.16 | 1.000000 49 | 1997 | -0.14 | -0.15 | 1.000000 49 | 1998 | -0.13 | -0.14 | 1.000000 49 | 1999 | -0.12 | -0.13 | 1.000000 49 | 2000 | -0.11 | -0.12 | 1.000000 50 | 1991 | -0.1 | -0.11 | 1.000000 50 | 1992 | -0.09 | -0.1 | 1.000000 50 | 1993 | -0.08 | -0.09 | 1.000000 50 | 1994 | -0.07 | -0.08 | 1.000000 50 | 1995 | -0.06 | -0.07 | 1.000000 50 | 1996 | -0.05 | -0.06 | 1.000000 50 | 1997 | -0.04 | -0.05 | 1.000000 50 | 1998 | -0.03 | -0.04 | 1.000000 50 | 1999 | -0.02 | -0.03 | 1.000000 50 | 2000 | -0.01 | -0.02 | 1.000000 50 | 2001 | 0 | -0.01 | 1.000000 50 | 2002 | 0.01 | 0 | 1.000000 50 | 2003 | 0.02 | 0.01 | 1.000000 50 | 2004 | 0.03 | 0.02 | 1.000000 50 | 2005 | 0.04 | 0.03 | 1.000000 50 | 2006 | 0.05 | 0.04 | 1.000000 50 | 2007 | 0.06 | 0.05 | 1.000000 50 | 2008 | 0.07 | 0.06 | 1.000000 50 | 2009 | 0.08 | 0.07 | 1.000000 51 | 2000 | 0.09 | 0.08 | 1.000000 51 | 2001 | 0.1 | 0.09 | 1.000000 51 | 2002 | 0.11 | 0.1 | 1.000000 51 | 2003 | 0.12 | 0.11 | 1.000000 51 | 2004 | 0.13 | 0.12 | 1.000000 51 | 2005 | 0.14 | 0.13 | 1.000000 51 | 2006 | 0.15 | 0.14 | 1.000000 51 | 2007 | 0.16 | 0.15 | 1.000000 51 | 2008 | 0.17 | 0.16 | 1.000000 51 | 2009 | 0.18 | 0.17 | 1.000000 52 | 2000 | 0.19 | 0.18 | 1.000000 52 | 2001 | 0.2 | 0.19 | 1.000000 52 | 2002 | 0.21 | 0.2 | 1.000000 52 | 2003 | 0.22 | 0.21 | 1.000000 52 | 2004 | 0.23 | 0.22 | 1.000000 52 | 2005 | 0.24 | 0.23 | 1.000000 52 | 2006 | 0.25 | 0.24 | 1.000000 52 | 2007 | 0.26 | 0.25 | 1.000000 52 | 2008 | 0.27 | 0.26 | 1.000000 52 | 2009 | 0.28 | 0.27 | 1.000000 53 | 2000 | 0.29 | 0.28 | 1.000000 53 | 2001 | 0.3 | 0.29 | 1.000000 53 | 2002 | 0.31 | 0.3 | 1.000000 53 | 2003 | 0.32 | 0.31 | 1.000000 53 | 2004 | 0.33 | 0.32 | 1.000000 53 | 2005 | 0.34 | 0.33 | 1.000000 53 | 2006 | 0.35 | 0.34 | 1.000000 53 | 2007 | 0.36 | 0.35 | 1.000000 53 | 2008 | 0.37 | 0.36 | 1.000000 53 | 2009 | 0.38 | 0.37 | 1.000000 54 | 2000 | 0.39 | 0.38 | 1.000000 54 | 2001 | 0.4 | 0.39 | 1.000000 54 | 2002 | 0.41 | 0.4 | 1.000000 54 | 2003 | 0.42 | 0.41 | 1.000000 54 | 2004 | 0.43 | 0.42 | 1.000000 54 | 2005 | 0.44 | 0.43 | 1.000000 54 | 2006 | 0.45 | 0.44 | 1.000000 54 | 2007 | 0.46 | 0.45 | 1.000000 54 | 2008 | 0.47 | 0.46 | 1.000000 54 | 2009 | 0.48 | 0.47 | 1.000000 55 | 2000 | 0.49 | 0.48 | 1.000000 55 | 2001 | 0.5 | 0.49 | 1.000000 55 | 2002 | 0.51 | 0.5 | 1.000000 55 | 2003 | 0.52 | 0.51 | 1.000000 55 | 2004 | 0.53 | 0.52 | 1.000000 55 | 2005 | 0.54 | 0.53 | 1.000000 55 | 2006 | 0.55 | 0.54 | 1.000000 55 | 2007 | 0.56 | 0.55 | 1.000000 55 | 2008 | 0.57 | 0.56 | 1.000000 55 | 2009 | 0.58 | 0.57 | 1.000000 56 | 2000 | 0.59 | 0.58 | 1.000000 56 | 2001 | 0.6 | 0.59 | 1.000000 56 | 2002 | 0.61 | 0.6 | 1.000000 56 | 2003 | 0.62 | 0.61 | 1.000000 56 | 2004 | 0.63 | 0.62 | 1.000000 56 | 2005 | 0.64 | 0.63 | 1.000000 56 | 2006 | 0.65 | 0.64 | 1.000000 56 | 2007 | 0.66 | 0.65 | 1.000000 56 | 2008 | 0.67 | 0.66 | 1.000000 56 | 2009 | 0.68 | 0.67 | 1.000000 57 | 2000 | 0.69 | 0.68 | 1.000000 57 | 2001 | 0.7 | 0.69 | 1.000000 57 | 2002 | 0.71 | 0.7 | 1.000000 57 | 2003 | 0.72 | 0.71 | 1.000000 57 | 2004 | 0.73 | 0.72 | 1.000000 57 | 2005 | 0.74 | 0.73 | 1.000000 57 | 2006 | 0.75 | 0.74 | 1.000000 57 | 2007 | 0.76 | 0.75 | 1.000000 57 | 2008 | 0.77 | 0.76 | 1.000000 57 | 2009 | 0.78 | 0.77 | 1.000000 58 | 2000 | 0.79 | 0.78 | 1.000000 58 | 2001 | 0.8 | 0.79 | 1.000000 58 | 2002 | 0.81 | 0.8 | 1.000000 58 | 2003 | 0.82 | 0.81 | 1.000000 58 | 2004 | 0.83 | 0.82 | 1.000000 58 | 2005 | 0.84 | 0.83 | 1.000000 58 | 2006 | 0.85 | 0.84 | 1.000000 58 | 2007 | 0.86 | 0.85 | 1.000000 58 | 2008 | 0.87 | 0.86 | 1.000000 58 | 2009 | 0.88 | 0.87 | 1.000000 59 | 2000 | 0.89 | 0.88 | 1.000000 59 | 2001 | 0.9 | 0.89 | 1.000000 59 | 2002 | 0.91 | 0.9 | 1.000000 59 | 2003 | 0.92 | 0.91 | 1.000000 59 | 2004 | 0.93 | 0.92 | 1.000000 59 | 2005 | 0.94 | 0.93 | 1.000000 59 | 2006 | 0.95 | 0.94 | 1.000000 59 | 2007 | 0.96 | 0.95 | 1.000000 59 | 2008 | 0.97 | 0.96 | 1.000000 59 | 2009 | 0.98 | 0.97 | 1.000000 60 | 2000 | 0.99 | 0.98 | 1.000000 60 | 2001 | 1 | 0.99 | 1.000000 60 | 2002 | 1.01 | 1 | 1.000000 60 | 2003 | 1.02 | 1.01 | 1.000000 60 | 2004 | 1.03 | 1.02 | 1.000000 60 | 2005 | 1.04 | 1.03 | 1.000000 60 | 2006 | 1.05 | 1.04 | 1.000000 60 | 2007 | 1.06 | 1.05 | 1.000000 60 | 2008 | 1.07 | 1.06 | 1.000000 60 | 2009 | 1.08 | 1.07 | 1.000000 61 | 2000 | 1.09 | 1.08 | 1.000000 61 | 2001 | 1.1 | 1.09 | 1.000000 61 | 2002 | 1.11 | 1.1 | 1.000000 61 | 2003 | 1.12 | 1.11 | 1.000000 61 | 2004 | 1.13 | 1.12 | 1.000000 61 | 2005 | 1.14 | 1.13 | 1.000000 61 | 2006 | 1.15 | 1.14 | 1.000000 61 | 2007 | 1.16 | 1.15 | 1.000000 61 | 2008 | 1.17 | 1.16 | 1.000000 61 | 2009 | 1.18 | 1.17 | 1.000000 62 | 2000 | 1.19 | 1.18 | 1.000000 62 | 2001 | 1.2 | 1.19 | 1.000000 62 | 2002 | 1.21 | 1.2 | 1.000000 62 | 2003 | 1.22 | 1.21 | 1.000000 62 | 2004 | 1.23 | 1.22 | 1.000000 62 | 2005 | 1.24 | 1.23 | 1.000000 62 | 2006 | 1.25 | 1.24 | 1.000000 62 | 2007 | 1.26 | 1.25 | 1.000000 62 | 2008 | 1.27 | 1.26 | 1.000000 62 | 2009 | 1.28 | 1.27 | 1.000000 63 | 2000 | 1.29 | 1.28 | 1.000000 63 | 2001 | 1.3 | 1.29 | 1.000000 63 | 2002 | 1.31 | 1.3 | 1.000000 63 | 2003 | 1.32 | 1.31 | 1.000000 63 | 2004 | 1.33 | 1.32 | 1.000000 63 | 2005 | 1.34 | 1.33 | 1.000000 63 | 2006 | 1.35 | 1.34 | 1.000000 63 | 2007 | 1.36 | 1.35 | 1.000000 63 | 2008 | 1.37 | 1.36 | 1.000000 63 | 2009 | 1.38 | 1.37 | 1.000000 64 | 2000 | 1.39 | 1.38 | 1.000000 64 | 2001 | 1.4 | 1.39 | 1.000000 64 | 2002 | 1.41 | 1.4 | 1.000000 64 | 2003 | 1.42 | 1.41 | 1.000000 64 | 2004 | 1.43 | 1.42 | 1.000000 64 | 2005 | 1.44 | 1.43 | 1.000000 64 | 2006 | 1.45 | 1.44 | 1.000000 64 | 2007 | 1.46 | 1.45 | 1.000000 64 | 2008 | 1.47 | 1.46 | 1.000000 64 | 2009 | 1.48 | 1.47 | 1.000000 65 | 2000 | 1.49 | 1.48 | 1.000000 65 | 2001 | 1.5 | 1.49 | 1.000000 65 | 2002 | 1.51 | 1.5 | 1.000000 65 | 2003 | 1.52 | 1.51 | 1.000000 65 | 2004 | 1.53 | 1.52 | 1.000000 65 | 2005 | 1.54 | 1.53 | 1.000000 65 | 2006 | 1.55 | 1.54 | 1.000000 65 | 2007 | 1.56 | 1.55 | 1.000000 65 | 2008 | 1.57 | 1.56 | 1.000000 65 | 2009 | 1.58 | 1.57 | 1.000000 66 | 2000 | 1.59 | 1.58 | 1.000000 66 | 2001 | 1.6 | 1.59 | 1.000000 66 | 2002 | 1.61 | 1.6 | 1.000000 66 | 2003 | 1.62 | 1.61 | 1.000000 66 | 2004 | 1.63 | 1.62 | 1.000000 66 | 2005 | 1.64 | 1.63 | 1.000000 66 | 2006 | 1.65 | 1.64 | 1.000000 66 | 2007 | 1.66 | 1.65 | 1.000000 66 | 2008 | 1.67 | 1.66 | 1.000000 66 | 2009 | 1.68 | 1.67 | 1.000000 67 | 2000 | 1.69 | 1.68 | 1.000000 67 | 2001 | 1.7 | 1.69 | 1.000000 67 | 2002 | 1.71 | 1.7 | 1.000000 67 | 2003 | 1.72 | 1.71 | 1.000000 67 | 2004 | 1.73 | 1.72 | 1.000000 67 | 2005 | 1.74 | 1.73 | 1.000000 67 | 2006 | 1.75 | 1.74 | 1.000000 67 | 2007 | 1.76 | 1.75 | 1.000000 67 | 2008 | 1.77 | 1.76 | 1.000000 67 | 2009 | 1.78 | 1.77 | 1.000000 68 | 2000 | 1.79 | 1.78 | 1.000000 68 | 2001 | 1.8 | 1.79 | 1.000000 68 | 2002 | 1.81 | 1.8 | 1.000000 68 | 2003 | 1.82 | 1.81 | 1.000000 68 | 2004 | 1.83 | 1.82 | 1.000000 68 | 2005 | 1.84 | 1.83 | 1.000000 68 | 2006 | 1.85 | 1.84 | 1.000000 68 | 2007 | 1.86 | 1.85 | 1.000000 68 | 2008 | 1.87 | 1.86 | 1.000000 68 | 2009 | 1.88 | 1.87 | 1.000000 69 | 2000 | 1.89 | 1.88 | 1.000000 69 | 2001 | 1.9 | 1.89 | 1.000000 69 | 2002 | 1.91 | 1.9 | 1.000000 69 | 2003 | 1.92 | 1.91 | 1.000000 69 | 2004 | 1.93 | 1.92 | 1.000000 69 | 2005 | 1.94 | 1.93 | 1.000000 69 | 2006 | 1.95 | 1.94 | 1.000000 69 | 2007 | 1.96 | 1.95 | 1.000000 69 | 2008 | 1.97 | 1.96 | 1.000000 69 | 2009 | 1.98 | 1.97 | 1.000000 70 | 2000 | 1.99 | 1.98 | 1.000000 (400 rows) CREATE OR REPLACE FUNCTION rlargeint8out(n int) RETURNS int8[] AS $$ matrix(2, 1, n) $$ LANGUAGE plr; CREATE OR REPLACE FUNCTION routfloat4(n int) RETURNS float4[] AS $$ vector(mode = "numeric", length = n) $$ LANGUAGE plr; SELECT rlargeint8out(10); rlargeint8out ------------------------- {{2,2,2,2,2,2,2,2,2,2}} (1 row) SELECT routfloat4(10); routfloat4 ----------------------- {0,0,0,0,0,0,0,0,0,0} (1 row) SELECT count(rlargeint8out(15000)); count ------- 1 (1 row) SELECT count(routfloat4(15000)); count ------- 1 (1 row) CREATE table tbl(val integer); CREATE OR REPLACE FUNCTION test_create_procedure() RETURNS void AS $BODY$ version_11plus <- pg.spi.exec("select current_setting('server_version_num')::integer >= 110000;") if(version_11plus[[1]]) { pg.spi.exec(" CREATE OR REPLACE PROCEDURE insert_data(a int, b int) AS $$ pg.spi.exec('INSERT INTO tbl VALUES (1);') pg.spi.exec('INSERT INTO tbl VALUES (2);') $$ LANGUAGE plr; ") pg.spi.exec("CALL insert_data(1, 2);") } else { pg.spi.exec("INSERT INTO tbl VALUES (1);") pg.spi.exec("INSERT INTO tbl VALUES (2);") } $BODY$ LANGUAGE plr; SELECT test_create_procedure(); test_create_procedure ----------------------- (1 row) SELECT * FROM tbl; val ----- 1 2 (2 rows) plr-REL8_4_5/expected/plr_transaction.out000066400000000000000000000024671414122415700206000ustar00rootroot00000000000000CREATE TABLE test1 (a int, b text); CREATE OR REPLACE FUNCTION test_create_procedure_transaction() RETURNS void AS $BODY$ version_11plus <- pg.spi.exec("SELECT current_setting('server_version_num')::integer >= 110000;") if(version_11plus[[1]]) { pg.spi.exec(" CREATE OR REPLACE PROCEDURE transaction_test1() AS $$ for(i in 0:9){ pg.spi.exec(paste('INSERT INTO test1 (a) VALUES (', i, ');')) if (i %% 2 == 0) { pg.spi.commit() } else { pg.spi.rollback() } } $$ LANGUAGE plr; ") } else { pg.spi.exec("INSERT INTO test1 (a) VALUES (0);") pg.spi.exec("INSERT INTO test1 (a) VALUES (2);") pg.spi.exec("INSERT INTO test1 (a) VALUES (4);") pg.spi.exec("INSERT INTO test1 (a) VALUES (6);") pg.spi.exec("INSERT INTO test1 (a) VALUES (8);") } $BODY$ LANGUAGE plr; SELECT test_create_procedure_transaction(); test_create_procedure_transaction ----------------------------------- (1 row) \o out.txt SELECT current_setting('server_version_num')::integer server_version_num; \o \gset \o out.txt SELECT CASE WHEN :server_version_num >= 110000 THEN 'CALL transaction_test1();' ELSE '' END thecall; \o \gset :thecall SELECT * FROM test1; a | b ---+--- 0 | 2 | 4 | 6 | 8 | (5 rows) plr-REL8_4_5/header.def000066400000000000000000000000251414122415700147400ustar00rootroot00000000000000LIBRARY R EXPORTS plr-REL8_4_5/msvc.diff000066400000000000000000000034741414122415700146450ustar00rootroot00000000000000diff --git a/src/tools/msvc/Mkvcbuild.pm b/src/tools/msvc/Mkvcbuild.pm index a184404e21..bedbd93ed2 100644 --- a/src/tools/msvc/Mkvcbuild.pm +++ b/src/tools/msvc/Mkvcbuild.pm @@ -51,7 +51,8 @@ my @contrib_excludes = ( 'pgcrypto', 'sepgsql', 'brin', 'test_extensions', 'test_misc', 'test_pg_dump', - 'snapshot_too_old', 'unsafe_tests'); + 'snapshot_too_old', 'unsafe_tests', + 'plr'); # Set of variables for frontend modules my $frontend_defines = { 'initdb' => 'FRONTEND' }; @@ -479,6 +480,16 @@ sub mkvcbuild my $mf = Project::read_file('contrib/pgcrypto/Makefile'); GenerateContribSqlFiles('pgcrypto', $mf); + my $plr = $solution->AddProject('plr','dll','plr'); + $plr->AddFiles( + 'contrib\plr','plr.c','pg_conversion.c','pg_backend_support.c','pg_userfuncs.c','pg_rsupport.c' + ); + $plr->AddReference($postgres); + $plr->AddLibrary('contrib/plr/R$(PlatformTarget).lib'); + $plr->AddIncludeDir('$(R_HOME)\include'); + my $mfplr = Project::read_file('contrib/plr/Makefile'); + GenerateContribSqlFiles('plr', $mfplr); + foreach my $subdir ('contrib', 'src/test/modules') { opendir($D, $subdir) || croak "Could not opendir on $subdir!\n"; @@ -1035,6 +1046,15 @@ sub GenerateContribSqlFiles } } } + else + { + print "GenerateContribSqlFiles skipping $n\n"; + if ($n eq 'plr') + { + print "mf: $mf\n"; + } + } + return; } diff --git a/src/tools/msvc/vcregress.pl b/src/tools/msvc/vcregress.pl index d9bac6c3a2..25501eeb2d 100644 --- a/src/tools/msvc/vcregress.pl +++ b/src/tools/msvc/vcregress.pl @@ -467,7 +467,7 @@ sub contribcheck { chdir "../../../contrib"; my $mstat = 0; - foreach my $module (glob("*")) + foreach my $module (glob("plr")) { # these configuration-based exclusions must match Install.pm next if ($module eq "uuid-ossp" && !defined($config->{uuid})); plr-REL8_4_5/msvc.diff.R000066400000000000000000000143161414122415700150420ustar00rootroot00000000000000 # derived from msvc.diff (PostgreSQL Release 13.2) ############################################################################################### # This R script dynamically edits Mkvcbuild.pm and vcregress.pl ############################################################################################### # Required: get the environment variable - postgresrcroot # # e.g. set postgresrcroot=C:\projects\postgresql # postgresrcroot <- Sys.getenv("postgresrcroot") postgresrcroot <- normalizePath(postgresrcroot, winslash="/", mustWork = T) MkvcbuildPathFile <- paste0(postgresrcroot, "/src/tools/msvc/Mkvcbuild.pm") Mkvcbuild.pm.Lines <- readLines(MkvcbuildPathFile) insContribExcludesArray <- function(lines) { # lines LineOnlyBeginPos <- which(grepl("@contrib_excludes\\s+=\\s+\\(", x = lines, perl = TRUE)) LineAllHaveRightParensPos <- which(grepl("\\)", x = lines, perl = TRUE)) # after BeginPos, first-found line that has a right paren LineOnlyEndPos <- LineAllHaveRightParensPos[head(which(LineOnlyBeginPos <= LineAllHaveRightParensPos),1)] ModifyLineWorking <- lines[LineOnlyEndPos] # within that line # find the right-most paren LastParenPos <- tail(gregexpr("\\)", text = ModifyLineWorking, perl = TRUE)[[1L]],1L) # insert into that line ModifyLineWorking <- paste0(append(strsplit(ModifyLineWorking, split = "")[[1L]], ", 'plr'", after = LastParenPos - 1L), collapse = "") lines[LineOnlyEndPos] <- ModifyLineWorking writeLines("") writeLines("BEGIN insContribExcludesArray ") writeLines("") writeLines(lines[LineOnlyBeginPos:LineOnlyEndPos]) writeLines("") writeLines("END insContribExcludesArray ") writeLines("") return(lines) } # 1 - add 'plr' to @contrib_excludes array Mkvcbuild.pm.Lines <- insContribExcludesArray(Mkvcbuild.pm.Lines) addProjectCode <- function(lines) { LineOnlyBeginPos <- which(grepl("sub\\s+mkvcbuild", x = lines, perl = TRUE)) LineLastPgCryptoPos <- which(grepl("GenerateContribSqlFiles\\s*\\(\\s*'pgcrypto'", x = lines , perl = TRUE)) # after BeginPos, first-found line LineOnlyPos <- LineLastPgCryptoPos[head(which(LineOnlyBeginPos < LineLastPgCryptoPos),1)] plrProjectText <- "\tmy $plr = $solution->AddProject('plr','dll','plr','contrib/plr'); \t$plr->AddFiles( \t\t'contrib\\plr','plr.c','pg_conversion.c','pg_backend_support.c','pg_userfuncs.c','pg_rsupport.c' \t); \t$plr->AddReference($postgres); \t$plr->AddLibrary('contrib/plr/R$(PlatformTarget).lib'); \t$plr->AddIncludeDir('$(R_HOME)\\include'); \tmy $mfplr = Project::read_file('contrib/plr/Makefile'); \tGenerateContribSqlFiles('plr', $mfplr); " # insert into the file lines <- append(lines, strsplit(plrProjectText, split = "\n")[[1L]], after = LineOnlyPos + 1L) writeLines("") writeLines("BEGIN AddProjectCode") writeLines("") writeLines(lines[LineOnlyPos:(LineOnlyPos + 10L)]) writeLines("") writeLines("END AddProjectCode") writeLines("") return(lines) } # 2 - part of "sub mkvcbuild" - add 'plr' project Mkvcbuild.pm.Lines <- addProjectCode(Mkvcbuild.pm.Lines) addGenerateContribSqlFilesCode <- function(lines) { # lines LineOnlyBeginPos <- which(grepl("sub\\s+GenerateContribSqlFiles", x = lines, perl = TRUE)) # pg 11 and later has "return;" LineAllHaveReturnsPos <- which(grepl("\\breturn\\s*;", x = lines, perl = TRUE)) if(length(LineAllHaveReturnsPos)) { # after BeginPos, first-found line LineOfContribReturnPos <- LineAllHaveReturnsPos[head(which(LineOnlyBeginPos < LineAllHaveReturnsPos),1L)] } else { # earlier than pg 11 # just find the function closing end-left-facing-brace LineAllHaveReturnsPos <- which(grepl("^}$", x = lines, perl = TRUE)) LineOfContribReturnPos <- LineAllHaveReturnsPos[head(which(LineOnlyBeginPos < LineAllHaveReturnsPos),1L)] } plrGenerateContribSqlFilesText <- "\telse \t{ \t\tprint \"GenerateContribSqlFiles skipping $n\\n\"; \t\tif ($n eq 'plr') \t\t{ \t\t\tprint \"mf: $mf\\n\"; \t\t} \t} " # insert into the file to the position "just above", the "return" statement, xor, "function closing function closing end-left-facing-brace" lines <- append(lines, strsplit(plrGenerateContribSqlFilesText, split = "\n")[[1L]], after = LineOfContribReturnPos -1L) writeLines("") writeLines("BEGIN addGenerateContribSqlFilesCode") writeLines("") writeLines(lines[LineOnlyBeginPos:(LineOfContribReturnPos + 7L + 1L + 1L)]) writeLines("") writeLines("END addGenerateContribSqlFilesCode") writeLines("") return(lines) } # 3 - part of "sub GenerateContribSqlFiles" - add - else 'plr' Mkvcbuild.pm.Lines <- addGenerateContribSqlFilesCode(Mkvcbuild.pm.Lines) cat(file = MkvcbuildPathFile, Mkvcbuild.pm.Lines, sep = "\n") vcregressPathFile <- paste0(postgresrcroot, "/src/tools/msvc/vcregress.pl") vcregress.pl.Lines <- readLines(vcregressPathFile) modifySubContribCheck <- function(lines) { # lines LineOnlyBeginPos <- which(grepl("sub\\s+contribcheck", x = lines, perl = TRUE)) LineAllHaveGlobPos <- which(grepl("foreach\\s+my\\s+[$]module\\s+\\(glob\\(", x = lines, perl = TRUE)) # after BeginPos, first-found line LineOfGlobPos <- LineAllHaveGlobPos[head(which(LineOnlyBeginPos < LineAllHaveGlobPos),1L)] ModifyLineWorking <- lines[LineOfGlobPos] # within that line LastAsteriskPos <- tail(gregexpr("[*]", text = ModifyLineWorking, perl = TRUE)[[1L]],1L) ModifyLineWorking <- strsplit(ModifyLineWorking, split = "")[[1L]] # remove that asterisk ModifyLineWorking <- as.list(ModifyLineWorking) ModifyLineWorking[LastAsteriskPos] <- NULL ModifyLineWorking <- unlist(ModifyLineWorking) ModifyLineWorking <- paste0(ModifyLineWorking, collapse = "") # insert into the line at the old-asterisk position ModifyLineWorking <- paste0(append(strsplit(ModifyLineWorking, split = "")[[1L]], "plr", after = LastAsteriskPos - 1L), collapse = "") lines[LineOfGlobPos] <- ModifyLineWorking writeLines("") writeLines("BEGIN modifySubContribCheck ") writeLines("") writeLines(lines[LineOnlyBeginPos:LineOfGlobPos]) writeLines("") writeLines("END modifySubContribCheck ") writeLines("") return(lines) } # 4 - part of sub contribcheck - reduce concern to only 'plr' vcregress.pl.Lines <- modifySubContribCheck(vcregress.pl.Lines) cat(file = vcregressPathFile, vcregress.pl.Lines, sep = "\n") plr-REL8_4_5/pg_backend_support.c000077500000000000000000000253301414122415700170560ustar00rootroot00000000000000/* * PL/R - PostgreSQL support for R as a * procedural language (PL) * * Copyright (c) 2003 by Joseph E. Conway * ALL RIGHTS RESERVED * * Joe Conway * * Based on pltcl by Jan Wieck * and inspired by REmbeddedPostgres by * Duncan Temple Lang * http://www.omegahat.org/RSPostgres/ * * License: GPL version 2 or newer. http://www.gnu.org/copyleft/gpl.html * * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * pg_backend_support.c - Postgres backend support functions */ #include "plr.h" #ifdef PGDLLIMPORT /* Postgres global */ extern PGDLLIMPORT char my_exec_path[]; #else /* Postgres global */ extern DLLIMPORT char my_exec_path[]; #endif /* PGDLLIMPORT */ /* compiled function hash table */ extern HTAB *plr_HashTable; /* caller's memory context */ extern MemoryContext plr_caller_context; /* * static declarations */ static char *get_lib_pathstr(Oid langOid); static char *expand_dynamic_library_name(const char *name); static char *substitute_libpath_macro(const char *name); static char *find_in_dynamic_libpath(const char *basename); static bool file_exists(const char *name); /* * Compute the hashkey for a given function invocation * * The hashkey is returned into the caller-provided storage at *hashkey. */ void compute_function_hashkey(FunctionCallInfo fcinfo, Form_pg_proc procStruct, plr_func_hashkey *hashkey) { int i; /* Make sure any unused bytes of the struct are zero */ MemSet(hashkey, 0, sizeof(plr_func_hashkey)); /* get function OID */ hashkey->funcOid = fcinfo->flinfo->fn_oid; /* if trigger, get relation OID */ if (CALLED_AS_TRIGGER(fcinfo)) { TriggerData *trigdata = (TriggerData *) fcinfo->context; hashkey->trigrelOid = RelationGetRelid(trigdata->tg_relation); } /* get the argument types */ for (i = 0; i < procStruct->pronargs; i++) { Oid argtypeid = PROARGTYPES(i); /* * Check for polymorphic arguments. If found, use the actual * parameter type from the caller's FuncExpr node, if we have one. * * We can support arguments of type ANY the same way as normal * polymorphic arguments. */ if (argtypeid == ANYARRAYOID || argtypeid == ANYELEMENTOID || argtypeid == ANYOID) { argtypeid = get_fn_expr_argtype(fcinfo->flinfo, i); if (!OidIsValid(argtypeid)) ereport(ERROR, (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), errmsg("could not determine actual argument " "type for polymorphic function \"%s\"", NameStr(procStruct->proname)))); } hashkey->argtypes[i] = argtypeid; } } void plr_HashTableInit(void) { HASHCTL ctl; memset(&ctl, 0, sizeof(ctl)); ctl.keysize = sizeof(plr_func_hashkey); ctl.entrysize = sizeof(plr_HashEnt); // specifying the hash function has been deprecated since 12 #if (PG_VERSION_NUM < 120000) ctl.hash = tag_hash; plr_HashTable = hash_create("PLR function cache", FUNCS_PER_USER, &ctl, HASH_ELEM | HASH_FUNCTION); #else plr_HashTable = hash_create("PLR function cache", FUNCS_PER_USER, &ctl, HASH_ELEM | HASH_BLOBS); #endif } plr_function * plr_HashTableLookup(plr_func_hashkey *func_key) { plr_HashEnt *hentry; hentry = (plr_HashEnt*) hash_search(plr_HashTable, (void *) func_key, HASH_FIND, NULL); if (hentry) return hentry->function; else return (plr_function *) NULL; } void plr_HashTableInsert(plr_function *function, plr_func_hashkey *func_key) { plr_HashEnt *hentry; bool found; hentry = (plr_HashEnt*) hash_search(plr_HashTable, (void *) func_key, HASH_ENTER, &found); if (hentry == NULL) ereport(ERROR, (errcode(ERRCODE_OUT_OF_MEMORY), errmsg("out of memory"))); if (found) elog(WARNING, "trying to insert a function that exists"); hentry->function = function; /* prepare back link from function to hashtable key */ function->fn_hashkey = &hentry->key; } void plr_HashTableDelete(plr_function *function) { plr_HashEnt *hentry; hentry = (plr_HashEnt*) hash_search(plr_HashTable, (void *) function->fn_hashkey, HASH_REMOVE, NULL); if (hentry == NULL) elog(WARNING, "trying to delete function that does not exist"); } static char * get_lib_pathstr(Oid langOid) { HeapTuple procedureTuple; HeapTuple languageTuple; Form_pg_language languageStruct; Oid lang_funcid; Datum tmp; bool isnull; char *raw_path; char *cooked_path; languageTuple = SearchSysCache(LANGOID, ObjectIdGetDatum(langOid), 0, 0, 0); if (!HeapTupleIsValid(languageTuple)) /* internal error */ elog(ERROR, "cache lookup failed for language %u", langOid); languageStruct = (Form_pg_language) GETSTRUCT(languageTuple); lang_funcid = languageStruct->lanplcallfoid; ReleaseSysCache(languageTuple); /* finally, get the pg_proc entry for the language handler */ procedureTuple = SearchSysCache(PROCOID, ObjectIdGetDatum(lang_funcid), 0, 0, 0); if (!HeapTupleIsValid(procedureTuple)) /* internal error */ elog(ERROR, "cache lookup failed for function %u", lang_funcid); tmp = SysCacheGetAttr(PROCOID, procedureTuple, Anum_pg_proc_probin, &isnull); raw_path = DatumGetCString(DirectFunctionCall1(byteaout, tmp)); #if PG_VERSION_NUM >= 80500 /* Recognize hex input */ if (raw_path[0] == '\\' && raw_path[1] == 'x') { char *result; int bc; size_t len = strlen(raw_path); bc = (len - 2)/2 + 1; /* maximum possible length */ result = palloc0(bc); bc = hex_decode(raw_path + 2, len - 2, result); cooked_path = expand_dynamic_library_name(result); } else cooked_path = expand_dynamic_library_name(raw_path); #else cooked_path = expand_dynamic_library_name(raw_path); #endif if (!cooked_path) cooked_path = pstrdup(raw_path); ReleaseSysCache(procedureTuple); return cooked_path; } char * get_load_self_ref_cmd(Oid langOid) { char *libstr = get_lib_pathstr(langOid); char *buf = NULL; if (libstr) buf = (char *) palloc(strlen(libstr) + 12 + 1); else ereport(ERROR, (errcode_for_file_access(), errmsg("could not find path to PL/R shared library"))); sprintf(buf, "dyn.load(\"%s\")", libstr); return buf; } void perm_fmgr_info(Oid functionId, FmgrInfo *finfo) { fmgr_info_cxt(functionId, finfo, TopMemoryContext); INIT_AUX_FMGR_ATTS; } static bool file_exists(const char *name) { struct stat st; AssertArg(name != NULL); if (stat(name, &st) == 0) return S_ISDIR(st.st_mode) ? false : true; else if (!(errno == ENOENT || errno == ENOTDIR || errno == EACCES)) ereport(ERROR, (errcode_for_file_access(), errmsg("could not access file \"%s\": %m", name))); return false; } #ifndef DLSUFFIX #error "DLSUFFIX must be defined to compile this file." #endif /* * If name contains a slash, check if the file exists, if so return * the name. Else (no slash) try to expand using search path (see * find_in_dynamic_libpath below); if that works, return the fully * expanded file name. If the previous failed, append DLSUFFIX and * try again. If all fails, return NULL. * * A non-NULL result will always be freshly palloc'd. */ static char * expand_dynamic_library_name(const char *name) { bool have_slash; char *new; char *full; AssertArg(name); have_slash = (strchr(name, '/') != NULL); #ifndef WIN32 if (!have_slash) { full = find_in_dynamic_libpath(name); if (full) return full; } else { full = substitute_libpath_macro(name); if (file_exists(full)) return full; pfree(full); } #endif new = palloc(strlen(name) + strlen(DLSUFFIX) + 1); strcpy(new, name); strcat(new, DLSUFFIX); if (!have_slash) { full = find_in_dynamic_libpath(new); pfree(new); if (full) return full; } else { full = substitute_libpath_macro(new); pfree(new); if (file_exists(full)) return full; pfree(full); } return NULL; } /* * Substitute for any macros appearing in the given string. * Result is always freshly palloc'd. */ static char * substitute_libpath_macro(const char *name) { const char *sep_ptr; char *ret; char pkglib_path[MAXPGPATH]; AssertArg(name != NULL); get_pkglib_path(my_exec_path, pkglib_path); if (name[0] != '$') return pstrdup(name); if ((sep_ptr = first_dir_separator(name)) == NULL) sep_ptr = name + strlen(name); if (strlen("$libdir") != sep_ptr - name || strncmp(name, "$libdir", strlen("$libdir")) != 0) ereport(ERROR, (errcode(ERRCODE_INVALID_NAME), errmsg("invalid macro name in dynamic library path: %s", name))); ret = palloc(strlen(pkglib_path) + strlen(sep_ptr) + 1); strcpy(ret, pkglib_path); strcat(ret, sep_ptr); return ret; } /* * Search for a file called 'basename' in the colon-separated search * path Dynamic_library_path. If the file is found, the full file name * is returned in freshly palloc'd memory. If the file is not found, * return NULL. */ static char * find_in_dynamic_libpath(const char *basename) { const char *p; size_t baselen; char *Dynamic_library_path = GetConfigOptionByName("dynamic_library_path", NULL #if PG_VERSION_NUM >= 90600 , false #endif ); AssertArg(basename != NULL); AssertArg(strchr(basename, '/') == NULL); AssertState(Dynamic_library_path != NULL); p = Dynamic_library_path; if (strlen(p) == 0) return NULL; baselen = strlen(basename); for (;;) { size_t len; char *piece; char *mangled; char *full; len = strcspn(p, ":"); if (len == 0) ereport(ERROR, (errcode(ERRCODE_INVALID_NAME), errmsg("zero-length component in DYNAMIC_LIBRARY_PATH"))); piece = palloc(len + 1); strncpy(piece, p, len); piece[len] = '\0'; mangled = substitute_libpath_macro(piece); pfree(piece); /* only absolute paths */ if (mangled[0] != '/') ereport(ERROR, (errcode(ERRCODE_INVALID_NAME), errmsg("DYNAMIC_LIBRARY_PATH component is not absolute"))); full = palloc(strlen(mangled) + 1 + baselen + 1); sprintf(full, "%s/%s", mangled, basename); pfree(mangled); elog(DEBUG2, "find_in_dynamic_libpath: trying %s", full); if (file_exists(full)) return full; pfree(full); if (p[len] == '\0') break; else p += len + 1; } return NULL; } plr-REL8_4_5/pg_conversion.c000077500000000000000000001532001414122415700160560ustar00rootroot00000000000000/* * PL/R - PostgreSQL support for R as a * procedural language (PL) * * Copyright (c) 2003 by Joseph E. Conway * ALL RIGHTS RESERVED * * Joe Conway * * Based on pltcl by Jan Wieck * and inspired by REmbeddedPostgres by * Duncan Temple Lang * http://www.omegahat.org/RSPostgres/ * * License: GPL version 2 or newer. http://www.gnu.org/copyleft/gpl.html * * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * pg_conversion.c - functions for converting arguments from pg types to * R types, and for converting return values from R types * to pg types */ #include "plr.h" static void pg_get_one_r(char *value, Oid arg_out_fn_oid, SEXP obj, int elnum); static SEXP get_r_vector(Oid typtype, int64 numels); static Datum get_trigger_tuple(SEXP rval, plr_function *function, FunctionCallInfo fcinfo, bool *isnull); static Datum get_tuplestore(SEXP rval, plr_function *function, FunctionCallInfo fcinfo, bool *isnull); static Datum get_simple_array_datum(SEXP rval, Oid typelem, bool *isnull); static Datum get_array_datum(SEXP rval, plr_function *function, int col, bool *isnull); static Datum get_frame_array_datum(SEXP rval, plr_function *function, int col, bool *isnull); static Datum get_md_array_datum(SEXP rval, int ndims, plr_function *function, int col, bool *isnull); static Datum get_generic_array_datum(SEXP rval, plr_function *function, int col, bool *isnull); static Tuplestorestate *get_frame_tuplestore(SEXP rval, plr_function *function, AttInMetadata *attinmeta, MemoryContext per_query_ctx); static Tuplestorestate *get_matrix_tuplestore(SEXP rval, plr_function *function, AttInMetadata *attinmeta, MemoryContext per_query_ctx); static Tuplestorestate *get_generic_tuplestore(SEXP rval, plr_function *function, AttInMetadata *attinmeta, MemoryContext per_query_ctx); static SEXP coerce_to_char(SEXP rval); static Datum r_get_tuple(SEXP rval, plr_function *function, FunctionCallInfo fcinfo); extern char *last_R_error_msg; /* * given a scalar pg value, convert to a one row R vector */ SEXP pg_scalar_get_r(Datum dvalue, Oid arg_typid, FmgrInfo arg_out_func) { SEXP result; /* add our value to it */ if (arg_typid != BYTEAOID) { char *value; value = DatumGetCString(FunctionCall3(&arg_out_func, dvalue, (Datum) 0, Int32GetDatum(-1))); /* get new vector of the appropriate type, length 1 */ PROTECT(result = get_r_vector(arg_typid, 1)); pg_get_one_r(value, arg_typid, result, 0); UNPROTECT(1); } else { SEXP s, t, obj; int status; Datum dt_dvalue = PointerGetDatum(PG_DETOAST_DATUM(dvalue)); int bsize = VARSIZE((bytea *) dt_dvalue); PROTECT(obj = get_r_vector(arg_typid, bsize)); memcpy((char *) RAW(obj), VARDATA((bytea *) dt_dvalue), bsize); /* * Need to construct a call to * unserialize(rval) */ PROTECT(t = s = allocList(2)); SET_TYPEOF(s, LANGSXP); SETCAR(t, install("unserialize")); t = CDR(t); SETCAR(t, obj); PROTECT(result = R_tryEval(s, R_GlobalEnv, &status)); if(status != 0) { if (last_R_error_msg) ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("R interpreter expression evaluation error"), errdetail("%s", last_R_error_msg))); else ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("R interpreter expression evaluation error"), errdetail("R expression evaluation error caught in \"unserialize\"."))); } UNPROTECT(3); } return result; } /* * Given an array pg value, convert to a multi-row R vector. */ SEXP pg_array_get_r(Datum dvalue, FmgrInfo out_func, int typlen, bool typbyval, char typalign) { /* * Loop through and convert each scalar value. * Use the converted values to build an R vector. */ SEXP result; ArrayType *v; Oid element_type; int i, j, k, nitems, nr = 1, nc = 1, nz = 1, ndim, *dim; int elem_idx = 0; Datum *elem_values; bool *elem_nulls; bool fast_track_type; /* short-circuit for NULL datums */ if (dvalue == (Datum) NULL) return R_NilValue; v = DatumGetArrayTypeP(dvalue); ndim = ARR_NDIM(v); element_type = ARR_ELEMTYPE(v); dim = ARR_DIMS(v); nitems = ArrayGetNItems(ARR_NDIM(v), ARR_DIMS(v)); switch (element_type) { case INT4OID: case FLOAT8OID: fast_track_type = true; break; default: fast_track_type = false; } /* * Special case for pass-by-value data types, if the following conditions are met: * designated fast_track_type * no NULL elements * 1 dimensional array only * at least one element */ if (fast_track_type && typbyval && !ARR_HASNULL(v) && (ndim == 1) && (nitems > 0)) { char *p = ARR_DATA_PTR(v); /* get new vector of the appropriate type and length */ PROTECT(result = get_r_vector(element_type, nitems)); /* keep this in sync with switch above -- fast_track_type only */ switch (element_type) { case INT4OID: Assert(sizeof(int) == 4); memcpy(INTEGER_DATA(result), p, nitems * sizeof(int)); break; case FLOAT8OID: Assert(sizeof(double) == 8); memcpy(NUMERIC_DATA(result), p, nitems * sizeof(double)); break; default: /* Everything else is error */ ereport(ERROR, (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), errmsg("direct array passthrough attempted for unsupported type"))); } if (ndim > 1) { SEXP matrix_dims; /* attach dimensions */ PROTECT(matrix_dims = allocVector(INTSXP, ndim)); for (i = 0; i < ndim; i++) INTEGER_DATA(matrix_dims)[i] = dim[i]; setAttrib(result, R_DimSymbol, matrix_dims); UNPROTECT(1); } UNPROTECT(1); /* result */ } else { deconstruct_array(v, element_type, typlen, typbyval, typalign, &elem_values, &elem_nulls, &nitems); /* array is empty */ if (nitems == 0) { PROTECT(result = get_r_vector(element_type, nitems)); UNPROTECT(1); return result; } if (ndim == 1) nr = nitems; else if (ndim == 2) { nr = dim[0]; nc = dim[1]; } else if (ndim == 3) { nr = dim[0]; nc = dim[1]; nz = dim[2]; } else ereport(ERROR, (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), errmsg("greater than 3-dimensional arrays are not yet supported"))); /* get new vector of the appropriate type and length */ PROTECT(result = get_r_vector(element_type, nitems)); /* Convert all values to their R form and build the vector */ for (i = 0; i < nr; i++) { for (j = 0; j < nc; j++) { for (k = 0; k < nz; k++) { char *value; Datum itemvalue; bool isnull; int idx = (k * nr * nc) + (j * nr) + i; isnull = elem_nulls[elem_idx]; itemvalue = elem_values[elem_idx++]; if (!isnull) { value = DatumGetCString(FunctionCall3(&out_func, itemvalue, (Datum) 0, Int32GetDatum(-1))); } else value = NULL; /* * Note that pg_get_one_r() replaces NULL values with * the NA value appropriate for the data type. */ pg_get_one_r(value, element_type, result, idx); if (value != NULL) pfree(value); } } } pfree(elem_values); pfree(elem_nulls); if (ndim > 1) { SEXP matrix_dims; /* attach dimensions */ PROTECT(matrix_dims = allocVector(INTSXP, ndim)); for (i = 0; i < ndim; i++) INTEGER_DATA(matrix_dims)[i] = dim[i]; setAttrib(result, R_DimSymbol, matrix_dims); UNPROTECT(1); } UNPROTECT(1); /* result */ } return result; } #ifdef HAVE_WINDOW_FUNCTIONS /* * Evaluate a window function's argument expression on a specified * window frame, returning either an array or an R dataframe * for the argno column in the frame, depending on whether * the argno argument is of composite type or not * * winobj: PostgreSQL window object handle * argno: argument number to evaluate (counted from 0) * function: contains necessary info on how to output Datum as string for general case conversion */ SEXP pg_window_frame_get_r(WindowObject winobj, int argno, plr_function* function) { char buf[256]; SEXP result, v, names, row_names; int64 i, num_frame_row = 0; int j, nc = 1, nc_effective = 1, df_colnum = 0; Datum dvalue; bool isnull, isout = false; bool isrel = function->arg_is_rel[argno]; Oid element_type = function->arg_typid[argno]; FmgrInfo out_func = function->arg_out_func[argno]; /* for tuple arguments */ HeapTuple tuple; HeapTupleHeader tuple_hdr; Oid tupType; int32 tupTypmod; TupleDesc tupdesc; /* for array arguments */ Oid typelem = function->arg_elem[argno]; int16 typlen; bool typbyval; char typdelim, typalign; Oid typoutput, typioparam; FmgrInfo outputproc; int64 num_partition_rows = WinGetPartitionRowCount(winobj); if (num_partition_rows < 1) return R_NilValue; /* * Check to see if arg is an array type. typelem will be * InvalidOid instead of actual element type if the type is not a * varlena array. */ if (!isrel && typelem != InvalidOid) { typlen = function->arg_elem_typlen[argno]; typbyval = function->arg_elem_typbyval[argno]; typalign = function->arg_elem_typalign[argno]; outputproc = function->arg_elem_out_func[argno]; } if (isrel) { /* * Get current row for starters, setting mark * Need this to get tuple info in order to build an R dataframe */ dvalue = WinGetFuncArgInFrame(winobj, argno, 0, WINDOW_SEEK_HEAD, true, &isnull, &isout); if (isout || isnull) return R_NilValue; /* Count non-dropped attributes so we can later ignore the dropped ones */ tuple_hdr = DatumGetHeapTupleHeader(dvalue); tupType = HeapTupleHeaderGetTypeId(tuple_hdr); tupTypmod = HeapTupleHeaderGetTypMod(tuple_hdr); tupdesc = lookup_rowtype_tupdesc(tupType, tupTypmod); nc = tupdesc->natts; for (j = 0, nc_effective = 0; j < nc; j++) { if (!TUPLE_DESC_ATTR(tupdesc,j)->attisdropped) nc_effective++; } /* * Allocate the resulting data.frame initially as a list, * and also allocate a names vector for the column names. * If !isrel, then nc == nc_effective == 1, see below */ PROTECT(names = NEW_CHARACTER(nc_effective)); } PROTECT(result = NEW_LIST(nc_effective)); for (;; num_frame_row++) { dvalue = WinGetFuncArgInFrame(winobj, argno, num_frame_row, WINDOW_SEEK_HEAD, num_frame_row == 0, &isnull, &isout); if (isout) break; if (isrel && !isnull) { /* Allocate new heaptuple for this row and set contents */ tuple = palloc(sizeof(HeapTupleData)); tuple_hdr = DatumGetHeapTupleHeader(dvalue); tuple->t_len = HeapTupleHeaderGetDatumLength(tuple_hdr); ItemPointerSetInvalid(&(tuple->t_self)); tuple->t_tableOid = InvalidOid; tuple->t_data = tuple_hdr; } for (df_colnum = 0, j = 0; j < nc; j++) { if (isrel) { /* ignore dropped attributes */ if (TUPLE_DESC_ATTR(tupdesc,j)->attisdropped) continue; /* set column names */ if (num_frame_row == 0) SET_COLUMN_NAMES; /* update column datatype oid and check for embedded array */ element_type = SPI_gettypeid(tupdesc, j + 1); typelem = get_element_type(element_type); if (typelem != InvalidOid) { get_type_io_data(typelem, IOFunc_output, &typlen, &typbyval, &typalign, &typdelim, &typioparam, &typoutput); fmgr_info(typoutput, &outputproc); } } if (num_frame_row == 0) { /* allocate new vector of the appropriate type and length */ if (typelem == InvalidOid) /* dealing with scalars of element_type */ PROTECT(v = get_r_vector(element_type, num_partition_rows)); else /* dealing with arrays (containing typelem's) */ PROTECT(v = NEW_LIST(num_partition_rows)); SET_VECTOR_ELT(result, df_colnum, v); UNPROTECT(1); } v = VECTOR_ELT(result, df_colnum); if (!isrel && typelem == InvalidOid) { /* scalar type */ char *value; switch (element_type) { case BOOLOID: LOGICAL_DATA(v)[num_frame_row] = isnull ? NA_LOGICAL : DatumGetBool(dvalue); break; case INT8OID: NUMERIC_DATA(v)[num_frame_row] = isnull ? NA_REAL : (double)DatumGetInt64(dvalue); break; case INT2OID: case INT4OID: case OIDOID: INTEGER_DATA(v)[num_frame_row] = isnull ? NA_INTEGER : DatumGetInt32(dvalue); break; case FLOAT4OID: NUMERIC_DATA(v)[num_frame_row] = isnull ? NA_REAL : DatumGetFloat4(dvalue); break; case FLOAT8OID: NUMERIC_DATA(v)[num_frame_row] = isnull ? NA_REAL : DatumGetFloat8(dvalue); break; default: value = isnull ? NULL : DatumGetCString(FunctionCall3(&out_func, dvalue, (Datum) 0, Int32GetDatum(-1))); /* * Note that pg_get_one_r() replaces NULL values with * the NA value appropriate for the data type. */ pg_get_one_r(value, element_type, v, num_frame_row); if (value != NULL) pfree(value); } } else if (isrel && typelem == InvalidOid) { char *value = isnull ? NULL : SPI_getvalue(tuple, tupdesc, j + 1); pg_get_one_r(value, element_type, v, num_frame_row); if (value != NULL) pfree(value); } else /* typelem != InvalidOid, i.e.: */ { /* array type (regardless of whether embedded in a tuple or not) */ SEXP fldvec_elem; Datum value = dvalue; bool isvaluenull = isnull; if (isrel && !isnull) value = SPI_getbinval(tuple, tupdesc, j + 1, &isvaluenull); if (!isvaluenull) PROTECT(fldvec_elem = pg_array_get_r(value, outputproc, typlen, typbyval, typalign)); else PROTECT(fldvec_elem = R_NilValue); SET_VECTOR_ELT(v, num_frame_row, fldvec_elem); UNPROTECT(1); } df_colnum++; } if (isrel && !isnull) pfree(tuple); } /* Resize all vectors from num_partition_rows (rows in partition) down to num_frame_row (rows in frame) */ if (num_frame_row < num_partition_rows) { for (df_colnum = 0, j = 0; j < nc; j++) { if (isrel && TUPLE_DESC_ATTR(tupdesc,j)->attisdropped) continue; v = VECTOR_ELT(result, df_colnum); SET_VECTOR_ELT(result, df_colnum, SET_LENGTH(v, num_frame_row)); df_colnum++; } } /* for non-tuple arguments return now */ if (!isrel) { v = VECTOR_ELT(result, 0); UNPROTECT(1); /* result */ return v; } /* attach the column names */ setAttrib(result, R_NamesSymbol, names); /* attach row names - basically just the row number, zero based */ PROTECT(row_names = allocVector(STRSXP, num_frame_row)); for (i = 0; i < num_frame_row; i++) { sprintf(buf, "%ld", i + 1); SET_STRING_ELT(row_names, i, COPY_TO_USER_STRING(buf)); } setAttrib(result, R_RowNamesSymbol, row_names); /* finally, tell R we are a data.frame */ setAttrib(result, R_ClassSymbol, mkString("data.frame")); ReleaseTupleDesc(tupdesc); UNPROTECT(3); /* result, names, row-names */ return result; } #endif /* * Given an array of pg tuples, convert to an R list * the created object is not quite actually a data.frame */ SEXP pg_tuple_get_r_frame(int ntuples, HeapTuple *tuples, TupleDesc tupdesc) { int nr = ntuples; int nc = tupdesc->natts; int nc_non_dropped = 0; int df_colnum = 0; int i = 0; int j = 0; Oid element_type; Oid typelem; SEXP names; SEXP row_names; char buf[256]; SEXP result; SEXP fldvec; if (tuples == NULL || ntuples < 1) return R_NilValue; /* Count non-dropped attributes so we can later ignore the dropped ones */ for (j = 0; j < nc; j++) { if (!TUPLE_DESC_ATTR(tupdesc,i)->attisdropped) nc_non_dropped++; } /* * Allocate the data.frame initially as a list, * and also allocate a names vector for the column names */ PROTECT(result = NEW_LIST(nc_non_dropped)); PROTECT(names = NEW_CHARACTER(nc_non_dropped)); /* * Loop by columns */ for (j = 0; j < nc; j++) { int16 typlen; bool typbyval; char typdelim; Oid typoutput, typioparam; FmgrInfo outputproc; char typalign; /* ignore dropped attributes */ if (TUPLE_DESC_ATTR(tupdesc,j)->attisdropped) continue; /* set column name */ SET_COLUMN_NAMES; /* get column datatype oid */ element_type = SPI_gettypeid(tupdesc, j + 1); /* * Check to see if it is an array type. get_element_type will return * InvalidOid instead of actual element type if the type is not a * varlena array. */ typelem = get_element_type(element_type); /* get new vector of the appropriate type and length */ if (typelem == InvalidOid) PROTECT(fldvec = get_r_vector(element_type, nr)); else { PROTECT(fldvec = NEW_LIST(nr)); get_type_io_data(typelem, IOFunc_output, &typlen, &typbyval, &typalign, &typdelim, &typioparam, &typoutput); fmgr_info(typoutput, &outputproc); } /* loop rows for this column */ for (i = 0; i < nr; i++) { if (typelem == InvalidOid) { /* not an array type */ char *value; value = SPI_getvalue(tuples[i], tupdesc, j + 1); pg_get_one_r(value, element_type, fldvec, i); } else { /* array type */ Datum dvalue; bool isnull; SEXP fldvec_elem; dvalue = SPI_getbinval(tuples[i], tupdesc, j + 1, &isnull); if (!isnull) PROTECT(fldvec_elem = pg_array_get_r(dvalue, outputproc, typlen, typbyval, typalign)); else PROTECT(fldvec_elem = R_NilValue); SET_VECTOR_ELT(fldvec, i, fldvec_elem); UNPROTECT(1); } } SET_VECTOR_ELT(result, df_colnum, fldvec); UNPROTECT(1); df_colnum++; } /* attach the column names */ setAttrib(result, R_NamesSymbol, names); /* attach row names - basically just the row number, zero based */ PROTECT(row_names = allocVector(STRSXP, nr)); for (i=0; i use R INTEGER */ PROTECT(result = NEW_INTEGER(numels)); break; case INT8OID: case FLOAT4OID: case FLOAT8OID: case CASHOID: case NUMERICOID: /* * Other numeric types => use R REAL * Note pgsql int8 is mapped to R REAL * because R INTEGER is only 4 byte */ PROTECT(result = NEW_NUMERIC(numels)); break; case BOOLOID: PROTECT(result = NEW_LOGICAL(numels)); break; case BYTEAOID: PROTECT(result = NEW_RAW(numels)); break; default: /* Everything else is defaulted to string */ PROTECT(result = NEW_CHARACTER(numels)); } UNPROTECT(1); return result; } /* * given a single non-array pg value, convert to its R value representation */ static void pg_get_one_r(char *value, Oid typtype, SEXP obj, int elnum) { switch (typtype) { case OIDOID: case INT2OID: case INT4OID: /* 2 and 4 byte integer pgsql datatype => use R INTEGER */ if (value) INTEGER_DATA(obj)[elnum] = atoi(value); else INTEGER_DATA(obj)[elnum] = NA_INTEGER; break; case INT8OID: case FLOAT4OID: case FLOAT8OID: case CASHOID: case NUMERICOID: /* * Other numeric types => use R REAL * Note pgsql int8 is mapped to R REAL * because R INTEGER is only 4 byte */ if (value) { /* fixup for Visual Studio 2013, _MSC_VER == 1916*/ char *endptr = NULL; const double el = strtod(value, &endptr); NUMERIC_DATA(obj)[elnum] = value==endptr ? R_NaN : el; } else NUMERIC_DATA(obj)[elnum] = NA_REAL; break; case BOOLOID: if (value) LOGICAL_DATA(obj)[elnum] = ((*value == 't') ? 1 : 0); else LOGICAL_DATA(obj)[elnum] = NA_LOGICAL; break; default: /* Everything else is defaulted to string */ if (value) SET_STRING_ELT(obj, elnum, COPY_TO_USER_STRING(value)); else SET_STRING_ELT(obj, elnum, NA_STRING); } } /* * given an R value, convert to its pg representation */ Datum r_get_pg(SEXP rval, plr_function *function, FunctionCallInfo fcinfo) { bool isnull = false; Datum result; if (CALLED_AS_TRIGGER(fcinfo)) result = get_trigger_tuple(rval, function, fcinfo, &isnull); else if (fcinfo->flinfo->fn_retset) result = get_tuplestore(rval, function, fcinfo, &isnull); else if (function->result_natts > 1) result = r_get_tuple(rval, function, fcinfo); else { /* short circuit if return value is Null */ if (rval == R_NilValue || isNull(rval)) /* probably redundant */ { fcinfo->isnull = true; return (Datum) 0; } if (function->result_fld_elem_typid[0] == function->result_fld_typid[0]) result = get_scalar_datum(rval, function->result_fld_typid[0], function->result_fld_elem_in_func[0], &isnull); else result = get_array_datum(rval, function, 0, &isnull); } if (isnull) fcinfo->isnull = true; return result; } /* * Given an R value (data frame or list), coerce it to list * and get a tuple representing first elements of each list element. * * This is used to return a single RECORD (not SETOF) */ Datum r_get_tuple(SEXP rval, plr_function *function, FunctionCallInfo fcinfo) { Oid oid; TupleDesc tupdesc; HeapTuple tuple; Datum *values; bool *isnull; int i, min_length; if (!(isFrame(rval) || isNewList(rval) || isList(rval))) elog(ERROR, "Only list alike is expected"); if (TYPEFUNC_COMPOSITE != get_call_result_type(fcinfo, &oid, &tupdesc)) elog(ERROR, "return type must be a row type"); min_length = Min(function->result_natts, length(rval)); //if (tupdesc->natts != length(rval)) // elog(ERROR, "same length expected"); BlessTupleDesc(tupdesc); values = palloc0(sizeof(Datum) * tupdesc->natts); isnull = palloc0(sizeof(bool) * tupdesc->natts); for (i = 0; i < min_length; i++) { SEXP el = VECTOR_ELT(rval, i); if (function->result_fld_typid[i] != function->result_fld_elem_typid[i]) values[i] = get_array_datum(el, function, i, isnull + i); else values[i] = get_scalar_datum(el, function->result_fld_elem_typid[i], function->result_fld_elem_in_func[i], isnull + i); } tuple = heap_form_tuple(tupdesc, values, isnull); pfree(values); pfree(isnull); return HeapTupleGetDatum(tuple); } /* * Similar to r_get_pg, given an R value, convert to its pg representation * Other than scalar, currently only prepared to be used with simple 1D vector */ Datum get_datum(SEXP rval, Oid typid, Oid typelem, FmgrInfo in_func, bool *isnull) { Datum result; /* short circuit if return value is Null */ if (rval == R_NilValue || isNull(rval)) /* probably redundant */ { *isnull = true; return (Datum) 0; } if (typelem == InvalidOid) result = get_scalar_datum(rval, typid, in_func, isnull); else result = get_simple_array_datum(rval, typelem, isnull); return result; } static Datum get_trigger_tuple(SEXP rval, plr_function *function, FunctionCallInfo fcinfo, bool *isnull) { TriggerData *trigdata = (TriggerData *) fcinfo->context; TupleDesc tupdesc = trigdata->tg_relation->rd_att; AttInMetadata *attinmeta; MemoryContext fn_mcxt; MemoryContext oldcontext; int nc; int nr; char **values; HeapTuple tuple = NULL; int i, j; int nc_dropped = 0; int df_colnum = 0; SEXP result; SEXP dfcol; /* short circuit statement level trigger which always returns NULL */ if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event)) { /* special for triggers, don't set isnull flag */ *isnull = false; return (Datum) 0; } /* short circuit if return value is Null */ if (rval == R_NilValue || isNull(rval)) /* probably redundant */ { /* special for triggers, don't set isnull flag */ *isnull = false; return (Datum) 0; } if (isFrame(rval)) nc = length(rval); else if (isMatrix(rval)) nc = ncols(rval); else nc = 1; PROTECT(dfcol = VECTOR_ELT(rval, 0)); nr = length(dfcol); UNPROTECT(1); if (nr != 1) ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("incorrect function return type"), errdetail("function return value cannot have more " \ "than one row"))); /* * Count number of dropped attributes so we can add them back to * the return tuple */ for (j = 0; j < nc; j++) { if (TUPLE_DESC_ATTR(tupdesc,j)->attisdropped) nc_dropped++; } /* * Check to make sure we have the same number of columns * to return as there are attributes in the return tuple. * Note that we have to account for the number of dropped * columns. * * Note we will attempt to coerce the R values into whatever * the return attribute type is and depend on the "in" * function to complain if needed. */ if (nc + nc_dropped != tupdesc->natts) ereport(ERROR, (errcode(ERRCODE_DATATYPE_MISMATCH), errmsg("returned tuple structure does not match table " \ "of trigger event"))); fn_mcxt = fcinfo->flinfo->fn_mcxt; oldcontext = MemoryContextSwitchTo(fn_mcxt); attinmeta = TupleDescGetAttInMetadata(tupdesc); /* coerce columns to character in advance */ PROTECT(result = NEW_LIST(nc)); for (j = 0; j < nc; j++) { PROTECT(dfcol = VECTOR_ELT(rval, j)); if(!isFactor(dfcol)) { SEXP obj; PROTECT(obj = coerce_to_char(dfcol)); SET_VECTOR_ELT(result, j, obj); UNPROTECT(1); } else { SEXP t; for (t = ATTRIB(dfcol); t != R_NilValue; t = CDR(t)) { if(TAG(t) == R_LevelsSymbol) { PROTECT(SETCAR(t, coerce_to_char(CAR(t)))); UNPROTECT(1); break; } } SET_VECTOR_ELT(result, j, dfcol); } UNPROTECT(1); } values = (char **) palloc((nc + nc_dropped) * sizeof(char *)); for(i = 0; i < nr; i++) { for (j = 0; j < nc + nc_dropped; j++) { /* insert NULL for dropped attributes */ if (TUPLE_DESC_ATTR(tupdesc,j)->attisdropped) values[j] = NULL; else { PROTECT(dfcol = VECTOR_ELT(result, df_colnum)); if(isFactor(dfcol)) { SEXP t; for (t = ATTRIB(dfcol); t != R_NilValue; t = CDR(t)) { if(TAG(t) == R_LevelsSymbol) { SEXP obj; int idx = INTEGER(dfcol)[i] - 1; PROTECT(obj = CAR(t)); values[j] = pstrdup(CHAR(STRING_ELT(obj, idx))); UNPROTECT(1); break; } } } else { if (STRING_ELT(dfcol, 0) != NA_STRING) values[j] = pstrdup(CHAR(STRING_ELT(dfcol, i))); else values[j] = NULL; } UNPROTECT(1); df_colnum++; } } /* construct the tuple */ tuple = BuildTupleFromCStrings(attinmeta, values); for (j = 0; j < nc; j++) if (values[j] != NULL) pfree(values[j]); } UNPROTECT(1); MemoryContextSwitchTo(oldcontext); if (tuple) { *isnull = false; return PointerGetDatum(tuple); } else { /* special for triggers, don't set isnull flag */ *isnull = false; return (Datum) 0; } } static Datum get_tuplestore(SEXP rval, plr_function *function, FunctionCallInfo fcinfo, bool *isnull) { ReturnSetInfo *rsinfo = (ReturnSetInfo *) fcinfo->resultinfo; TupleDesc tupdesc; AttInMetadata *attinmeta; MemoryContext per_query_ctx; MemoryContext oldcontext; int nc; /* check to see if caller supports us returning a tuplestore */ if (!rsinfo || !(rsinfo->allowedModes & SFRM_Materialize)) ereport(ERROR, (errcode(ERRCODE_SYNTAX_ERROR), errmsg("materialize mode required, but it is not " "allowed in this context"))); if (isFrame(rval)) nc = length(rval); else if (isList(rval) || isNewList(rval)) nc = length(rval); else if (isMatrix(rval)) nc = ncols(rval); else nc = 1; per_query_ctx = rsinfo->econtext->ecxt_per_query_memory; oldcontext = MemoryContextSwitchTo(per_query_ctx); /* get the requested return tuple description */ tupdesc = CreateTupleDescCopy(rsinfo->expectedDesc); /* * Check to make sure we have the same number of columns * to return as there are attributes in the return tuple. * * Note we will attempt to coerce the R values into whatever * the return attribute type is and depend on the "in" * function to complain if needed. */ if (nc != tupdesc->natts) ereport(ERROR, (errcode(ERRCODE_SYNTAX_ERROR), errmsg("query-specified return tuple and " "function returned data.frame are not compatible"))); attinmeta = TupleDescGetAttInMetadata(tupdesc); /* OK, go to work */ rsinfo->returnMode = SFRM_Materialize; if (isFrame(rval) || isList(rval) || isNewList(rval)) rsinfo->setResult = get_frame_tuplestore(rval, function, attinmeta, per_query_ctx); else if (isMatrix(rval)) rsinfo->setResult = get_matrix_tuplestore(rval, function, attinmeta, per_query_ctx); else rsinfo->setResult = get_generic_tuplestore(rval, function, attinmeta, per_query_ctx); /* * SFRM_Materialize mode expects us to return a NULL Datum. The actual * tuples are in our tuplestore and passed back through * rsinfo->setResult. rsinfo->setDesc is set to the tuple description * that we actually used to build our tuples with, so the caller can * verify we did what it was expecting. */ rsinfo->setDesc = tupdesc; MemoryContextSwitchTo(oldcontext); *isnull = true; return (Datum) 0; } Datum get_scalar_datum(SEXP rval, Oid result_typid, FmgrInfo result_in_func, bool *isnull) { Datum dvalue; SEXP obj; const char *value = NULL; /* * Element type is zero, we don't have an array, so coerce to string * and take the first element as a scalar * * Exception: if result type is BYTEA, we want to return the whole * object in serialized form */ if (result_typid != BYTEAOID) { PROTECT(obj = coerce_to_char(rval)); /* * passing a null into something like * return as.real(NULL) will return numeric(0) * which has a length of 0 */ if ( (isNumeric(rval) && length(rval) == 0) || STRING_ELT(obj, 0) == NA_STRING) { UNPROTECT(1); *isnull = true; dvalue = (Datum) 0; return dvalue; } obj = STRING_ELT(obj, 0); if (TYPEOF(obj) == CHARSXP ) { value = CHAR(obj); } else { ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("R interpreter expression evaluation error"), errdetail("return type cannot be coerced to char"))); } UNPROTECT(1); if (value != NULL) { dvalue = FunctionCall3(&result_in_func, CStringGetDatum(value), ObjectIdGetDatum(0), Int32GetDatum(-1)); } else { *isnull = true; dvalue = (Datum) 0; } } else { SEXP s, t; int len, rsize, status; bytea *result; char *rptr; /* * Need to construct a call to * serialize(rval, NULL) */ PROTECT(t = s = allocList(3)); SET_TYPEOF(s, LANGSXP); SETCAR(t, install("serialize")); t = CDR(t); SETCAR(t, rval); t = CDR(t); SETCAR(t, R_NilValue); PROTECT(obj = R_tryEval(s, R_GlobalEnv, &status)); if(status != 0) { if (last_R_error_msg) ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("R interpreter expression evaluation error"), errdetail("%s", last_R_error_msg))); else ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("R interpreter expression evaluation error"), errdetail("R expression evaluation error caught in \"serialize\"."))); } len = LENGTH(obj); rsize = VARHDRSZ + len; result = (bytea *) palloc(rsize); SET_VARSIZE(result, rsize); rptr = VARDATA(result); memcpy(rptr, (char *) RAW(obj), rsize - VARHDRSZ); UNPROTECT(2); dvalue = PointerGetDatum(result); } return dvalue; } static Datum get_array_datum(SEXP rval, plr_function *function, int col, bool *isnull) { SEXP rdims; int ndims; int objlen = length(rval); if (objlen > 0) { /* two supported special cases */ if (isFrame(rval)) return get_frame_array_datum(rval, function, col, isnull); else if (isMatrix(rval)) return get_md_array_datum(rval, 2 /* matrix is 2D */, function, col, isnull); PROTECT(rdims = getAttrib(rval, R_DimSymbol)); ndims = length(rdims); UNPROTECT(1); /* 2D and 3D arrays are specifically supported too */ if (ndims == 2 || ndims == 3) return get_md_array_datum(rval, ndims, function, col, isnull); /* everything else */ return get_generic_array_datum(rval, function, col, isnull); } else { /* create an empty array */ return PointerGetDatum(construct_empty_array(function->result_fld_elem_typid[col])); } } static Datum get_frame_array_datum(SEXP rval, plr_function *function, int col, bool *isnull) { Datum dvalue; SEXP obj; const char *value; Oid result_elem; FmgrInfo in_func; int typlen; bool typbyval; char typalign; int i; Datum *dvalues = NULL; ArrayType *array; int nr = 0; int nc = length(rval); #define FIXED_NUM_DIMS 2 int ndims = FIXED_NUM_DIMS; int dims[FIXED_NUM_DIMS]; int lbs[FIXED_NUM_DIMS]; #undef FIXED_NUM_DIMS int idx; SEXP dfcol = NULL; int j; bool *nulls = NULL; bool have_nulls = FALSE; if (nc < 1) /* internal error */ elog(ERROR, "plr: bad internal representation of data.frame"); result_elem = function->result_fld_elem_typid[col]; in_func = function->result_fld_elem_in_func[col]; typlen = function->result_fld_elem_typlen[col]; typbyval = function->result_fld_elem_typbyval[col]; typalign = function->result_fld_elem_typalign[col]; for (j = 0; j < nc; j++) { if (TYPEOF(rval) == VECSXP) PROTECT(dfcol = VECTOR_ELT(rval, j)); else if (TYPEOF(rval) == LISTSXP) { PROTECT(dfcol = CAR(rval)); rval = CDR(rval); } else /* internal error */ elog(ERROR, "plr: bad internal representation of data.frame"); /* * Not sure about this test. Need to reliably detect * factors and do the alternative assignment ONLY for them. * For the moment this locution seems to work correctly. */ if (ATTRIB(dfcol) == R_NilValue || TYPEOF(CAR(ATTRIB(dfcol))) != STRSXP) PROTECT(obj = coerce_to_char(dfcol)); else PROTECT(obj = coerce_to_char(CAR(ATTRIB(dfcol)))); if (j == 0) { nr = length(obj); dvalues = (Datum *) palloc(nr * nc * sizeof(Datum)); nulls = (bool *) palloc(nr * nc * sizeof(bool)); } for(i = 0; i < nr; i++) { value = CHAR(STRING_ELT(obj, i)); idx = ((i * nc) + j); if (STRING_ELT(obj, i) == NA_STRING || value == NULL) { nulls[idx] = TRUE; have_nulls = TRUE; } else { nulls[idx] = FALSE; dvalues[idx] = FunctionCall3(&in_func, CStringGetDatum(value), (Datum) 0, Int32GetDatum(-1)); } } UNPROTECT(2); } dims[0] = nr; dims[1] = nc; lbs[0] = 1; lbs[1] = 1; if (!have_nulls) array = construct_md_array(dvalues, NULL, ndims, dims, lbs, result_elem, typlen, typbyval, typalign); else array = construct_md_array(dvalues, nulls, ndims, dims, lbs, result_elem, typlen, typbyval, typalign); dvalue = PointerGetDatum(array); return dvalue; } /* return simple, one dimensional array */ static Datum get_simple_array_datum(SEXP rval, Oid typelem, bool *isnull) { Datum dvalue; SEXP obj; SEXP rdims; const char *value; int16 typlen; bool typbyval; char typdelim; Oid typinput, typioparam; FmgrInfo in_func; char typalign; int i; Datum *dvalues = NULL; ArrayType *array; int nitems; int *dims; int *lbs; bool *nulls; bool have_nulls = FALSE; int ndims = 1; dims = palloc(ndims * sizeof(int)); lbs = palloc(ndims * sizeof(int)); /* * get the element type's in_func */ get_type_io_data(typelem, IOFunc_output, &typlen, &typbyval, &typalign, &typdelim, &typioparam, &typinput); perm_fmgr_info(typinput, &in_func); PROTECT(rdims = getAttrib(rval, R_DimSymbol)); if (length(rdims) > 1) ereport(ERROR, (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), errmsg("greater than 1-dimensional arrays are " \ "not supported in this context"))); dims[0] = INTEGER(rdims)[0]; lbs[0] = 1; UNPROTECT(1); nitems = dims[0]; if (nitems == 0) { *isnull = true; return (Datum) 0; } dvalues = (Datum *) palloc(nitems * sizeof(Datum)); nulls = (bool *) palloc(nitems * sizeof(bool)); PROTECT(obj = coerce_to_char(rval)); for (i = 0; i < nitems; i++) { value = CHAR(STRING_ELT(obj, i)); if (STRING_ELT(obj, i) == NA_STRING || value == NULL) { nulls[i] = TRUE; have_nulls = TRUE; } else { nulls[i] = FALSE; dvalues[i] = FunctionCall3(&in_func, CStringGetDatum(value), (Datum) 0, Int32GetDatum(-1)); } } UNPROTECT(1); if (!have_nulls) array = construct_md_array(dvalues, NULL, ndims, dims, lbs, typelem, typlen, typbyval, typalign); else array = construct_md_array(dvalues, nulls, ndims, dims, lbs, typelem, typlen, typbyval, typalign); dvalue = PointerGetDatum(array); return dvalue; } static Datum get_md_array_datum(SEXP rval, int ndims, plr_function *function, int col, bool *isnull) { Datum dvalue; SEXP obj; SEXP rdims; const char *value; Oid result_elem; FmgrInfo in_func; int typlen; bool typbyval; char typalign; int i, j, k; Datum *dvalues = NULL; ArrayType *array; int nitems; int nr = 1; int nc = 1; int nz = 1; int *dims; int *lbs; int idx; int cntr = 0; bool *nulls; bool have_nulls = FALSE; Oid return_type_oid = function->result_fld_elem_typid[col]; if (ndims > 0) { dims = palloc(ndims * sizeof(int)); lbs = palloc(ndims * sizeof(int)); } else { dims = NULL; lbs = NULL; } result_elem = function->result_fld_elem_typid[col]; in_func = function->result_fld_elem_in_func[col]; typlen = function->result_fld_elem_typlen[col]; typbyval = function->result_fld_elem_typbyval[col]; typalign = function->result_fld_elem_typalign[col]; PROTECT(rdims = getAttrib(rval, R_DimSymbol)); for(i = 0; i < ndims; i++) { dims[i] = INTEGER(rdims)[i]; lbs[i] = 1; switch (i) { case 0: nr = dims[i]; break; case 1: nc = dims[i]; break; case 2: nz = dims[i]; break; default: /* anything higher is currently unsupported */ ereport(ERROR, (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), errmsg("greater than 3-dimensional arrays are " \ "not yet supported"))); } } UNPROTECT(1); nitems = nr * nc * nz; dvalues = (Datum *) palloc(nitems * sizeof(Datum)); nulls = (bool *) palloc(nitems * sizeof(bool)); /* * Convert common R data type directly to datum */ if (TYPEOF(rval) == REALSXP && return_type_oid == INT8OID) { for (i = 0; i < nr; i++) { for (j = 0; j < nc; j++) { for (k = 0; k < nz; k++) { int arridx = cntr++; idx = (k * nr * nc) + (j * nr) + i; if (REAL(rval)[idx] == NA_REAL) { nulls[arridx] = TRUE; have_nulls = TRUE; } else { nulls[arridx] = FALSE; dvalues[arridx] = Int64GetDatum((int64) REAL(rval)[idx]); } } } } } else if (TYPEOF(rval) == REALSXP && return_type_oid == FLOAT4OID) { for (i = 0; i < nr; i++) { for (j = 0; j < nc; j++) { for (k = 0; k < nz; k++) { int arridx = cntr++; idx = (k * nr * nc) + (j * nr) + i; if (REAL(rval)[idx] == NA_REAL) { nulls[arridx] = TRUE; have_nulls = TRUE; } else { nulls[arridx] = FALSE; dvalues[arridx] = Float4GetDatum((float) REAL(rval)[idx]); } } } } } else if (TYPEOF(rval) == REALSXP && return_type_oid == FLOAT8OID) { for (i = 0; i < nr; i++) { for (j = 0; j < nc; j++) { for (k = 0; k < nz; k++) { int arridx = cntr++; idx = (k * nr * nc) + (j * nr) + i; if (REAL(rval)[idx] == NA_REAL) { nulls[arridx] = TRUE; have_nulls = TRUE; } else { nulls[arridx] = FALSE; dvalues[arridx] = Float8GetDatum((double) REAL(rval)[idx]); } } } } } else if (TYPEOF(rval) == REALSXP && return_type_oid == NUMERICOID) { for (i = 0; i < nr; i++) { for (j = 0; j < nc; j++) { for (k = 0; k < nz; k++) { int arridx = cntr++; idx = (k * nr * nc) + (j * nr) + i; if (REAL(rval)[idx] == NA_REAL) { nulls[arridx] = TRUE; have_nulls = TRUE; } else { nulls[arridx] = FALSE; dvalues[arridx] = DirectFunctionCall1(float8_numeric, Float8GetDatum((double)REAL(rval)[idx])); } } } } } else if (TYPEOF(rval) == INTSXP && return_type_oid == INT4OID) { for (i = 0; i < nr; i++) { for (j = 0; j < nc; j++) { for (k = 0; k < nz; k++) { int arridx = cntr++; idx = (k * nr * nc) + (j * nr) + i; if (INTEGER(rval)[idx] == NA_INTEGER) { nulls[arridx] = TRUE; have_nulls = TRUE; } else { nulls[arridx] = FALSE; dvalues[arridx] = Int32GetDatum((int32) INTEGER(rval)[idx]); } } } } } else if (TYPEOF(rval) == INTSXP && return_type_oid == INT2OID) { for (i = 0; i < nr; i++) { for (j = 0; j < nc; j++) { for (k = 0; k < nz; k++) { int arridx = cntr++; idx = (k * nr * nc) + (j * nr) + i; if (INTEGER(rval)[idx] == NA_INTEGER) { nulls[arridx] = TRUE; have_nulls = TRUE; } else { nulls[arridx] = FALSE; dvalues[arridx] = Int16GetDatum((int16) INTEGER(rval)[idx]); } } } } } else { PROTECT(obj = coerce_to_char(rval)); for (i = 0; i < nr; i++) { for (j = 0; j < nc; j++) { for (k = 0; k < nz; k++) { int arridx = cntr++; idx = (k * nr * nc) + (j * nr) + i; value = CHAR(STRING_ELT(obj, idx)); if (STRING_ELT(obj, idx) == NA_STRING || value == NULL) { nulls[arridx] = TRUE; have_nulls = TRUE; } else { nulls[arridx] = FALSE; dvalues[arridx] = FunctionCall3(&in_func, CStringGetDatum(value), (Datum) 0, Int32GetDatum(-1)); } } } } UNPROTECT(1); } if (!have_nulls) array = construct_md_array(dvalues, NULL, ndims, dims, lbs, result_elem, typlen, typbyval, typalign); else array = construct_md_array(dvalues, nulls, ndims, dims, lbs, result_elem, typlen, typbyval, typalign); dvalue = PointerGetDatum(array); return dvalue; } static Datum get_generic_array_datum(SEXP rval, plr_function *function, int col, bool *isnull) { int objlen = length(rval); Datum dvalue; SEXP obj; const char *value; Oid result_elem; FmgrInfo in_func; int typlen; bool typbyval; char typalign; int i; Datum *dvalues = NULL; ArrayType *array; #define FIXED_NUM_DIMS 1 int ndims = FIXED_NUM_DIMS; int dims[FIXED_NUM_DIMS]; int lbs[FIXED_NUM_DIMS]; #undef FIXED_NUM_DIMS bool *nulls; bool have_nulls = FALSE; bool fast_track_type; bool has_na = false; result_elem = function->result_fld_elem_typid[col]; in_func = function->result_fld_elem_in_func[col]; typlen = function->result_fld_elem_typlen[col]; typbyval = function->result_fld_elem_typbyval[col]; typalign = function->result_fld_elem_typalign[col]; /* * Special case for pass-by-value data types, if the following conditions are met: * designated fast_track_type * no NULL/NA elements */ if (TYPEOF(rval) == INTSXP || TYPEOF(rval) == REALSXP) { switch (TYPEOF(rval)) { case INTSXP: if (result_elem == INT4OID) { fast_track_type = true; for (i = 0; i < objlen; i++) { if (INTEGER(rval)[i] == NA_INTEGER) { has_na = true; break; } } } else fast_track_type = false; break; case REALSXP: if (result_elem == FLOAT8OID) { fast_track_type = true; for (i = 0; i < objlen; i++) { if (ISNAN(REAL(rval)[i])) { has_na = true; break; } } } else fast_track_type = false; break; default: fast_track_type = false; has_na = true; /* does not really matter in this case */ } } else { fast_track_type = false; has_na = true; /* does not really matter in this case */ } if (fast_track_type && typbyval && !has_na) { int32 nbytes = 0; int32 dataoffset; if (TYPEOF(rval) == INTSXP) { nbytes = objlen * sizeof(INTEGER_DATA(rval)); dvalues = (Datum *) INTEGER_DATA(rval); } else if (TYPEOF(rval) == REALSXP) { nbytes = objlen * sizeof(NUMERIC_DATA(rval)); dvalues = (Datum *) NUMERIC_DATA(rval); } else elog(ERROR, "attempted to passthrough invalid R datatype to Postgresql"); dims[0] = objlen; lbs[0] = 1; dataoffset = 0; /* marker for no null bitmap */ array = (ArrayType *) palloc0(nbytes + ARR_OVERHEAD_NONULLS(ndims)); SET_VARSIZE(array, nbytes + ARR_OVERHEAD_NONULLS(ndims)); array->ndim = ndims; array->dataoffset = dataoffset; array->elemtype = result_elem; memcpy(ARR_DIMS(array), dims, ndims * sizeof(int)); memcpy(ARR_LBOUND(array), lbs, ndims * sizeof(int)); memcpy(ARR_DATA_PTR(array), dvalues, nbytes); dvalue = PointerGetDatum(array); } else { /* original code */ dvalues = (Datum *) palloc(objlen * sizeof(Datum)); nulls = (bool *) palloc(objlen * sizeof(bool)); /* * Convert common R data type directly to datum */ if (TYPEOF(rval) == REALSXP && result_elem == INT8OID) { for(i = 0; i < objlen; i++) { if (REAL(rval)[i] == NA_REAL) { nulls[i] = TRUE; have_nulls = TRUE; } else { nulls[i] = FALSE; dvalues[i] = Int64GetDatum((int64) REAL(rval)[i]); } } } else if((TYPEOF(rval) == REALSXP && result_elem == FLOAT4OID)) { for(i = 0; i < objlen; i++) { if (REAL(rval)[i] == NA_REAL) { nulls[i] = TRUE; have_nulls = TRUE; } else { nulls[i] = FALSE; dvalues[i] = Float4GetDatum((float) REAL(rval)[i]); } } } else if((TYPEOF(rval) == REALSXP && result_elem == NUMERICOID)) { for(i = 0; i < objlen; i++) { if (REAL(rval)[i] == NA_REAL) { nulls[i] = TRUE; have_nulls = TRUE; } else { nulls[i] = FALSE; dvalues[i] = DirectFunctionCall1(float8_numeric, Float8GetDatum((double)REAL(rval)[i])); } } } else if((TYPEOF(rval) == INTSXP && result_elem == INT2OID)) { for(i = 0; i < objlen; i++) { if (INTEGER(rval)[i] == NA_INTEGER) { nulls[i] = TRUE; have_nulls = TRUE; } else { nulls[i] = FALSE; dvalues[i] = Int16GetDatum((int16) INTEGER(rval)[i]); } } } else { PROTECT(obj = coerce_to_char(rval)); /* Loop is needed here as result value might be of length > 1 */ for(i = 0; i < objlen; i++) { value = CHAR(STRING_ELT(obj, i)); if (STRING_ELT(obj, i) == NA_STRING || value == NULL) { nulls[i] = TRUE; have_nulls = TRUE; } else { nulls[i] = FALSE; dvalues[i] = FunctionCall3(&in_func, CStringGetDatum(value), (Datum) 0, Int32GetDatum(-1)); } } UNPROTECT(1); } dims[0] = objlen; lbs[0] = 1; if (!have_nulls) array = construct_md_array(dvalues, NULL, ndims, dims, lbs, result_elem, typlen, typbyval, typalign); else array = construct_md_array(dvalues, nulls, ndims, dims, lbs, result_elem, typlen, typbyval, typalign); dvalue = PointerGetDatum(array); } return dvalue; } static Tuplestorestate * get_frame_tuplestore(SEXP rval, plr_function *function, AttInMetadata *attinmeta, MemoryContext per_query_ctx) { Tuplestorestate *tupstore; char **values; HeapTuple tuple; TupleDesc tupdesc = attinmeta->tupdesc; int tupdesc_nc = tupdesc->natts; MemoryContext oldcontext; int i, j; int nr = 0; int nc = length(rval); SEXP dfcol; SEXP result; if (nc != tupdesc_nc) ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("actual and requested return type mismatch"), errdetail("Actual return type has %d columns, but " \ "requested return type has %d", nc, tupdesc_nc))); /* switch to appropriate context to create the tuple store */ oldcontext = MemoryContextSwitchTo(per_query_ctx); /* initialize our tuplestore */ tupstore = TUPLESTORE_BEGIN_HEAP; MemoryContextSwitchTo(oldcontext); /* * If we return a set, get number of rows by examining the first column. * Otherwise, stop at one row. */ if (isFrame(rval)) { PROTECT(dfcol = VECTOR_ELT(rval, 0)); nr = length(dfcol); UNPROTECT(1); } else if (isList(rval) || isNewList(rval)) nr = 1; /* coerce columns to character in advance */ PROTECT(result = NEW_LIST(nc)); for (j = 0; j < nc; j++) { PROTECT(dfcol = VECTOR_ELT(rval, j)); if((!isFactor(dfcol)) && ((TUPLE_DESC_ATTR(tupdesc,j)->attndims == 0) || (TYPEOF(dfcol) != VECSXP))) { SEXP obj; PROTECT(obj = coerce_to_char(dfcol)); SET_VECTOR_ELT(result, j, obj); UNPROTECT(1); } else { SEXP t; for (t = ATTRIB(dfcol); t != R_NilValue; t = CDR(t)) { if(TAG(t) == R_LevelsSymbol) { PROTECT(SETCAR(t, coerce_to_char(CAR(t)))); UNPROTECT(1); break; } } SET_VECTOR_ELT(result, j, dfcol); } UNPROTECT(1); } values = (char **) palloc(nc * sizeof(char *)); for(i = 0; i < nr; i++) { for (j = 0; j < nc; j++) { PROTECT(dfcol = VECTOR_ELT(result, j)); if(isFactor(dfcol)) { SEXP t; /* * a factor is a special type of integer * but must check for NA value first */ if (INTEGER_ELT(dfcol, i) != NA_INTEGER) { for (t = ATTRIB(dfcol); t != R_NilValue; t = CDR(t)) { if(TAG(t) == R_LevelsSymbol) { SEXP obj; int idx = INTEGER(dfcol)[i] - 1; PROTECT(obj = CAR(t)); values[j] = pstrdup(CHAR(STRING_ELT(obj, idx))); UNPROTECT(1); break; } } } else values[j] = NULL; } else if (STRING_ELT(dfcol, i) != NA_STRING) values[j] = pstrdup(CHAR(STRING_ELT(dfcol, i))); else values[j] = NULL; UNPROTECT(1); } /* construct the tuple */ tuple = BuildTupleFromCStrings(attinmeta, values); /* switch to appropriate context while storing the tuple */ oldcontext = MemoryContextSwitchTo(per_query_ctx); /* now store it */ tuplestore_puttuple(tupstore, tuple); /* now reset the context */ MemoryContextSwitchTo(oldcontext); for (j = 0; j < nc; j++) if (values[j] != NULL) pfree(values[j]); } UNPROTECT(1); oldcontext = MemoryContextSwitchTo(per_query_ctx); tuplestore_donestoring(tupstore); MemoryContextSwitchTo(oldcontext); return tupstore; } static Tuplestorestate * get_matrix_tuplestore(SEXP rval, plr_function *function, AttInMetadata *attinmeta, MemoryContext per_query_ctx) { Tuplestorestate *tupstore; char **values; HeapTuple tuple; MemoryContext oldcontext; SEXP obj; int i, j; int nr; int nc = ncols(rval); /* switch to appropriate context to create the tuple store */ oldcontext = MemoryContextSwitchTo(per_query_ctx); /* * If we return a set, get number of rows. * Otherwise, stop at one row. */ nr = nrows(rval); /* initialize our tuplestore */ tupstore = TUPLESTORE_BEGIN_HEAP; MemoryContextSwitchTo(oldcontext); values = (char **) palloc(nc * sizeof(char *)); PROTECT(obj = coerce_to_char(rval)); for(i = 0; i < nr; i++) { for (j = 0; j < nc; j++) { if (STRING_ELT(obj, (j * nr) + i) != NA_STRING) values[j] = (char *) CHAR(STRING_ELT(obj, (j * nr) + i)); else values[j] = (char *) NULL; } /* construct the tuple */ tuple = BuildTupleFromCStrings(attinmeta, values); /* switch to appropriate context while storing the tuple */ oldcontext = MemoryContextSwitchTo(per_query_ctx); /* now store it */ tuplestore_puttuple(tupstore, tuple); /* now reset the context */ MemoryContextSwitchTo(oldcontext); } UNPROTECT(1); oldcontext = MemoryContextSwitchTo(per_query_ctx); tuplestore_donestoring(tupstore); MemoryContextSwitchTo(oldcontext); return tupstore; } static Tuplestorestate * get_generic_tuplestore(SEXP rval, plr_function *function, AttInMetadata *attinmeta, MemoryContext per_query_ctx) { Tuplestorestate *tupstore; char **values; HeapTuple tuple; MemoryContext oldcontext; int nr; int nc = 1; SEXP obj; int i; /* switch to appropriate context to create the tuple store */ oldcontext = MemoryContextSwitchTo(per_query_ctx); /* * If we return a set, get number of rows. * Otherwise, stop at one row. */ nr = length(rval); /* initialize our tuplestore */ tupstore = TUPLESTORE_BEGIN_HEAP; MemoryContextSwitchTo(oldcontext); values = (char **) palloc(nc * sizeof(char *)); PROTECT(obj = coerce_to_char(rval)); for(i = 0; i < nr; i++) { if (STRING_ELT(obj, i) != NA_STRING) values[0] = (char *) CHAR(STRING_ELT(obj, i)); else values[0] = (char *) NULL; /* construct the tuple */ tuple = BuildTupleFromCStrings(attinmeta, values); /* switch to appropriate context while storing the tuple */ oldcontext = MemoryContextSwitchTo(per_query_ctx); /* now store it */ tuplestore_puttuple(tupstore, tuple); /* now reset the context */ MemoryContextSwitchTo(oldcontext); } UNPROTECT(1); oldcontext = MemoryContextSwitchTo(per_query_ctx); tuplestore_donestoring(tupstore); MemoryContextSwitchTo(oldcontext); return tupstore; } static SEXP coerce_to_char(SEXP rval) { SEXP obj = NULL; switch (TYPEOF(rval)) { case LISTSXP: case NILSXP: case SYMSXP: case VECSXP: case EXPRSXP: case LGLSXP: case INTSXP: case REALSXP: case CPLXSXP: case STRSXP: case RAWSXP: PROTECT(obj = AS_CHARACTER(rval)); break; default: ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("data type coercion error"), errdetail("R object is not an expected " \ "data type; examine your R code"))); } UNPROTECT(1); return obj; } plr-REL8_4_5/pg_rsupport.c000077500000000000000000000462111414122415700155720ustar00rootroot00000000000000/* * PL/R - PostgreSQL support for R as a * procedural language (PL) * * Copyright (c) 2003 by Joseph E. Conway * ALL RIGHTS RESERVED * * Joe Conway * * Based on pltcl by Jan Wieck * and inspired by REmbeddedPostgres by * Duncan Temple Lang * http://www.omegahat.org/RSPostgres/ * * License: GPL version 2 or newer. http://www.gnu.org/copyleft/gpl.html * * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * pg_rsupport.c - Postgres support for use within plr functions */ #include "plr.h" extern MemoryContext plr_SPI_context; extern char *last_R_error_msg; static SEXP rpgsql_get_results(int ntuples, SPITupleTable *tuptable); static void rsupport_error_callback(void *arg); /* The information we cache prepared plans */ typedef struct saved_plan_desc { void *saved_plan; int nargs; Oid *typeids; Oid *typelems; FmgrInfo *typinfuncs; } saved_plan_desc; /* * Functions used in R *****************************************************************************/ void throw_pg_log(int* elevel, const char **msg) { /* skip error CONTEXT for explicitly called messages */ SAVE_PLERRCONTEXT; if (msg && *msg) elog(*elevel, "%s", *msg); else elog(*elevel, "%s", ""); RESTORE_PLERRCONTEXT; } /* * plr_quote_literal() - quote literal strings that are to * be used in SPI_exec query strings */ SEXP plr_quote_literal(SEXP rval) { const char *value; text *value_text; text *result_text; SEXP result; /* extract the C string */ PROTECT(rval = AS_CHARACTER(rval)); value = CHAR(STRING_ELT(rval, 0)); /* convert using the pgsql quote_literal function */ value_text = PG_STR_GET_TEXT(value); result_text = DatumGetTextP(DirectFunctionCall1(quote_literal, PointerGetDatum(value_text))); /* copy result back into an R object */ PROTECT(result = NEW_CHARACTER(1)); SET_STRING_ELT(result, 0, COPY_TO_USER_STRING(PG_TEXT_GET_STR(result_text))); UNPROTECT(2); return result; } /* * plr_quote_literal() - quote identifiers that are to * be used in SPI_exec query strings */ SEXP plr_quote_ident(SEXP rval) { const char *value; text *value_text; text *result_text; SEXP result; /* extract the C string */ PROTECT(rval = AS_CHARACTER(rval)); value = CHAR(STRING_ELT(rval, 0)); /* convert using the pgsql quote_literal function */ value_text = PG_STR_GET_TEXT(value); result_text = DatumGetTextP(DirectFunctionCall1(quote_ident, PointerGetDatum(value_text))); /* copy result back into an R object */ PROTECT(result = NEW_CHARACTER(1)); SET_STRING_ELT(result, 0, COPY_TO_USER_STRING(PG_TEXT_GET_STR(result_text))); UNPROTECT(2); return result; } /* * plr_SPI_exec - The builtin SPI_exec command for the R interpreter */ SEXP plr_SPI_exec(SEXP rsql) { int spi_rc = 0; char buf[64]; const char *sql; int count = 0; int ntuples; SEXP result = NULL; MemoryContext oldcontext; PREPARE_PG_TRY; /* set up error context */ PUSH_PLERRCONTEXT(rsupport_error_callback, "pg.spi.exec"); PROTECT(rsql = AS_CHARACTER(rsql)); sql = CHAR(STRING_ELT(rsql, 0)); UNPROTECT(1); if (sql == NULL) error("%s", "cannot exec empty query"); /* switch to SPI memory context */ SWITCHTO_PLR_SPI_CONTEXT(oldcontext); /* * trap elog/ereport so we can let R finish up gracefully * and generate the error once we exit the interpreter */ PG_TRY(); { /* Execute the query and handle return codes */ spi_rc = SPI_exec(sql, count); } PLR_PG_CATCH(); PLR_PG_END_TRY(); /* back to caller's memory context */ MemoryContextSwitchTo(oldcontext); switch (spi_rc) { case SPI_OK_UTILITY: snprintf(buf, sizeof(buf), "%d", 0); SPI_freetuptable(SPI_tuptable); PROTECT(result = NEW_CHARACTER(1)); SET_STRING_ELT(result, 0, COPY_TO_USER_STRING(buf)); UNPROTECT(1); break; case SPI_OK_SELINTO: case SPI_OK_INSERT: case SPI_OK_DELETE: case SPI_OK_UPDATE: #if PG_VERSION_NUM >= 90600 snprintf(buf, sizeof(buf), UINT64_FORMAT, SPI_processed); #else snprintf(buf, sizeof(buf), "%d", SPI_processed); #endif SPI_freetuptable(SPI_tuptable); PROTECT(result = NEW_CHARACTER(1)); SET_STRING_ELT(result, 0, COPY_TO_USER_STRING(buf)); UNPROTECT(1); break; case SPI_OK_SELECT: ntuples = SPI_processed; if (ntuples > 0) { result = rpgsql_get_results(ntuples, SPI_tuptable); SPI_freetuptable(SPI_tuptable); } else result = R_NilValue; break; case SPI_ERROR_ARGUMENT: error("SPI_exec() failed: SPI_ERROR_ARGUMENT"); break; case SPI_ERROR_UNCONNECTED: error("SPI_exec() failed: SPI_ERROR_UNCONNECTED"); break; case SPI_ERROR_COPY: error("SPI_exec() failed: SPI_ERROR_COPY"); break; case SPI_ERROR_CURSOR: error("SPI_exec() failed: SPI_ERROR_CURSOR"); break; case SPI_ERROR_TRANSACTION: error("SPI_exec() failed: SPI_ERROR_TRANSACTION"); break; case SPI_ERROR_OPUNKNOWN: error("SPI_exec() failed: SPI_ERROR_OPUNKNOWN"); break; default: error("SPI_exec() failed: %d", spi_rc); break; } POP_PLERRCONTEXT; return result; } static SEXP rpgsql_get_results(int ntuples, SPITupleTable *tuptable) { SEXP result; ERRORCONTEXTCALLBACK; /* set up error context */ PUSH_PLERRCONTEXT(rsupport_error_callback, "rpgsql_get_results"); if (tuptable != NULL) { HeapTuple *tuples = tuptable->vals; TupleDesc tupdesc = tuptable->tupdesc; result = pg_tuple_get_r_frame(ntuples, tuples, tupdesc); } else result = R_NilValue; POP_PLERRCONTEXT; return result; } /* * plr_SPI_prepare - The builtin SPI_prepare command for the R interpreter */ SEXP plr_SPI_prepare(SEXP rsql, SEXP rargtypes) { const char *sql; int nargs; int i; Oid *typeids = NULL; Oid *typelems = NULL; FmgrInfo *typinfuncs = NULL; void *pplan = NULL; void *saved_plan; saved_plan_desc *plan_desc; SEXP result; MemoryContext oldcontext; PREPARE_PG_TRY; /* set up error context */ PUSH_PLERRCONTEXT(rsupport_error_callback, "pg.spi.prepare"); /* switch to long lived context to create plan description */ oldcontext = MemoryContextSwitchTo(TopMemoryContext); plan_desc = (saved_plan_desc *) palloc(sizeof(saved_plan_desc)); MemoryContextSwitchTo(oldcontext); PROTECT(rsql = AS_CHARACTER(rsql)); sql = CHAR(STRING_ELT(rsql, 0)); UNPROTECT(1); if (sql == NULL) error("%s", "cannot prepare empty query"); PROTECT(rargtypes = AS_INTEGER(rargtypes)); if (!isVector(rargtypes) || !isInteger(rargtypes)) error("%s", "second parameter must be a vector of PostgreSQL datatypes"); /* deal with case of no parameters for the prepared query */ if (rargtypes == R_MissingArg || INTEGER(rargtypes)[0] == NA_INTEGER) nargs = 0; else nargs = length(rargtypes); if (nargs < 0) /* can this even happen?? */ error("%s", "second parameter must be a vector of PostgreSQL datatypes"); if (nargs > 0) { /* switch to long lived context to create plan description elements */ oldcontext = MemoryContextSwitchTo(TopMemoryContext); typeids = (Oid *) palloc(nargs * sizeof(Oid)); typelems = (Oid *) palloc(nargs * sizeof(Oid)); typinfuncs = (FmgrInfo *) palloc(nargs * sizeof(FmgrInfo)); MemoryContextSwitchTo(oldcontext); for (i = 0; i < nargs; i++) { int16 typlen; bool typbyval; char typdelim; Oid typinput, typelem; char typalign; FmgrInfo typinfunc; typeids[i] = INTEGER(rargtypes)[i]; /* switch to long lived context to create plan description elements */ oldcontext = MemoryContextSwitchTo(TopMemoryContext); get_type_io_data(typeids[i], IOFunc_input, &typlen, &typbyval, &typalign, &typdelim, &typelem, &typinput); typelems[i] = get_element_type(typeids[i]); MemoryContextSwitchTo(oldcontext); /* perm_fmgr_info already uses TopMemoryContext */ perm_fmgr_info(typinput, &typinfunc); typinfuncs[i] = typinfunc; } } else typeids = NULL; UNPROTECT(1); /* switch to SPI memory context */ SWITCHTO_PLR_SPI_CONTEXT(oldcontext); /* * trap elog/ereport so we can let R finish up gracefully * and generate the error once we exit the interpreter */ PG_TRY(); { /* Prepare plan for query */ pplan = SPI_prepare(sql, nargs, typeids); } PLR_PG_CATCH(); PLR_PG_END_TRY(); if (pplan == NULL) { char buf[128]; char *reason; switch (SPI_result) { case SPI_ERROR_ARGUMENT: reason = "SPI_ERROR_ARGUMENT"; break; case SPI_ERROR_UNCONNECTED: reason = "SPI_ERROR_UNCONNECTED"; break; case SPI_ERROR_COPY: reason = "SPI_ERROR_COPY"; break; case SPI_ERROR_CURSOR: reason = "SPI_ERROR_CURSOR"; break; case SPI_ERROR_TRANSACTION: reason = "SPI_ERROR_TRANSACTION"; break; case SPI_ERROR_OPUNKNOWN: reason = "SPI_ERROR_OPUNKNOWN"; break; default: snprintf(buf, sizeof(buf), "unknown RC %d", SPI_result); reason = buf; break; } /* internal error */ error("SPI_prepare() failed: %s", reason); } /* SPI_saveplan already uses TopMemoryContext */ saved_plan = SPI_saveplan(pplan); if (saved_plan == NULL) { char buf[128]; char *reason; switch (SPI_result) { case SPI_ERROR_ARGUMENT: reason = "SPI_ERROR_ARGUMENT"; break; case SPI_ERROR_UNCONNECTED: reason = "SPI_ERROR_UNCONNECTED"; break; default: snprintf(buf, sizeof(buf), "unknown RC %d", SPI_result); reason = buf; break; } /* internal error */ error("SPI_saveplan() failed: %s", reason); } /* back to caller's memory context */ MemoryContextSwitchTo(oldcontext); /* no longer need this */ SPI_freeplan(pplan); plan_desc->saved_plan = saved_plan; plan_desc->nargs = nargs; plan_desc->typeids = typeids; plan_desc->typelems = typelems; plan_desc->typinfuncs = typinfuncs; result = R_MakeExternalPtr(plan_desc, R_NilValue, R_NilValue); POP_PLERRCONTEXT; return result; } /* * plr_SPI_execp - The builtin SPI_execp command for the R interpreter */ SEXP plr_SPI_execp(SEXP rsaved_plan, SEXP rargvalues) { saved_plan_desc *plan_desc = (saved_plan_desc *) R_ExternalPtrAddr(rsaved_plan); void *saved_plan = plan_desc->saved_plan; int nargs = plan_desc->nargs; Oid *typeids = plan_desc->typeids; Oid *typelems = plan_desc->typelems; FmgrInfo *typinfuncs = plan_desc->typinfuncs; int i; Datum *argvalues = NULL; char *nulls = NULL; bool isnull = false; SEXP obj; int spi_rc = 0; char buf[64]; int count = 0; int ntuples; SEXP result = NULL; MemoryContext oldcontext; PREPARE_PG_TRY; /* set up error context */ PUSH_PLERRCONTEXT(rsupport_error_callback, "pg.spi.execp"); if (nargs > 0) { if (!Rf_isVectorList(rargvalues)) error("%s", "second parameter must be a list of arguments " \ "to the prepared plan"); if (length(rargvalues) != nargs) error("list of arguments (%d) is not the same length " \ "as that of the prepared plan (%d)", length(rargvalues), nargs); argvalues = (Datum *) palloc(nargs * sizeof(Datum)); nulls = (char *) palloc(nargs * sizeof(char)); } for (i = 0; i < nargs; i++) { PROTECT(obj = VECTOR_ELT(rargvalues, i)); argvalues[i] = get_datum(obj, typeids[i], typelems[i], typinfuncs[i], &isnull); if (!isnull) nulls[i] = ' '; else nulls[i] = 'n'; UNPROTECT(1); } /* switch to SPI memory context */ SWITCHTO_PLR_SPI_CONTEXT(oldcontext); /* * trap elog/ereport so we can let R finish up gracefully * and generate the error once we exit the interpreter */ PG_TRY(); { /* Execute the plan */ spi_rc = SPI_execp(saved_plan, argvalues, nulls, count); } PLR_PG_CATCH(); PLR_PG_END_TRY(); /* back to caller's memory context */ MemoryContextSwitchTo(oldcontext); /* check the result */ switch (spi_rc) { case SPI_OK_UTILITY: snprintf(buf, sizeof(buf), "%d", 0); SPI_freetuptable(SPI_tuptable); PROTECT(result = NEW_CHARACTER(1)); SET_STRING_ELT(result, 0, COPY_TO_USER_STRING(buf)); UNPROTECT(1); break; case SPI_OK_SELINTO: case SPI_OK_INSERT: case SPI_OK_DELETE: case SPI_OK_UPDATE: #if PG_VERSION_NUM >= 90600 snprintf(buf, sizeof(buf), UINT64_FORMAT, SPI_processed); #else snprintf(buf, sizeof(buf), "%d", SPI_processed); #endif SPI_freetuptable(SPI_tuptable); PROTECT(result = NEW_CHARACTER(1)); SET_STRING_ELT(result, 0, COPY_TO_USER_STRING(buf)); UNPROTECT(1); break; case SPI_OK_SELECT: ntuples = SPI_processed; if (ntuples > 0) { result = rpgsql_get_results(ntuples, SPI_tuptable); SPI_freetuptable(SPI_tuptable); } else result = R_NilValue; break; case SPI_ERROR_ARGUMENT: error("SPI_execp() failed: SPI_ERROR_ARGUMENT"); break; case SPI_ERROR_UNCONNECTED: error("SPI_execp() failed: SPI_ERROR_UNCONNECTED"); break; case SPI_ERROR_COPY: error("SPI_execp() failed: SPI_ERROR_COPY"); break; case SPI_ERROR_CURSOR: error("SPI_execp() failed: SPI_ERROR_CURSOR"); break; case SPI_ERROR_TRANSACTION: error("SPI_execp() failed: SPI_ERROR_TRANSACTION"); break; case SPI_ERROR_OPUNKNOWN: error("SPI_execp() failed: SPI_ERROR_OPUNKNOWN"); break; default: error("SPI_execp() failed: %d", spi_rc); break; } POP_PLERRCONTEXT; return result; } #if CATALOG_VERSION_NO < 201811201 /* * plr_SPI_lastoid - return the last oid. To be used after insert queries. */ SEXP plr_SPI_lastoid(void) { SEXP result; PROTECT(result = NEW_INTEGER(1)); INTEGER_DATA(result)[0] = SPI_lastoid; UNPROTECT(1); return result; } #endif /* * Takes the prepared plan rsaved_plan and creates a cursor * for it using the values specified in ragvalues. * */ SEXP plr_SPI_cursor_open(SEXP cursor_name_arg,SEXP rsaved_plan, SEXP rargvalues) { saved_plan_desc *plan_desc = (saved_plan_desc *) R_ExternalPtrAddr(rsaved_plan); void *saved_plan = plan_desc->saved_plan; int nargs = plan_desc->nargs; Oid *typeids = plan_desc->typeids; FmgrInfo *typinfuncs = plan_desc->typinfuncs; int i; Datum *argvalues = NULL; char *nulls = NULL; bool isnull = false; SEXP obj; SEXP result = NULL; MemoryContext oldcontext; char cursor_name[64]; Portal portal=NULL; PREPARE_PG_TRY; PUSH_PLERRCONTEXT(rsupport_error_callback, "pg.spi.cursor_open"); /* Divide rargvalues */ if (nargs > 0) { if (!Rf_isVectorList(rargvalues)) error("%s", "second parameter must be a list of arguments " \ "to the prepared plan"); if (length(rargvalues) != nargs) error("list of arguments (%d) is not the same length " \ "as that of the prepared plan (%d)", length(rargvalues), nargs); argvalues = (Datum *) palloc(nargs * sizeof(Datum)); nulls = (char *) palloc(nargs * sizeof(char)); } for (i = 0; i < nargs; i++) { PROTECT(obj = VECTOR_ELT(rargvalues, i)); argvalues[i] = get_scalar_datum(obj, typeids[i], typinfuncs[i], &isnull); if (!isnull) nulls[i] = ' '; else nulls[i] = 'n'; UNPROTECT(1); } strncpy(cursor_name, CHAR(STRING_ELT(cursor_name_arg,0)), 64); /* switch to SPI memory context */ SWITCHTO_PLR_SPI_CONTEXT(oldcontext); /* * trap elog/ereport so we can let R finish up gracefully * and generate the error once we exit the interpreter */ PG_TRY(); { /* Open the cursor */ portal = SPI_cursor_open(cursor_name,saved_plan, argvalues, nulls,1); } PLR_PG_CATCH(); PLR_PG_END_TRY(); /* back to caller's memory context */ MemoryContextSwitchTo(oldcontext); if(portal==NULL) error("SPI_cursor_open() failed"); else result = R_MakeExternalPtr(portal, R_NilValue, R_NilValue); POP_PLERRCONTEXT; return result; } SEXP plr_SPI_cursor_fetch(SEXP cursor_in,SEXP forward_in, SEXP rows_in) { Portal portal=NULL; int ntuples; SEXP result = NULL; MemoryContext oldcontext; int forward; int rows; PREPARE_PG_TRY; PUSH_PLERRCONTEXT(rsupport_error_callback, "pg.spi.cursor_fetch"); portal = R_ExternalPtrAddr(cursor_in); if(!IS_LOGICAL(forward_in)) { error("pg.spi.cursor_fetch arg2 must be boolean"); return result; } if(!IS_INTEGER(rows_in)) { error("pg.spi.cursor_fetch arg3 must be an integer"); return result; } forward = LOGICAL_DATA(forward_in)[0]; rows = INTEGER_DATA(rows_in)[0]; /* switch to SPI memory context */ SWITCHTO_PLR_SPI_CONTEXT(oldcontext); PG_TRY(); { /* Open the cursor */ SPI_cursor_fetch(portal,forward,rows); } PLR_PG_CATCH(); PLR_PG_END_TRY(); /* back to caller's memory context */ MemoryContextSwitchTo(oldcontext); /* check the result */ ntuples = SPI_processed; if (ntuples > 0) { result = rpgsql_get_results(ntuples, SPI_tuptable); SPI_freetuptable(SPI_tuptable); } else result = R_NilValue; POP_PLERRCONTEXT; return result; } void plr_SPI_cursor_close(SEXP cursor_in) { Portal portal=NULL; MemoryContext oldcontext; PREPARE_PG_TRY; PUSH_PLERRCONTEXT(rsupport_error_callback, "pg.spi.cursor_close"); portal = R_ExternalPtrAddr(cursor_in); /* switch to SPI memory context */ SWITCHTO_PLR_SPI_CONTEXT(oldcontext); PG_TRY(); { /* Open the cursor */ SPI_cursor_close(portal); } PLR_PG_CATCH(); PLR_PG_END_TRY(); /* back to caller's memory context */ MemoryContextSwitchTo(oldcontext); } void plr_SPI_cursor_move(SEXP cursor_in,SEXP forward_in, SEXP rows_in) { Portal portal=NULL; MemoryContext oldcontext; int forward; int rows; PREPARE_PG_TRY; PUSH_PLERRCONTEXT(rsupport_error_callback, "pg.spi.cursor_move"); portal = R_ExternalPtrAddr(cursor_in); if(!IS_LOGICAL(forward_in)) { error("pg.spi.cursor_move arg2 must be boolean"); return; } if(!IS_INTEGER(rows_in)) { error("pg.spi.cursor_move arg3 must be an integer"); return; } forward = LOGICAL(forward_in)[0]; rows = INTEGER(rows_in)[0]; /* switch to SPI memory context */ SWITCHTO_PLR_SPI_CONTEXT(oldcontext); PG_TRY(); { /* Open the cursor */ SPI_cursor_move(portal, forward, rows); } PLR_PG_CATCH(); PLR_PG_END_TRY(); /* back to caller's memory context */ MemoryContextSwitchTo(oldcontext); } void throw_r_error(const char **msg) { if (msg && *msg) last_R_error_msg = pstrdup(*msg); else last_R_error_msg = pstrdup("caught error calling R function"); } /* * error context callback to let us supply a call-stack traceback */ static void rsupport_error_callback(void *arg) { if (arg) errcontext("In R support function %s", (char *) arg); } #if PG_VERSION_NUM >= 110000 /* * plr_SPI_commit - commit transaction and start a new one. */ SEXP plr_SPI_commit(void) { SPI_commit(); SPI_start_transaction(); return NULL; } /* * plr_SPI_rollback - abort transaction and start a new one. */ SEXP plr_SPI_rollback(void) { SPI_rollback(); SPI_start_transaction(); return NULL; } #endif plr-REL8_4_5/pg_userfuncs.c000077500000000000000000000360271414122415700157150ustar00rootroot00000000000000/* * PL/R - PostgreSQL support for R as a * procedural language (PL) * * Copyright (c) 2003 by Joseph E. Conway * ALL RIGHTS RESERVED * * Joe Conway * * Based on pltcl by Jan Wieck * and inspired by REmbeddedPostgres by * Duncan Temple Lang * http://www.omegahat.org/RSPostgres/ * * License: GPL version 2 or newer. http://www.gnu.org/copyleft/gpl.html * * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * pg_userfuncs.c - User visible PostgreSQL functions */ #include "plr.h" extern MemoryContext plr_SPI_context; #ifndef WIN32 extern char **environ; #endif static ArrayType *plr_array_create(FunctionCallInfo fcinfo, int numelems, int elem_start); /*----------------------------------------------------------------------------- * plr_version : * output PL/R version string *---------------------------------------------------------------------------- */ PG_FUNCTION_INFO_V1(plr_version); Datum plr_version(PG_FUNCTION_ARGS) { PG_RETURN_TEXT_P(PG_STR_GET_TEXT(PLR_VERSION)); } /*----------------------------------------------------------------------------- * reload_modules : * interface to allow plr_modules to be reloaded on demand *---------------------------------------------------------------------------- */ PG_FUNCTION_INFO_V1(reload_plr_modules); Datum reload_plr_modules(PG_FUNCTION_ARGS) { MemoryContext plr_caller_context = CurrentMemoryContext; if (SPI_connect() != SPI_OK_CONNECT) elog(ERROR, "SPI_connect failed"); plr_SPI_context = CurrentMemoryContext; MemoryContextSwitchTo(plr_caller_context); plr_load_modules(); if (SPI_finish() != SPI_OK_FINISH) elog(ERROR, "SPI_finish failed"); PG_RETURN_TEXT_P(PG_STR_GET_TEXT("OK")); } /*----------------------------------------------------------------------------- * install_rcmd : * interface to allow user defined R functions to be called from other * R functions *---------------------------------------------------------------------------- */ PG_FUNCTION_INFO_V1(install_rcmd); Datum install_rcmd(PG_FUNCTION_ARGS) { char *cmd = PG_TEXT_GET_STR(PG_GETARG_TEXT_P(0)); load_r_cmd(cmd); PG_RETURN_TEXT_P(PG_STR_GET_TEXT("OK")); } /*----------------------------------------------------------------------------- * array : * form a one-dimensional array given starting elements * FIXME: does not handle NULL array elements * this function should be obsoleted by similar * backend functionality *---------------------------------------------------------------------------- */ PG_FUNCTION_INFO_V1(plr_array); Datum plr_array(PG_FUNCTION_ARGS) { ArrayType *result; result = plr_array_create(fcinfo, PG_NARGS(), 0); PG_RETURN_ARRAYTYPE_P(result); } /*----------------------------------------------------------------------------- * array_push : * push an element onto the end of a one-dimensional array * FIXME: does not handle NULL array elements * this function should be obsoleted by similar * backend functionality *---------------------------------------------------------------------------- */ PG_FUNCTION_INFO_V1(plr_array_push); Datum plr_array_push(PG_FUNCTION_ARGS) { ArrayType *v; Datum newelem; int *dimv, *lb, ub; ArrayType *result; int indx; Oid element_type; int16 typlen; bool typbyval; char typalign; v = PG_GETARG_ARRAYTYPE_P(0); newelem = PG_GETARG_DATUM(1); /* Sanity check: do we have a one-dimensional array */ if (ARR_NDIM(v) != 1) ereport(ERROR, (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), errmsg("input must be one-dimensional array"))); lb = ARR_LBOUND(v); dimv = ARR_DIMS(v); ub = dimv[0] + lb[0] - 1; indx = ub + 1; element_type = ARR_ELEMTYPE(v); /* Sanity check: do we have a non-zero element type */ if (element_type == 0) /* internal error */ elog(ERROR, "invalid array element type"); get_typlenbyvalalign(element_type, &typlen, &typbyval, &typalign); result = array_set(v, 1, &indx, newelem, FALSE, -1, typlen, typbyval, typalign); PG_RETURN_ARRAYTYPE_P(result); } /*----------------------------------------------------------------------------- * array_accum : * accumulator to build an array from input values -- when used in * conjunction with plr functions that accept an array, and output * a statistic, this can be used to create custom aggregates. * FIXME: does not handle NULL array elements * this function should be obsoleted by similar * backend functionality *---------------------------------------------------------------------------- */ PG_FUNCTION_INFO_V1(plr_array_accum); Datum plr_array_accum(PG_FUNCTION_ARGS) { Datum v; Datum newelem; ArrayType *result; /* return NULL if both arguments are NULL */ if (PG_ARGISNULL(0) && PG_ARGISNULL(1)) PG_RETURN_NULL(); /* create a new array from the second argument if first is NULL */ if (PG_ARGISNULL(0)) PG_RETURN_ARRAYTYPE_P(plr_array_create(fcinfo, 1, 1)); /* return the first argument if the second is NULL */ if (PG_ARGISNULL(1)) PG_RETURN_ARRAYTYPE_P(PG_GETARG_ARRAYTYPE_P_COPY(0)); v = PG_GETARG_DATUM(0); newelem = PG_GETARG_DATUM(1); result = DatumGetArrayTypeP(DirectFunctionCall2(plr_array_push, v, newelem)); PG_RETURN_ARRAYTYPE_P(result); } /* * actually does the work for array(), and array_accum() if it is given a null * input array. * * numelems and elem_start allow the function to be shared given the differing * arguments accepted by array() and array_accum(). With array(), all function * arguments are used for array construction -- therefore elem_start is 0 and * numelems is the number of function arguments. With array_accum(), we are * always initializing the array with a single element given to us as argument * number 1 (i.e. the second argument). * */ static ArrayType * plr_array_create(FunctionCallInfo fcinfo, int numelems, int elem_start) { Oid funcid = fcinfo->flinfo->fn_oid; Datum *dvalues = (Datum *) palloc(numelems * sizeof(Datum)); int16 typlen; bool typbyval; Oid typinput; Oid element_type; char typalign; int i; HeapTuple tp; Oid functypeid; Oid *funcargtypes; ArrayType *result; if (numelems == 0) ereport(ERROR, (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), errmsg("at least one value required to construct an array"))); /* * Get the type metadata for the array return type and its elements */ tp = SearchSysCache(PROCOID, ObjectIdGetDatum(funcid), 0, 0, 0); if (!HeapTupleIsValid(tp)) /* internal error */ elog(ERROR, "function OID %u does not exist", funcid); functypeid = ((Form_pg_proc) GETSTRUCT(tp))->prorettype; getTypeInputInfo(functypeid, &typinput, &element_type); get_typlenbyvalalign(element_type, &typlen, &typbyval, &typalign); funcargtypes = FUNCARGTYPES(tp); /* * the first function argument(s) may not be one of our array elements, * but the caller is responsible to ensure we get nothing but array * elements once they start coming */ for (i = elem_start; i < elem_start + numelems; i++) if (funcargtypes[i] != element_type) ereport(ERROR, (errcode(ERRCODE_INVALID_PARAMETER_VALUE), errmsg("argument %d datatype not " \ "compatible with return data type", i + 1))); ReleaseSysCache(tp); for (i = 0; i < numelems; i++) dvalues[i] = PG_GETARG_DATUM(elem_start + i); result = construct_array(dvalues, numelems, element_type, typlen, typbyval, typalign); return result; } /*----------------------------------------------------------------------------- * plr_environ : * utility function to display the environment under which the * postmaster is running. *---------------------------------------------------------------------------- */ PG_FUNCTION_INFO_V1(plr_environ); Datum plr_environ(PG_FUNCTION_ARGS) { ReturnSetInfo *rsinfo = (ReturnSetInfo *) fcinfo->resultinfo; Tuplestorestate *tupstore; HeapTuple tuple; TupleDesc tupdesc; AttInMetadata *attinmeta; MemoryContext per_query_ctx; MemoryContext oldcontext; char *var_name; char *var_val; char *values[2]; #ifndef WIN32 char **current_env; #else char *buf; LPTSTR envstr; int count = 0; int i; #endif /* check to see if caller supports us returning a tuplestore */ if (!rsinfo || !(rsinfo->allowedModes & SFRM_Materialize)) ereport(ERROR, (errcode(ERRCODE_SYNTAX_ERROR), errmsg("materialize mode required, but it is not " "allowed in this context"))); per_query_ctx = rsinfo->econtext->ecxt_per_query_memory; oldcontext = MemoryContextSwitchTo(per_query_ctx); /* get the requested return tuple description */ tupdesc = CreateTupleDescCopy(rsinfo->expectedDesc); /* * Check to make sure we have a reasonable tuple descriptor */ if (tupdesc->natts != 2 || TUPLE_DESC_ATTR(tupdesc,0)->atttypid != TEXTOID || TUPLE_DESC_ATTR(tupdesc,0)->atttypid != TEXTOID) ereport(ERROR, (errcode(ERRCODE_SYNTAX_ERROR), errmsg("query-specified return tuple and " "function return type are not compatible"))); /* OK to use it */ attinmeta = TupleDescGetAttInMetadata(tupdesc); /* let the caller know we're sending back a tuplestore */ rsinfo->returnMode = SFRM_Materialize; /* initialize our tuplestore */ tupstore = TUPLESTORE_BEGIN_HEAP; #ifndef WIN32 for (current_env = environ; current_env != NULL && *current_env != NULL; current_env++) { Size name_len; var_val = strchr(*current_env, '='); if (!var_val) continue; name_len = var_val - *current_env; var_name = (char *) palloc0(name_len + 1); memcpy(var_name, *current_env, name_len); values[0] = var_name; values[1] = var_val + 1; tuple = BuildTupleFromCStrings(attinmeta, values); tuplestore_puttuple(tupstore, tuple); pfree(var_name); } #else buf = GetEnvironmentStrings(); envstr = buf; while (true) { if (*envstr == 0) break; while (*envstr != 0) envstr++; envstr++; count++; } /* reset pointer to the environment buffer */ envstr = buf; while(*buf == '=') buf++; for (i = 0; i < count; i++) { Size name_len; var_val = strchr(buf, '='); if (!var_val) continue; name_len = var_val - buf; var_name = (char *) palloc0(name_len + 1); memcpy(var_name, buf, name_len); values[0] = var_name; values[1] = var_val + 1; tuple = BuildTupleFromCStrings(attinmeta, values); tuplestore_puttuple(tupstore, tuple); pfree(var_name); while(*buf != '\0') buf++; buf++; } FreeEnvironmentStrings(envstr); #endif /* * no longer need the tuple descriptor reference created by * TupleDescGetAttInMetadata() */ ReleaseTupleDesc(tupdesc); tuplestore_donestoring(tupstore); rsinfo->setResult = tupstore; /* * SFRM_Materialize mode expects us to return a NULL Datum. The actual * tuples are in our tuplestore and passed back through * rsinfo->setResult. rsinfo->setDesc is set to the tuple description * that we actually used to build our tuples with, so the caller can * verify we did what it was expecting. */ rsinfo->setDesc = tupdesc; MemoryContextSwitchTo(oldcontext); return (Datum) 0; } /*----------------------------------------------------------------------------- * plr_set_rhome : * utility function to set the R_HOME environment variable under * which the postmaster is running. *---------------------------------------------------------------------------- */ PG_FUNCTION_INFO_V1(plr_set_rhome); Datum plr_set_rhome(PG_FUNCTION_ARGS) { char *rhome = PG_TEXT_GET_STR(PG_GETARG_TEXT_P(0)); size_t rh_len = strlen(rhome); if (rh_len) { char *rhenv; MemoryContext oldcontext; /* Needs to live until/unless we explicitly delete it */ oldcontext = MemoryContextSwitchTo(TopMemoryContext); rhenv = palloc(8 + rh_len); MemoryContextSwitchTo(oldcontext); sprintf(rhenv, "R_HOME=%s", rhome); putenv(rhenv); } PG_RETURN_TEXT_P(PG_STR_GET_TEXT("OK")); } /*----------------------------------------------------------------------------- * plr_unset_rhome : * utility function to unset the R_HOME environment variable under * which the postmaster is running. *---------------------------------------------------------------------------- */ PG_FUNCTION_INFO_V1(plr_unset_rhome); Datum plr_unset_rhome(PG_FUNCTION_ARGS) { unsetenv("R_HOME"); PG_RETURN_TEXT_P(PG_STR_GET_TEXT("OK")); } /*----------------------------------------------------------------------------- * plr_set_display : * utility function to set the DISPLAY environment variable under * which the postmaster is running. *---------------------------------------------------------------------------- */ PG_FUNCTION_INFO_V1(plr_set_display); Datum plr_set_display(PG_FUNCTION_ARGS) { char *display = PG_TEXT_GET_STR(PG_GETARG_TEXT_P(0)); size_t d_len = strlen(display); if (d_len) { char *denv; MemoryContext oldcontext; /* Needs to live until/unless we explicitly delete it */ oldcontext = MemoryContextSwitchTo(TopMemoryContext); denv = palloc(9 + d_len); MemoryContextSwitchTo(oldcontext); sprintf(denv, "DISPLAY=%s", display); putenv(denv); } PG_RETURN_TEXT_P(PG_STR_GET_TEXT("OK")); } /*----------------------------------------------------------------------------- * plr_get_raw : * utility function to ... *---------------------------------------------------------------------------- */ extern char *last_R_error_msg; PG_FUNCTION_INFO_V1(plr_get_raw); Datum plr_get_raw(PG_FUNCTION_ARGS) { SEXP result; SEXP s, t, obj; int status; bytea *bvalue = PG_GETARG_BYTEA_P(0); int len, rsize; bytea *bresult; char *brptr; PROTECT(obj = NEW_RAW(VARSIZE(bvalue))); memcpy((char *) RAW(obj), VARDATA(bvalue), VARSIZE(bvalue)); /* * Need to construct a call to * unserialize(rval) */ PROTECT(t = s = allocList(2)); SET_TYPEOF(s, LANGSXP); SETCAR(t, install("unserialize")); t = CDR(t); SETCAR(t, obj); PROTECT(result = R_tryEval(s, R_GlobalEnv, &status)); if(status != 0) { if (last_R_error_msg) ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("R interpreter expression evaluation error"), errdetail("%s", last_R_error_msg))); else ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("R interpreter expression evaluation error"), errdetail("R expression evaluation error caught in \"unserialize\"."))); } len = LENGTH(result); rsize = VARHDRSZ + len; bresult = (bytea *) palloc(rsize); SET_VARSIZE(bresult, rsize); brptr = VARDATA(bresult); memcpy(brptr, (char *) RAW(result), rsize - VARHDRSZ); UNPROTECT(3); PG_RETURN_BYTEA_P(bresult); } plr-REL8_4_5/plr--8.3.0.18--8.4.sql000066400000000000000000000010311414122415700157000ustar00rootroot00000000000000CREATE OR REPLACE FUNCTION r_typenames() RETURNS SETOF r_typename AS ' within(data.frame( typename = ls(name = .GlobalEnv, pat = "OID"), stringsAsFactors = FALSE ), { typeoid <- sapply(typename, get) }) ' language 'plr'; CREATE FUNCTION plr_inline_handler(internal) RETURNS VOID AS 'MODULE_PATHNAME' LANGUAGE C STRICT; CREATE FUNCTION plr_validator(oid) RETURNS VOID AS 'MODULE_PATHNAME' LANGUAGE C STRICT; CREATE OR REPLACE LANGUAGE plr HANDLER plr_call_handler INLINE plr_inline_handler VALIDATOR plr_validator; plr-REL8_4_5/plr--8.4--8.4.1.sql000066400000000000000000000001241414122415700154550ustar00rootroot00000000000000-- no changes to the sql files. Changes were require due to postgres API deprecationplr-REL8_4_5/plr--8.4.1--8.4.2.sql000066400000000000000000000003521414122415700156200ustar00rootroot00000000000000-- no changes to the sql files. Changes were require due to postgres API deprecation -- complain if script is sourced in psql, rather than via ALTER EXTENSION \echo Use "ALTER EXTENSION plr UPDATE to '8.4.2'" to load this file. \quitplr-REL8_4_5/plr--8.4.2--8.4.3.sql000066400000000000000000000003521414122415700156220ustar00rootroot00000000000000-- no changes to the sql files. Changes were require due to postgres API deprecation -- complain if script is sourced in psql, rather than via ALTER EXTENSION \echo Use "ALTER EXTENSION plr UPDATE to '8.4.3'" to load this file. \quitplr-REL8_4_5/plr--8.4.3--8.4.4.sql000066400000000000000000000003521414122415700156240ustar00rootroot00000000000000-- no changes to the sql files. Changes were require due to postgres API deprecation -- complain if script is sourced in psql, rather than via ALTER EXTENSION \echo Use "ALTER EXTENSION plr UPDATE to '8.4.4'" to load this file. \quitplr-REL8_4_5/plr--8.4.4--8.4.5.sql000066400000000000000000000002661414122415700156320ustar00rootroot00000000000000-- no changes to the sql files. -- complain if script is sourced in psql, rather than via ALTER EXTENSION \echo Use "ALTER EXTENSION plr UPDATE to '8.4.5'" to load this file. \quitplr-REL8_4_5/plr--8.4.5.sql000066400000000000000000000057021414122415700151040ustar00rootroot00000000000000CREATE FUNCTION plr_call_handler() RETURNS LANGUAGE_HANDLER AS 'MODULE_PATHNAME' LANGUAGE C; CREATE FUNCTION plr_inline_handler(internal) RETURNS VOID AS 'MODULE_PATHNAME' LANGUAGE C STRICT; CREATE FUNCTION plr_validator(oid) RETURNS VOID AS 'MODULE_PATHNAME' LANGUAGE C STRICT; CREATE LANGUAGE plr HANDLER plr_call_handler INLINE plr_inline_handler VALIDATOR plr_validator; CREATE OR REPLACE FUNCTION plr_version () RETURNS text AS 'MODULE_PATHNAME','plr_version' LANGUAGE C; CREATE OR REPLACE FUNCTION reload_plr_modules () RETURNS text AS 'MODULE_PATHNAME','reload_plr_modules' LANGUAGE C; CREATE OR REPLACE FUNCTION install_rcmd (text) RETURNS text AS 'MODULE_PATHNAME','install_rcmd' LANGUAGE C STRICT; REVOKE EXECUTE ON FUNCTION install_rcmd (text) FROM PUBLIC; CREATE OR REPLACE FUNCTION plr_singleton_array (float8) RETURNS float8[] AS 'MODULE_PATHNAME','plr_array' LANGUAGE C STRICT; CREATE OR REPLACE FUNCTION plr_array_push (_float8, float8) RETURNS float8[] AS 'MODULE_PATHNAME','plr_array_push' LANGUAGE C STRICT; CREATE OR REPLACE FUNCTION plr_array_accum (_float8, float8) RETURNS float8[] AS 'MODULE_PATHNAME','plr_array_accum' LANGUAGE C; CREATE TYPE plr_environ_type AS (name text, value text); CREATE OR REPLACE FUNCTION plr_environ () RETURNS SETOF plr_environ_type AS 'MODULE_PATHNAME','plr_environ' LANGUAGE C; REVOKE EXECUTE ON FUNCTION plr_environ() FROM PUBLIC; CREATE TYPE r_typename AS (typename text, typeoid oid); CREATE OR REPLACE FUNCTION r_typenames() RETURNS SETOF r_typename AS ' within(data.frame( typename = ls(name = .GlobalEnv, pat = "OID"), stringsAsFactors = FALSE ), { typeoid <- sapply(typename, get) }) ' language 'plr'; CREATE OR REPLACE FUNCTION load_r_typenames() RETURNS text AS ' sql <- "select upper(typname::text) || ''OID'' as typename, oid from pg_catalog.pg_type where typtype = ''b'' order by typname" rs <- pg.spi.exec(sql) for(i in 1:nrow(rs)) { typobj <- rs[i,1] typval <- rs[i,2] if (substr(typobj,1,1) == "_") typobj <- paste("ARRAYOF", substr(typobj,2,nchar(typobj)), sep="") assign(typobj, typval, .GlobalEnv) } return("OK") ' language 'plr'; CREATE TYPE r_version_type AS (name text, value text); CREATE OR REPLACE FUNCTION r_version() RETURNS setof r_version_type as ' cbind(names(version),unlist(version)) ' language 'plr'; CREATE OR REPLACE FUNCTION plr_set_rhome (text) RETURNS text AS 'MODULE_PATHNAME','plr_set_rhome' LANGUAGE C STRICT; REVOKE EXECUTE ON FUNCTION plr_set_rhome (text) FROM PUBLIC; CREATE OR REPLACE FUNCTION plr_unset_rhome () RETURNS text AS 'MODULE_PATHNAME','plr_unset_rhome' LANGUAGE C; REVOKE EXECUTE ON FUNCTION plr_unset_rhome () FROM PUBLIC; CREATE OR REPLACE FUNCTION plr_set_display (text) RETURNS text AS 'MODULE_PATHNAME','plr_set_display' LANGUAGE C STRICT; REVOKE EXECUTE ON FUNCTION plr_set_display (text) FROM PUBLIC; CREATE OR REPLACE FUNCTION plr_get_raw (bytea) RETURNS bytea AS 'MODULE_PATHNAME','plr_get_raw' LANGUAGE C STRICT; plr-REL8_4_5/plr--unpackaged--8.4.5.sql000066400000000000000000000021721414122415700172570ustar00rootroot00000000000000/* plr/plr--unpackaged--8.4.sql */ ALTER EXTENSION plr ADD type plr_environ_type; ALTER EXTENSION plr ADD type r_typename; ALTER EXTENSION plr ADD type r_version_type; ALTER EXTENSION plr ADD function plr_call_handler(); ALTER EXTENSION plr ADD function plr_inline_handler(internal); ALTER EXTENSION plr ADD function plr_validator(oid); ALTER EXTENSION plr ADD function plr_version(); ALTER EXTENSION plr ADD function reload_plr_modules(); ALTER EXTENSION plr ADD function install_rcmd(text); ALTER EXTENSION plr ADD function plr_singleton_array (float8); ALTER EXTENSION plr ADD function plr_array_push (_float8, float8); ALTER EXTENSION plr ADD function plr_array_accum (_float8, float8); ALTER EXTENSION plr ADD function plr_environ (); ALTER EXTENSION plr ADD function r_typenames(); ALTER EXTENSION plr ADD function load_r_typenames(); ALTER EXTENSION plr ADD function r_version(); ALTER EXTENSION plr ADD function plr_set_rhome (text); ALTER EXTENSION plr ADD function plr_unset_rhome (); ALTER EXTENSION plr ADD function plr_set_display (text); ALTER EXTENSION plr ADD function plr_get_raw (bytea); ALTER EXTENSION plr ADD LANGUAGE plr;plr-REL8_4_5/plr-US.pdf000066400000000000000000005066711414122415700146670ustar00rootroot00000000000000%PDF-1.5 % 5 0 obj << /Length 146 /Filter /FlateDecode >> stream x=1 0 I_^m]-H"q BKT8!B[ʽ+#@[ ;lt]5p}W"މ(C*c-$!iOys'0TE4οbҠR-R* endstream endobj 14 0 obj << /Length 190 /Filter /FlateDecode >> stream xM1@ w~E7^VbIhbĀK{M/Ea k Әb07`K8< vRIľuL(ZΛV:eI(+s/+UWHjNvxO#b~}sJHfG"1mݺeY?~я_]YW@@ endstream endobj 49 0 obj << /Length 776 /Filter /FlateDecode >> stream xKo@}~,Žg|_EiZVi&]D] XI_6K hMLx!›\ NNʶ|/^ )۱X^hzؓ=SQ׋"*{?ÞWDV+9XT!CY)m|~Xϖ?qk*LpEJ<;{maJr\UJՄyY,UZ]I# N&hW竵d>mr㢐/b6&eI[]շ^ b]:OZT)\fPgifzo=.fhni1v7[u ! Ӿ6Zb)NJnT&r[eu|`@Y ;sе ӵC `}6qQ* pW~-l)g]{f3}A|\,=C\o[Wvi =^/<͎JϪŒll7I|Iɠ,Mx֜]n(Fx^s(;H.8teܙ8ǨHt6:ںҶRteh ZE4Mn~78 endstream endobj 71 0 obj << /Length 1205 /Filter /FlateDecode >> stream xmVK6 W(IJH{kv2Mַ4Ze2JzWv"Ǐ U/w2̂!(DT$"($I[N,PD4~~EW" /[TQETJldNW Ќ8PѲU&ykLXl;ɵ=#-8܏˗O:Lvs!L=;X22I`%eɶ:m-,c"b2H G' FYUD>2 *hNP hn{G@.HڳZt%ړbVρGŖ>8ndQ2fdET% ? ,T+rHEͰZe:!]]q$SrjF^_4&fᓅk a}L)ll4=Ȱګ_mñ.3DKSûMN#BP(Cvl$A:T׀/{ s$p2Hm5XŒ'd2Qbܑ#+BDHx@bWZL<_|muC;@vc?u IG|><G5.W<9"Z-VQ\$3Nhf6Ǝ &ɺN?`N!ZOw(L9'hvW- qQNs-1lb\wX.:h]V[έf˦[2h]0 aƕ 4{:8ZX3x1]G=kuG!"ZPI0KGMoy6 :eyQL ,N t{3A~XgYxFq?TtI[4  ͌;4r5`‡43/4#ѻ=OnOZr aY+/o0,׳}ͷvVq _C|ֳ 8h@*<"Ma삗՗j񸱿*򒯉|YG?meñ ?ѵFQn<>44, b߯e? 9 endstream endobj 83 0 obj << /Length 1332 /Filter /FlateDecode >> stream xڝWo6V")+bY+!eVq3 wǣl9Un_x׏^qq~侒Lrq0f`'f|9zI.olGF%}VmeY’PhǏX,̑ 3vޮlҺW=i#!*5:ELE\ݺ/yGFQiUd1-މW,m 86-}ՁKD%>BA篢s\H/-k[*]r:M'n0XMk,jl[kw.=bC|C+8+XCjU{ kȹ8y.ܹpMY,lfM*>lhӧMȿ)(wkea`!QH{&HA{v g8uNpɍ^` ^1"惭vC3&:T ]C<&DhJI`#kǖ`Q](;Zg(%}H .C ߤ= EުayWvcPvA־]pu4 bn+,BA}v=-s]YѕWTY/<"J g} vY]5g0J pxl^gȴ`?uq5$I.=%i˳׿^ѬHRmi> stream xڥW[o6~ϯCCDK>xqcEWe})R`b^txH{̛9Z:KPls7 %>EG1glsCSUaeɚBT7GCɏ\crf d$Ȳo*[j,[YW5`8XR綟yX:?*Uja7DfЕ)pD=7H?\P X[Xqɢ¢/㲨y v꿪K( qDmuCg.6A/w} Jm*TAQvՈA^DZ1;  ($ ʜlm*SKl{ƞ @@M .\B8M!9Gdm#@&l @4|擀p)K 0vF&vOc+SBB 6QOCIm2a@h R'^Qb"tвCN6Bf]c 8t%ʾl|N<;ST%Uw*gf%BsZ&5Tu5> stream x}TK0+r!<jmŖ֭VlxUOghb4EThdu&iJdѢ~Ɵ>g#U[t]ɯŷI'w_AƲOYQT8+\{Ӌ)pӥm0=9%) xܩ圴uhRL2nyD us) D*Nة$goSìfҾKm08I&by!-i` z#96PD08MY)dDդk5I ^:'m%)Yf*cp=qiV[z72~;Y%DCXzCF!`@R84KB۸ :{jLD e=EJ@κ(CJϵV7HTr&j1D\9KsP~5M D4.=Y'w\3;ͱReif׬,M.8re+=eK߉CToΏNg[zMzܪՖdn=}(gI <L+hM/e@TEV4(W^{cXѠ{yCU3ʆȇɜ:z> +/;P:~RK|1_ Tx(&z-=0c8KS:<>$.ų|:t6珣QE:[[C%JZ]W_է9X+W!?oЛm endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 805 /Length 1834 /Filter /FlateDecode >> stream xZnG}WcA=]]@օ@] ~:@ dH>f,(2$΅5O ]$quH+I8 %'v`'GR\J+ZHS#vRTG >\"hP) hGe34P )%)L3S &8 có|§v׿y$艇ozC%#:X}lB}E|fz)vb>oۛw坻JG'Y,sCk#yE0׸SH~;R;4]Y5>H1;pwg;tp w(CJPb;ء%v(Ct(ҡH"t(ҡHHQ3zV9m0qߡSP|z[=Ah3*TY_(lwOdzNúI>@(ߞHRWl<׊$F&x:݁"+"$ߚHd%B})F"';cEՈWL6C-e#b-V$z-)^ H2&m`p"v2x5J^} ClmVHȜ9u痧ˋbg鳢GNXx;*>*V 5y N={<Ԗyv@9/.Njb֋wf eOXq'ZFj?;N{R\$+\-Ɠx2^L^}1,~m'ƫC/o$Y ^h2!0ۮd.^Ow9+24 s &6[m,Pu||vz>ܓ^Z>ψȫ9#iVl^9l̎00J`잞Ϗw ˊH/+)CZ9Q_ŦBŗlP)=ޠemo/>4e ~ZMfHVSc3J'`/i)F%'⭶V22! mg[":mB,lf6'NѯC%>B/ƒc)m;yS CLyih;YB Un%Le ALI1YyAD)dJ ^ 2ƚ Pfi)a[\/ [2AE ղ6יHLM ^B%A34mmfF'q{y:ĸЄU g+}] ̫,2 aQЕm7p&rE|pA㌢H0V!a$" گOcXA+TmjT<DP1F)ͧv|^S֚%H~ZZӽ_|btӬ/: endstream endobj 139 0 obj << /Length 1769 /Filter /FlateDecode >> stream xڥXo6޿ DlD=u&A #ɎY2hb ߾#zrӢtGAxl&trՋW\L8%dxx6x&v'h:}*.sM{^gaY"$Ŕ kSo*V`2xl22VSZtn;b%~Ɣ⸕d8Z=۫WKRmjg֥(̪CYD8`}V'#}?Ԫ+d!oc[qyda\"*V9$<ܱdY&Lm ˬb!q6a\G.pBmJtRj6oc#Tfa8P <#q!3O"bb{81Z.RTo?KJ]X%^7F"N4bsH7)<[Pf >]]\]' %LC_FCZ\_[\?٥ɯ#y'mPA'ol徃囊TD/ beݥ{%qh֠Gb˰Hv"yg8MS2Mhv +|~8eʅ%OZ(kGHK],-yJSղChWʄBRSt*G_1r >w cf:ƢwLRbZvLcyd e[ej@@}Zr?uEiݔX$!UԅFJkSk/*J eizɠ0{5?R;G/#FuPm?v+>o G  gbŠ T$ΌO-3`5n|8-SلK=C㈅jyy:^C*YT4 n̹ yl "AA)ROzb+(s4 *5sꆊ1aR k {Ư4k3e8_s/@ z%rPVJ[V~LtJ԰Tѓi> stream xڭXo7B(Z$f}ι0@^_qhjEYۓv} ߐ3܇e8o(g0q&_M^rI@d7qc8`/&v^jUw.UuVNe9fL~~吵7WD`*𴩅z <;zr ~+7"pPO%\wA3__N1=*U,@qIO5Geoh1 x`tPFT;ITUi]"ei6e GԲ x1) ne-) ’9\x1 }N keݷ+41U:,:YpMVT8g~h!}%+ճLjh7$a®G:4qD*mmQ[G{%-8ϔ5~ˆX/d> ׋)y =_ x[?8xrʹ@xP*12Txd!IC]ͱ,Ts2fam&O@0R<1[gY_m>u5P ]Q} mk%s|'/j]ѷuL(~*5vY:AP!BcP"zUJص]?~VNMl_ldenL(8ɮRu;vU\T(H$bya{n:]X<ޏ|@&rG08vMGemznsQv15-iֻȣ7`MOԜ*I`ڒҥ(,InHM#?d:SdSl:qhy%c w5-b *9A!B8p#RȄ+~DY}X@:NMÏ:QïOOHHxdXU`>gPhqWb 6jT $ҷѻuZ~RM[2e` 7UFyXBfy/lb9XZ7"$.+Pyx*~u*rG=D?f^@3vbv:mɍFIq9*źK&ـ A%0ߡbhJQʠI4Us:E}(e^"bh_GiE|1ԤTĩ_Ǻ5ȟEtRP7CYMCtѩ6W?{B?o5CbAp5H38jqHO{PA$ҬM+gOmlbzMvX[m6Lz50fyӦ2CFL@1tR\ l~FYSm+_ A SMx#T -DA} r\sgoQ1^]^%g.}ysy׹ss.Ȥi;sVo/Z4Y+߼Zq%#_7Uyٶ3 <(l-] p_cNt0/F;sl}ݦ(9:ƅNϛ@omLxŎef endstream endobj 189 0 obj << /Length 1333 /Filter /FlateDecode >> stream xڭWKs6Wp|Ԋ0x$O2ʩd`8H R"e9ɡ:ž:r˳˹[1X˕qd`/ej1]-|g2m4YY8EĴhnU?ov9Ӯl:, <;zήc;pQ!jdYU;Q ߐ+Y6,C4 ס9#oTg{;6LroKpc#l-U V/ELU~M2@r.^)|1ǨܨJafy]"U]Y58YTJ5mUdŚqHFNuut0A!(;b6]p+ wkb]/lPfc'|HLi$Y(cC'P@_]K,'=>_Re.*~0KVP?d ñ\A܃5Z2= VpBiĆN^$B@ӻ*..^̓U ꢟ4 {U}>lewbt:)/?=x@`Fc09 ,}1=ڧnj?DS"N)di=}O=j̣*mɺ|YLN9c.Ut. 1љ<>R6;H(KBxHX{@ /z3N8s9yDU/Te$: <`=z"I#9"Sp@V`~̢ٮ+a8N3BU"[}\'D#`fZPǮM]Uʜs8 gy?*,]MX@_8H=3QwoٮDl0Om觙(m:[oMS d9od9DViٚio-Q[v)u _RǢ,h̖grg endstream endobj 202 0 obj << /Length 2565 /Filter /FlateDecode >> stream x[o_A'f?"\PgrYPJR;HiEY&rf7_;C tEoWU) Uۇ b$, \}qSu9_(I빠#NOG(j! <4 dDb΂%OcpKYZY<{ܭ639W]QĶ뢪K_vEx~WQ4l\;蝈]U]M<-ݮ#*@:pƂoڌ^jʽT(eUYf3ReY۲XBB kktT< y r 4ɞ>-$H-cik}p]:[Gi#QG} 9/ˆJfZh:n-H0iц]u}T O^aA#4L|R5t$ gS800mQe^;4*PA]D -Ld 5{LGlgP(b waļ aG)XCLW р%DR$b,X>~=<]$,5 >\ J2"ap4qPH Bص1Bb3:$D!8`# qW"&IG#@ZI*KѥHJa({J/"wи+\O[v9cn@s`4TTX"V4!VLAI *9#%@.Z5I7 0 o@xFp1g #KL1pLa2 F-x#xȋGgxunj : -u€.fA>HBH%b]|ZK<G%x6E^eJjFiJHzJtUY{44#z9Jbݨ)b9TP {R׻r^Dt}ihu߿6i:쾿7MMq߮Pui3NNCgsw9=l½,:6oU3)NQ0wgmqid_pxc{;{2]N=gݾ30ot\z*>o&a ط{.lqo覱#r$DDp)\ $4Q@@,$"sضT#&\$R9ĊA$v1=ͮ%B>>mm%=s9gBd)%blCi 77<ÐaNg#pɷqpg; `xMgQAόgª n rpsa,87M9$}m 2p1{Oy zgx`-q 0T龨PBc):n_^v z[dsFOY;G︻Zryh>JMx !b T*uqRB2i6dXFl͟з+եY,/>?{d7Q26t!0ޟVVz)~a#_&4jRA4f髉ACr>X |4A໡<Q$EgcӬLagMjoqğzD 7x0MO{/䲐 "^pw[!h"0!'` |O.#{m<֝Y|.y{\ʿ/|!x{9*%.0)A 0> H$n~E. 4+ endstream endobj 215 0 obj << /Length 943 /Filter /FlateDecode >> stream xX]o0}W$=n&M{X;nM[$>$];!nb@B(ĝ&luϽ';a0nyQ(ӠH)w* r}<ib]IgY7_HϾ8d潟0p2 *D0R M;???FZ:% p>!:(N jj ZbTAN LQ#ݷ/H,-Ҋ-^$fcd`[\5 @.0b t=*^C4R`qVvs2}TVl5m1PKK DɉE P;F*,K~ aEo;n34.|IWm}v{`?*'Nxg~*CeTau- WB5oF?F/c(LuJ-PiFrʴ>)Wʳ;OhɄ|W3{F_VRgz]&]Igj^'3G5NmlutT̳GdC"0Y^x}eSO+̼h>yC6f`jeV?~G$Lk1-MmƝ(y( -{,;vx;c;> stream xڭ]F=“3g;i{IL;)d`mb rWZ KiJZ%{̛~ͣ'D8pbߍ{+hIg2/DrBuV|2''i/ w=[HD(v+b YUyP&;(=_w2_d|n69$^΅QD k|HӰ5"){9zcken*lnDId#DM 5]]OKGe =4ElU CNvsZӡs p^B^gyf ߤV0ö)Ewݛ'S|2wUS 3M،ٔ,a!{EHp]::e`lؓƠ QYҹɟ9U jF4!1§W+ ^ > W9`3hqO67KYg:W,P$QZgc9K`%mvfJ:ӆ۲f{5C*1䭝rK_rW! 3ܙEl]"yr5psPҧs UdGulYh=$w`ڹ\uj,ZA{CC߄]K}c˃C4․h=El(%p_aNd99ᡆSӡLpI =Iߊ |bò\ji`>U=U*Jmvd }]!\2sy,L7ZR,峑mhj˗@=rfXۂbLb[\1BXCY3\Pg/n d\i{:ѬT3|mL&/8IE.x@5Q*i?H&7z AZ ʹo= BZ1D#CU`A`6VUwsݔ!76(>b 9ErV|Te]}xlJm~ SvrfEAfaڝ%pMyy{tCJxANl"6sð'\mk||"@ev૗o.x1Xz9(b׏SXe{ ~0*uw4ud]vEfѿ6 endstream endobj 238 0 obj << /Length 748 /Filter /FlateDecode >> stream xW[o0~ϯ@}I5/ؐ}:Rm6iO4QP$ 8m}Hy4 1" ZxN53/,1`3![mp/x>b )Pu^$M@o>6\٥)v@+;6Ur.yR )3"Ǔ)0 hD\R*iae\9OP\,PYGPע%B TN?+FQxNig'T"J`9T,(/QZH@! " !ekDK/vs^)/n1DVdh3^('3NI3mR 5l@dD4\^y:S1Xo ymvQOxX[鞪?͵ȳ;'}X?~ߟ{'rL7F2ې3,;Uz6myw:k%v4tidiwmӠyռxؘ?_ZBws.bǢ{t34=]e!kK8NUkZŌ K%a"l m[ c2]ϓM#>̖&rF&[ۊF;ʸFp]zP8o*QVEkcS~qR?m8'Ѻe$=ެq ktnrUf6Mn endstream endobj 136 0 obj << /Type /ObjStm /N 100 /First 873 /Length 1700 /Filter /FlateDecode >> stream xڭXMo7Wp8N ؎!H[#4U8Y;-۷|$HER#[`\r&9/eNI'ũ] _u).T:, e Zɕ ʮRįuBqv:B|B2- )Ra6 ltl^v):ɫJUAlbUM͵B<{6gHxnǒKv,.z`˫CfwCp r +ήw麳Cם/޸9{1^&^t~o,>|||]ZJcR}{w {iSn>)y6/=Vw뇴%zSij&TX8O)-j ^cM^b5 x q[Jc`DcfSJ>1>"m2f7Emo*BFlp V (@lr^FFj9'GX Xh>l_vd7|XEb88BW@>5nd+A6ȕVA EWbcCd*k!2Gnj ˾2M?}>_鯏?^3/?,OoQ %GB~ vGe[oW9;M~3=8}1 4)7U(<yxgNm 52rUشEFQ"kJ*{AA2;E`EOiBP FM G(rV hM.^S!x0ܳp}B[D=Q35aYYnVЏؘS˲sYV˲2UЬEi~܄EsKiEPr{[ģ1v>FBZkyjG W1?ۉ[+y Jmj_i+4?{5??~vLluKF ڨ`|:{98>ONqok#-= g4z!M=V$ QFJT2ve6 fh5*n(mv8AS@ kS5^kveIj4}WYU>FIPƠ2?;ggg15Ln#倠[%&sFM&czrt4$(جrP#ꢈ69y}pqrQPXQ،Z~@]F4;(!J~8F(~:66CA,t@(NUYD(Ų VIN,kG- Y+F endstream endobj 243 0 obj << /Length 126 /Filter /FlateDecode >> stream x3PHW0Ppr w36UԳ432SIS0143T076ҳ05RIQpH,(I-5250ՃСřy{N~RbXeF+*Ymmh5 |# endstream endobj 247 0 obj << /Length 2264 /Filter /FlateDecode >> stream xڭ]s}n&vpERvfe]C2mk*K>6)Kv )A,`ӛټyAX1g8Lh-ϭW"NnV7n4 uɗ|pYlW K+6 HHYc)戻r_Eje7kGWW$y'˶rh/6[}w9UW ڽjﷱ4;Ufv]mmc^zEpR`UT $*mjS9*D\{ huĸ}Ut1BH@Q8ԯ =֜sfM6c(J@tKkIdG] =*1 TKS3̞"fQ({r>Pd0Y*%oW\-Mֵ`'D8嗿CNծpdqhhǍ1uJEP^hqӌ,EqV:om z*SX_Z6M%*oG˲;muh\OˑZon@DBz",ϛJD[~=, #OwJ)2QĄ'wխ9mp UA=AH3kk"o_ֳf]|f4A[ YŇ,scM]w=9pTPD;*) \uxdѝʆPz.tF=%}Ol_cG;^dy0p/•!pt3@g.g%eBJ\BF 9KYpLgH[H50Oc&p/g{zͪ7v2XuRO`ܯx9j/9Rux$eK_(.g 3 ȸ Ƶ$BM0$ZDϬ+sSfƭpE޲Q],X(aڙ&rk\qI,2Ncw23Ak`3#5 0Ŏ>1R;M.[ =_]] Nf®k0 ~%f!#<Ɓt Lز"ft0VF9d^K\6nBVL>~οO~͵"&v4i:>P&*lfjm"YrЉ-K<ZTOW$B a%RV4{ zbڕ|0a4ؔ 8ˎc_=TM{--hT=Ic3Q뚃n5.R!^a2IY ϭO?䤯 5WsIAҎP)S:E"XNzT$PFya|i+mYXҌ` M 4;;H ʓ=vcԏX lkhgyinG_¤5jYWצti#:Trx$/OMTV<v"s%R9솀1ώ4"&6%bg N8HWIT3Eꐹ)G19^)i7.rI*5EcۖS]'m>j mE W39Y-5/mU4s%g Ed7?X.YxTxPqZsqߏ$UÃWF,h; uO|liD >uMKd􀑾~Ma9'lQj@2sW|_l6JLI9[yvXY`tF_8)t:өm8BQ!vD}B>;kdGjjJ8 l"dSQmPxT4'm@T{5%##.Xn:Â>Z&gf?}[8ě]TzX?: ` ˅=C=ƓG7Jig3K=ރVpQG936$g$G$a kȑ)%7z endstream endobj 286 0 obj << /Length 1586 /Filter /FlateDecode >> stream xڝX[o6~ϯ0qE{p$&Cu+"PlH$%NHEQƏj:XthDDt1.A 8 }>_oVt(y*yf:fqUyYU6<Mأւ'^z~"FF#> Jjb$4eP,QWSc؁ODB~`x75٨C' hߦ@Kxn4+Bʗ'<Ldsq UĨO*@á9as?=WWV&L4TsR5ħi~f}{a\&UWG,  Hѿ^DUgN?0J_{7$ao= 'sjXQ獏>N''oA4ʀrBoOz܃'B8>/.Ɵ pp;84 =bkdM|I]kj߳'0#BmőU<_lF.;;̅4h7/\7 tFc~%n*xX6T$ )aU te?reNŒTEB qCF( 2cw >&*v HW*`j5Ӵj]&PI|Xp5ڮլpX.AmC>pM B/w )hP.򲩒?oT9p j,X K0W.`&0 &зn7 5vԆJAHl kUd]\iC./ݹI67JPГ-nE njGU\]V!  M.#2pa, w!FPNa.m螚4$[$MOʸV,`96 pRNi7hSk3c>R8b 慄RE}._-XFڟ]fk[0>uS 0gv옡 s W'ˉɵjh۝v* #[{׀rhbZ6ڢڀ/߽XT9r/-EZ9|{h&v^3CƸpGQ[9f?E:i~g{x ;aMisᲕY^Ο`;Q1 e㸨pm~g;?E ^Hr¤5y= endstream endobj 316 0 obj << /Length 666 /Filter /FlateDecode >> stream xW[O0}ﯰx l8vc'= 4ַ1!RI, &BA-<4~z"0|}NH rSL`I 9`,`0w\qiڋqv)tKڭy9t_3)+edVfRzG N lxگI@c>LQk1af~h.蜏TuSvBɅ@1YXmA -hKq]Tㅜ!-Muz%LSE04 bch: WpWO|Z jR6s9;ik!=2rɩ>uoI6'_YOJ(':Ǹyg73CeU-XH.]>VҲrd3R+0ἨpEن{%7p?̼-k+%}],LX:Gd5^ /Mttg${Nw:yO#[쿊\+l{ 2 i QX|=S endstream endobj 321 0 obj << /Length 2145 /Filter /FlateDecode >> stream xYKsϯm!w%Ɍr٩5lEQӍnP$M?6lr؍~}݀]ݟ>\x"Iz<)T,"O8Pvw>=^T:inFc馡qZnipU+6f_߹|*_D(QE$WW̺^عlYZn4Ǵi4Rޗ|>vipE Ce$Tp,'=٥E{ ՋD'țvyV;+u%Gk>]=W9Ɓ{MK j?E}i={GhWCҚ%4G忸۳K8*&;stvQ;DI)~T` P" $.o_Ϲ3̜an+ߛf]Tmu o0B7pݔ:0S Ev2=W՚T x"KȍUBUy9nl^ooEZү>tShxx\Y •F?$I ";}brGO'R4# "he9wZbf`3C,o˳duULUw?&jh z#U;؂hE?Jq!! >V]S<#dn,?K8cȥC8ČGX)7!/RXF2V<׵nZ ]gAime9Yn!@àA{ b7#1ϜU//7¦ u)+d_+9y1lfyݬ~#yu e=(kn=v>2+`pހOHH뵉Wk puB_3mOt9A.Bް> Kucd h`qB78%HaP3L[yNaY =.AyB5l br) GQSE2W74e 8q`ifzC8q؇z'Ab/3Yrw*boF ć$^ d8|_&w endstream endobj 240 0 obj << /Type /ObjStm /N 100 /First 876 /Length 1363 /Filter /FlateDecode >> stream xڭn7 )EJ#6Ȯ@f6"H/A\$}?N]j{;Ι3$EU{*ZM>XQJqny61׎DSPVS7&͒qm}piTii _~'ȡvaLPwM"4֐t'QAME!*VЀba(0aC?CACCp2Jٜ#րyr$SCD\\es%4,/gT[qVVm 3b`ܴ$)u ZzҲiPYH|Z1{%D;YH'?qqד !!(j *TTGH4Eo!06;*grPVgP'PIl,pJja1B;IoVMf(΢v5]ױjZ f yrl9pvv88p^bSRQ!n=;_~<"IǗ_ӗہGANf.&@/?<)/$ǡboevGї7%;A2r{%T{ oo3Gx-aUrð{X;BL.Ƀþ|:,ydϻҢlc mUtת{IZKVZ&e6‚\L;1Jark^&Q\CȪfϵ-!3۽SѴEU׎4}H~2d-%wr9TV6]s>"k+66f [H{XLBM‡8hs} Ep['guo1yUu1twѤM跊іu^tH%^Z<]>]5XpA`љ _< Ư> stream xYKs6W(0 ?2dZGQOm' 2iG .D2[3$<׷X(Mۓ7M24̗BBl0J҈NhZOiLcW a$~si *pkZ8Tޖ29 7<>9 C 87w2H$$ Fg3`G -rTOn dA\^Ǖ%$yg$ (6h$O!J8}B++sNX !s*\JYMڴwZ~#kt+쯿]^$hC10 7$׳o3A4#lKT&>#$N;MTF͵(4P.ZOt{/ݦ< ӰMmM)%1 pg`Ksptar Zl/$Nk\lZ(#@ʂx pm,Wui,XIcBy!10t6McM ʳ @ft1JH%!q3d{.`Ny0}Аzpjueuխ#kk4Ht { )!VM%-}TTqu[?Lo05Ջr)'RZ;h#zso(]@M`k#BP2A~mxП?sFuSd|bqY+%s_D$䘒 (۵X{ڶb_:IG/݈8Vsk1.bY,!@[9hT.`r\}98kU}QNFc UC'0wYæΧp=Q]_KW| :lQ6gu>3~Mk.VI׏JJIģ'eBW0 ^L x [ <Oz1E%@%Wé'&}]&?xA~ ^9pfjQA;''<ʹHCd ZFۇ n!TիRAi]lK\JnƲ,A֍' ˾ mn30޽+lSR_(gW Np.ͭvqȷ07DaA}>řO]> stream xڭ]TGϯ?/XHdbH"^,:AW0>OuT``9볫jY*ZKUiHRu&J>T|V%s\|j1m8ngy% K],kV-yoi)||"N]$RXo ҡI`el[z7N8z4CJ+0BB s7_O2a:ʋ 'vM'YU \ۥ<,WM*Ʈe<"[TGIDaG &(0wu0}8!c3eY|;M`b8I64R}Q hlju3V|)PMw>qLnvsG"o{Lǀ݊ pGTW̭+nf#FuUWi (nƪٞ mOkl77izAHo{ M{^h۷'O ^5# CM[&cؒɜ& kň+BHŰr’׹>!(q^ Րwjhع7/Rl 7ĘkRI1D\-eA'(F鋛*Hɔ{5 6.c*X.ADXY GYJc1˨Y]K)bz_ Wlr&E)A} |{!ܤ-W)̾!5ShMg_r~H/tzqP3㼝~T۷_}i<.|~ݏKnKy̕+{RwApJSHod&2s-zX-&6($7%Hՠ_BvNny ,Vvny`k-y{\70t-=!E Qq?O#pcuV6l5=fe{ i.b!) %]/+}kdc֐wΘ^̝} IICh|YVƤ D_Y8 lA0Un!1(=D"7f'f|<'P%.BLaPQ !Dj2ԓ1nFͧQ/qOh$UOCF æ?& endstream endobj 482 0 obj << /Length 1667 /Filter /FlateDecode >> stream xڽXmo6_!l6KJ^OYt4s\C[DdK`%˚X!wPνÝqͥ+@FYmPN=zʜmrhT5[a4 |>-Rw^=JiCv6ygV؉YCY14V[%nʢ(g>{n쳚fIe }Ahˆ~=ﭪrUw%y6tss{N>zQBZQU pKhdD%‹+=g!B{.!~C<֧} 95Zȯ.z+?MflD!)uźJwŇ d`9c1K4F3.:r\@ +^vٕ9 s&=ny"]I"U*U#唑Nis>h`"mMiVc][;ꫯREdkL]d3 8.ѐJo/ TB%`S;a̞z |Pvp(ϱepސˀč/ij? ! 31i&0& T n%TXE+Y$$lsf[[1I][/چJvZB@A2 Nln޾?{k,Oh磝yTCw}ݴ]ڜ;'[x⡬lr<)4il凎d1SkkaOAh a!t'mo! |-jtC THw\ϑϤЮE,1BWUj#뢬S'%=CuƵ n nw9 '\'^Ѡy%WO;\]CNb(Z,֡^7 H.vN1Vi>J='C>^ +"9/*.N:]sBxawqxGw{6B4z;=7ce휔d34x^6L󙕏Om%}M7&nJqd[>H e;3ڱ> stream xڽXYoF~CI}O# ەeER$ÎwfgH:APpvvV`3W'o'g=`'|!<6JO [ҢcɇoPeYUI18wٳKKDZa[h σEZU;Tpvi-_=SH28 JGr-l΂Erĕ1lBwÓ=kǦi il&Sɤ1@nv: A\7Mޱ\B1Q dž=zffU%t w_鞫 o/{ _bқh#FP4wVGrB*1 92az#Cڀ_ӤL*NLB}p-G$H|Ad-|hbd M3ސJ0 Ff*|Z[BM1B5+`ˆ&ҹ,<Ɨd±1T\18iEr4vmVQs"ِξޫɳZ VPB*Ȃe,i{5<bB:SMà H|d!z9Q"~¢){׉%*uV0+` '̈ҢY_ Χʯ_{"85k8\ff4Φ7L|_0pE@&iS#1pl7g{A1YbK-(?ӛ۫+vx12>"]@YAa8X8XH-T!kYAX;Tũl_=?y|\UA ?Ĵ JdnOd}ѱ:=ΕnT[US#B%*fє۩ZUEm!یT\M +rI$#*;:lzp/%nu}8B.8$bEEv5#,ESo&['#s|&NA$"I\koG.eR.`XMfDS&aľ,^ԍqCݞ+GE&OQ&?5զx4MhME#T* 1X|F-QM/(IFW WUy`G"IE i>eG9/˱ YBsCw}j\tL"`V> T qT1UEm#Q#t =-S&\=x0k:k㛛L!EHW໯x6*Fk3=aiP7׌nuy:uh 9Ob".FuǬFcadP׭1=ɰ`h#҄~*ҌD+Y$SS Ʋ X:KS: k y ꥂ!/2S[Eq-2@hUDY2C,> stream xڭX]O7}_tIDDj@*jĭ3 KIX+܇}όU!Tf^YNiw{OrjAkLw~ ]WPMm70|jg6oחb|zFSǍzo<2ʚ`T *iږ蝄`s OG;/V;V=>WPdJq<܁,b0j,V 'K"Εb5)*} l:T=5d2sX`/}ؤaSs7T֣T1-B'hޜb[B$-LAF[N1--|ug+Z>,CYǂ:]|"t~}94w_N@EG= #Bq£=`ϩӓ/ ҂Z%p9>yutk8ɣS݁.ȣrʸH)U7 , [Fx[g( Ɩݤ5pq.|0v`k[·Qj]PItXv&ǂg.П~y// endstream endobj 572 0 obj << /Length 1138 /Filter /FlateDecode >> stream xڭW_o6 [,q-mn]BXb^E9táR#EzzW)h$,cj$H#a(Vٿ}rigқrNBZ辫7jj5kν<n%ޒޔ|N_ΙoP|E_H?5J?FnXZԪZ84= o|ns4Ŝ2NB]&KBQ<Ҙ,&H .C2!6 rpb$_|wP:|ՊM5'VW W*SP W}g|<+btHoӤԺ6୐v[O0 y/Np p@No(J:E{1꺪K\d:OyMB0("%& AoFq]Jhvʆ >^?পNmnblEaBX5W}I[-12I O,IdY?N>q)o6´b_B*a8MHO4W"qWoO:( 20Nk~8vߕ&\`[M\?VLJ m 4FIk* CTv7N8cx |3Nэv,wM &9& eI,%x]vtQLA>I "nnVwuxp\W)H^f C+&~L?y;}܋Whn6eUpף94!STSm& (9KG p6Ec]b[p]:f\D|7LH;}3,3v &#J&Jt-ôYyf&c|4,痢YED , &tK3 pKeY6.n6k%gpeҡ%}U>kTXvNx@?[ ~n3aǯuVg>b=a dE '6w워Y endstream endobj 582 0 obj << /Length 1550 /Filter /FlateDecode >> stream xڕ]sF=BMqI ;rd24A$"/c2NOG{8Hp6s}wnG<ya™uRDx0~Lۮ*Des;p F fbfN= {40'e$ۍ'YI7o}3<.|6=CNN?n\$NgS# +kan?hl:m >I\צ~K6q垀hId\#v83o4 \(4"i"(֪*dI" p5ݖWZ╖Mnt+eFoVR?+d;CdOHHBG:Z9H{em*'mum5FEWkapHZo°á$&h /*b]eiSPD+ΈM!9 5 pFLqhT{k ~'VU^I֐(%JU9:bӲRH=B0rmA deR&`BXr#.Xf8w{'d&-ZP!&cY4q<(;zڤ@tZ!TԲҒ^^?FdR+h1:JdQ=h븖:qTi(3յݼX8|G}#kbq.2@nE ` 2L*&G<MY\0b"l6Q<\'3έ~W墵]>W -wK,u6UQ!pm1Z-1)//n؜ynVkw9'Fz7tbHdYux6~(LA4y2VrM$>?HhDZ-dOGn<1f|a2!O5o޻b9.XK/oiD:1݉*R*QR T7kt7R?%R, SZ[ H pҖ` m* V7eAh3{vjr퇌tp\R馏 zOyh@ 1 :zʈVE8*O&֧]|mr d̵ 㰑:fd3vu`mxʼv1 ګZ9m\MӮíb&e]Q!N2+h{^g;'۵Dc|^cs ^G\n?ibnf^)A*M)7k GqB9ֲ&.͖TC5Іh8Yt/`I5C}]vR I&hlɼ֧k~pslCR:4ZY͹3^Z w_B^Peعqh_]1PMptͩR"aj6c-;)ׯ1& zDI}&qǙi8Q{/nCY endstream endobj 613 0 obj << /Length 1431 /Filter /FlateDecode >> stream xXKo8WЃYzXnnd]xqm0%dwȡ$ˑiOp>΋Hvoӳ{7](AoyNH]eH}ۊ}߷D٪yV,?]Fk >!B`o(z1? lKVKo}xQ4prkE!uE<^/p\ğ˸; ].'Pk5ipL$!n1=||ۂ;ql24mclܥ Z3q=.yb}P|5/K03*ónZq.{kذ+NGag3R>x'?Է1nUTǁD )вbSaXt HULd'RFBñ+׹zQ9J B&̰ˉ~^+%w IPV# u654p uJ!fy=GB{= 3dbRx(6x2@Z##:[ѩfLXeBV YyKklє~xZۖ@8\7h'Ȳy*Â|UDH0rꭠFq@:OScv " '0~Խ{6-r)x25jEcMIb#2"fk3=<1^`V/ pW\Jc]ƌ8)[<#9Xp@c< dqj@߱4Aળ7-?~d ]>Ҏ˕pL" ꓄u/BK&f68ղc[sDHԷ@ق Ӽ2nT!'l'BxAͭ N:ʂw_ h[TI`VP^݀mP"ǛZkL3e>/'|kZ֡cmށv'ݪ4jI{ŶOomM&O@u9KP_㾰x3%@0ER}'sRhu uR(m퉗7v endstream endobj 630 0 obj << /Length 1268 /Filter /FlateDecode >> stream xڕWKs6W&jFd;Nڑ^&A S>T'w P%&X,}| y[y߿a~cz tz C/gqř_;b/|,]+miϧh5}5ǽ~8Ȣ OL`2*d{OwW`1)2r_}?h@>~8$g}%hTô(;c? .Nj'ײҺJ({Ű%hLF,ȡ$VPC[QPo|{dN;J fZH{}hNI_ӾSD@Ik *ZW8 kP&ڝ *bQ$;yӸހ" 6~lAh!\2YzlN`kzAvyBQ ,+%]+:MdmTBATI?Ԅֲi܇yj > stream xmUr0 +tG-w.W\D كܴ^ͻ e ` ~T;嵐e^fao .] > stream xŘ]oT7Wc[(RZ$Hm#.(*TT!HMqJ:޳3qWrw9RkGt1Eb-&IȮ a9@9n NyW#N#&NR\,d$sz9׼PLSyr iM F(lWLŠmG=.LdlLfÈww˧p~w5ʉRsg޽{x^lm&of[J;alO{a%$oGی-^oe|%61l[,&>dKl;?9whÃgǿ8<|~t'ߛRW`;o1{殸'e~,i#|%^)Cڢoh6K!)ppjK.WP ޻_n;r{#G%lsM"޺47Ҵ2DKW赤R7*6xC2&0!,U%oKN(c$PƔ u{Xz_iSVdPk6WʍX"ι%}&^O>8FOyX->/}ס3 5ln8ED|W{ cv<5H%U1!n$6UH먢ˬެ)g_5RAPŌI' kC]mVRgT6cHK 4[AuƵ-θ6%Vcbwbwθ?;ywwc_΅:EiC_NA endstream endobj 659 0 obj << /Length 1722 /Filter /FlateDecode >> stream xYKs6WVj&B=9:LmIl)R#.^|ȐdON\`w?|XfO޾ū+&G!dDEO""B"]ntFb^m6!Ք^i[z%$( I(' "<&3,Iu%޾4/d#B iD_2~u۲n6۵?m֩k-K[0ƫ%tG?2ߖ4#V)+}u#.NxBnT*H^ {Zw4F>g?$OO.1 YNu~pb>Jo>0+ Now7w.)AK"xFy=/p0E7fMqŢO'3+! J>SB.Y{'Q6YX<;ɝ\D֕`)^EóByqZ}0 > (JTJyp&tULeA@σ!Cō&XxJMvW)e Imju:`4:SL}M'E["B"^_p9s_V<}F.Ԧ2WXaʘWUBw/Jn|F#m\3ZF1 brR[~y%xfP"6>q< *9, \r3ߐ+dr[1 P\ћx!O`{¥ECҁ ?`c`O ~O4F4HLtI ne>Juy׺5cUA|%LGLæ&O< r >vg0#hrpr)ׄӎj28êְt?aA<eej|_<(ژDawl55aO! endstream endobj 736 0 obj << /Length 930 /Filter /FlateDecode >> stream xڵVoH_bՄz}p즊źJiTX;(eI;,@뇫>$;q0cuv/=0p#~H35̸5I-(Ʈĵ[o`inM|Jir˛grztÞDZBLlߙwӑtЀM74<\Z7$e<Ёn۾)V95SOIRɽ!*<Z#IGdT{ @i74KQom%BB&DD"/5DI3|VLK*>$g+M)K\(;%% +g f,~::x.Pd6h "&qRNK ϰtd, >IԔEfEA W̖Vϗb̠,(; *m4#k8z_moYjdox]xC>8bg>T`{-vU#[<_]?DUO`Z#B7N!Sh1SPe~hnP}oSTvnws Y.:NJ92)hPW\QLzF.žWJ5B]7:~ku-{ F>܄x6)kٗixŘhIC ۫*ھ4˱eq-7[}RjTu?~ߥVwjlQbl7r)#~tGF2AJ䩜w^@I:.;x墡YY-;J 鑩l+*ڒ!%%}AiȻ =hd'6\-23xD * m~W'ms.AB{Uk~83> stream x}UQo0 ~߯c*AHRMq1E MiTi8Ŀ lqlgX< w?$wBC:!0'ɜHťgQVnyrwMG LaG:}X6~w}^oqlKQ@ .Q'}+j[ѸSs55.Ծ2j}󠜤([2H%砵"WG3| I@٦5(gedqAe dZg3EVCq{ {W{ok|m^s~c8[6U5 .:i 1m307'D+SVWgfhB*=1w%wS `PbKc{I@͖7)ɭ=),yJa]o g0h砕wwN.&}ӣ,UUq9{=g[Տ@&nHe-t˭pyĂOUcQJ#!Ul\T_a(r> 0e!Pe͝I$Υ endstream endobj 656 0 obj << /Type /ObjStm /N 100 /First 873 /Length 1426 /Filter /FlateDecode >> stream xXˊ\7߯ZP]8^$0N18SWdѺҩRUƥoRYaV8zq"EY{-ƭxC;Veq, ?(0OhD@.PwsF-1c2L)/pUЫF"3(QR}aJ1PPWFJ] l;'-'Bv0X0B|Դ1[bKvs||y$!4֬H^R0VX\*% )ʊEՊ@Hq07Mq0̞ tlK0.$cr`I`Ik] *I(FAg}*C% !p*|EM f07h ֠+/h P0@Hd(Z$Nn ]!y c STz9?k43[Ё@x&DaI`L,+xVɕ5.qr~W؎rJGbw^=_=,֬S9 J\6ZT&GLr8 &"#f>_^)ew %9 %mݓ7/ߔ{ߔܣeٿy C,޼ܿ]`mq/~_jf:(c:jýxrߙ,twLɟ.ֆXpYF'J>EBmۙ2b5S!+m@hR>CSB89rsJ68Ib韷o5c9ժEv6g\sa]3k5$6s֤uE(JMakbbqXG8qja==<6M>hiUX9>jјxru~V2Nb*ˤ%X: Qa|TLŎSXضb9v|;rJl,HlK*> $FF) z ɰPLyM2aLdXt^`T p7AO:o |t)yVuX;M$ofKkOqe=go$B\#98Wme ADqdžcK_#ŝi760 [Au2CQx-3vN㿼?my/k[^'mA]>Ü˿_k Ӷ ݸ~w{nXЫ&s:}iφU ,˕t ,| _?t#h骧cQdIȖtֳCkϬ+6[rz/yɢ82GfhV-lvqxEǀYolU0UAv}ʼn$w[aYpa;׹[7}G endstream endobj 759 0 obj << /Length1 1410 /Length2 5940 /Length3 0 /Length 6895 /Filter /FlateDecode >> stream xڍTTTkS@qHA abfK:nDBZ);9޵]֞|lvf]}9kDC% ZZj P ag7!$F IA(LPwu E$E%@(W"!PAZu8 $aW;{"v(̘^`._9' Z  3 rP_-8%P(g >>www^p!H b  rFK0"6(w8` pYCp&@;>yng#(W1 ;9`P-(kA`n/ nxG3\Іc p}30y#.@ʮœ# r:zIpх>ֲQ59-^)`0lkxI@`F"f_/C 0ɧ)8A}UPq-waIcc'D18"OO۴]3yx Qްc3uu=u2Eр(QI Kvvbk}v U]9 EՃ[+ 5iōW քZq\0{ʢ!zB^~}ovG[s҃~FE!rWYoܶRTnnY/r%Wiء̙tgumi=K͉k6U[nq(4:y7,/ߌUвm-*A s8 ,i3YK7R牾1)b@]ɅMML,]/$V%67tI _֢!f"^, xyit>jjSa3 uɑՏfbqdN}֠IuA(#'NUlP8v{,mXZ hV"lV+)Dw6^wdROHhE;BLyߘ+j%齆gri'YPrKr%6e7vJ=)iȲk4fdZ4k&)?Ui\xB7u\ˑ`7m]Kfg_"2Y{N*?JPxv:(v'th+BtNۏ@"5i.:%wm@"02C('NDqɭP ;I7@n7nRJyy~Lx>05k}je;%P|CUW٩ʃh$)ÕnwZ(8~f4%n#>+e4՘Vr*>XpVI0=~%["G)1A$ ל3ˌ5p<:AֈHW:5M2/pw.Wb7Z(:"! %9"1w"'?4Ve2ӝt$S؋3xNz$ں cXǎŞKdЃo`]3:uumH&N&]xTlGuX,DeLxI>NSj){#8=]3񒈵הyN;nŏsj/9OvM}v//`-M|ޝRHAHrX8(s5KAZYdŒ-jtS#j]@!}q4/B, S% ;Mu,䉾k=ܼҠÂtfLT,YxS*OFemd9_r~5Rl ?{LLr1cI}1mϕ#JDzBR̯I{J44aBWM}kTGbgRd>3>jo:T M:M|.j*7?7Y܄̑11w1M.yaa`ׯ|j~?Wvb9C}bucAwH<ݚpm7x6v\KXOJjWЦ־Bh6ŗ[J ڇ L nrn[f^>z+<x"xT&PB-O[1HyƊۧ;fT{ 5*#jy$̈{BMZ?.خVUS z*!1͹߰`QoVXfR`-V!-lq@k]!^\Xv-"=U}[-? Hd D%Pli}}ˑ{\7x|'͈G?v? Nsb|,jl]wCLIJJCrb5=ʰ lڽe,dk)9_yeU -1KRƧR&Ǽ%ș$Fw [p'@l$5Gҹ^#C6RNG ׮b;.!Q 1d&/rpu5~Kmr?l\ET\ճwRCQ/tE[6Etu܂yHɝGЧyVK~gTCpn=Q ~mk .v`pX>[Qϙ佶!ڴ'e$di(O\4"O6i5KxcT_ecJbwWdZXCM^=]8u2-ϭ {]^CbI_=s!V6Cazsi;uTk k@ǼSA7g]Bi+$U&z['X0ME羆&=a6^fjSy":rx%Iwݔh5 ·7 QI i21qPG#~#b_|KRlڦ5["+o8GbaH a"M,?8wB<#N)+-CV<2@segA,ƥYYM{'aJN[i9Ysk4 ^z ~z}{yv**e&"! ɤK+:q]VI!vW"cypn^F0lwqW_"?`T@"x-棚s_ c_v|RZ T^׃j}G2MJNoQߑhPġFEj\s~?L w[wz) SrVM7arNMxeUwi /V-vE%:B|Ȕr3-ϓop.X[ 5hfvT/ef ) s?bQ[5[ QSjd Xʡ5r GR~?YXnEiIfR`?5vj,RNiSeyIR ɣTTE$O+SƵ+ɺBR\ U * <"!_&,9:}[R:;/{k>:}[J؃?2`UܘK5܅2(#Oqe˩9m7̞%CI}Y3cf.g"Vb#u/2ڷ2v[rl5pnָ`do Z.)VUC1mA(?DMC?\l25I+_Y*ب|8%wBHJ0|JFfL{se Xfh(ys~8s#_怗[` D%#ru $AHNCM1Cb. O3{,9TѸOUw;nF/a.>tNs1k6Nss; 'FiL|}Fmzz`@NT~:Dz3 [((*(.J+ Ͷ KT~wdi:ÙsXb[4I\MmnK7tML @ԗ$OAAoW1{ffFҊ.oԎHn hc|Jp upW67An*{dtf7iMR7c-~7j4UXMYm,!_=-k?=rs,sGm@NFr@aFuYJ(#X!V)Yu# .7{Qh2>[&b |uWp>| ZsyO1=iE8Ao9lfO LcT0Zb p U^Ňbg.OOnCv0۹r+ ŧE÷;LNI zAwH̓lIR,ټ*SxAKIgy"1l2GJ)tĐE-(L!ڎm;@<&Xm3 t^3Y'rCtY;E1n@x%z9 `5:J{jH),Rtw9XS=MeCt ǭR.[t_D֒^DF}֕"4 bƓ? |?@o%bYQ'"R޾SlxB: ?à5 5 bBe4Oَ"M ͲZ endstream endobj 761 0 obj << /Length1 1612 /Length2 18729 /Length3 0 /Length 19569 /Filter /FlateDecode >> stream xڬctf]&vFvR+m۶b*m6ӧ}~1sk^s^s$* ƶ@ ['Ffw[9e3௑Bhdnk#fhb@#++ jk`njVS֠O?!Chnj8ި̀s+ @TAQKZ^@-) ΆVF9s##`b`dkclOiG;m@7#?.z;```Ns#+g뿾`NFvNY$܎[ƶF/_^'sG\@E?V@Gǿ0 ߪ7rnE/N@+F8ֿ965cgPmLl,;Q334IX&pLNSTfA[j_% / 玱2pX[6@ IH;m_Am4w0w+;L v_v5c j&T̍,mi=ǿ]@JHΤ!!N_E)I/Yw[CD 2}pM/\7pr0w[23˿ t ?d`cw_Uu :4[Y5 HLw>lWڠZTWm{M0c$g©Ǿ p7UW 2uA^)bFռ6'θ^;dKQj},oF3GȞ}|XX ^lS$' F.\wxQ*ϒZЈCOSZ_c nBΗx254儱[W!~hX١?} 2ۼ anTaBnNN 8:>̊H D yPe8hLKiNDQn_jO^ř$P40.&,p)(" ɽfƴ͇a)9ex&$nv%_0B]j:~',e%9N^&:X<"|ȎZRUo,&2Ən0ʃ~9&{+2|rjOqŖۨv@\; (', ' kHڪWSgJ6?9HɖQ8:V§Bҵ)ߏ:0LE>.\xi%:pc[PNq . 祺]?w?yTlhUYWkVdGCr'ꞧ,w38VyK{z:;^ͬ՛_%ڤLZs!""'Yō:Ҕ> R?U~W;&`tmE @*͚iA9Y[ {Ej9 IEY ùK~ j1{"O Dz c`ż\Sg[ H!W o@QʩkUEr\?q 1W3 *<"ddQ*]ԣ&m_V$B|Ҹqbb1š')vAyYJkK\r^_R hH$VFsu)U&oy,C2j @a$ _a Jm$9wN˄;6[%\ߐL^2YOJ$ I5(I,@k3,cxz)2bT+ ԵkI@ٍGT^.=#Cs9JwrAy]!VWM>uzmvkąAǚZst:̝fr91EAG.ښi/WZ);?=CovH_愘c%u% o> F-(3 ][_"+EpV j+SRfEcKN P0wb+yzCMRɹ`TaK& _ʀ:hoz֝`H{Q#1Yl*:<,%0a$3"Bf`jx JOmbC$'YQhXpL;Ȧn^oW$ (e1n$'zlY)ʝdڢ(l|a̓V|}#:iI3 kNVqUre"kbN luWyO(ч ͊I\sTn٬sֿ6K]3bv0]7ԟ9Q]MPd[b['껾mΈ7CKP*òI @HJ<_"]+H=fr}@ ] >OŁ^,g';FQ-W/] 7L±nRA+g*$v¹T_/ǫbn11M$Xd+@6JC&lm] ? >jb5{R?{ئY"½deu8*"GL,pߛrT D"pcvCӂtmy! ܤE%piGթVDL2>8cYiic~- BW} 0*TklZ̮&Xc4P \Cd.xrl ˊCsRCN PoZuw)?4z*L7$ݗGTd/o,cD{nI:sv+>PؓtV^-=W"泯ش NBc)_S} 17m!3BB̐룉MyQx]>R $QTs}cڢٜ{t2,v|a5!fǪfG&T蓀?SR*6Bkgž}8o-a.2\i俘bU6~%1;jLicwڮ Lg bNBI*:Y M)k'WY%Iv;AFJ52>Sh4+p{x¶9+7u&~~Lqҙ!5?q(ĉGc۲Ze 2D4CƐQelXh~ҫWPT5wtȅ&,|--~]#X]HҰ.85 UT)qDo:z%D]ݑwFXM{JR1<ݭO;SCq+ڎ)LףHѝ2)*~x"\N'uW;SEQ-6&r(&d'f܈g<*;;Pۈꍴh ()T8 Lꆠ=(Q,.9h6'՗atpCo3; ={7SWؕ=6B Ѻ#ZfUb]=0A@B[TyJ_@RܰHV3nWxcM w靐?'p!gM{cBYd _E(Cg8[ҕ]\1Zo:P`Ɛ+vg­uZ,#vTM2ӂn^;D @un`/)*1MͰ fY=df3Kh3C 8`̥,h nI" jm%{xnb\Rvg"imgO'tIiSu7 cR>BY bթ2dFQ9yFҥD8ƒq/ (ODeš^.ꣽ/pJxwa#Ygk>SWYLrUs뉖ΐBƚdcDyi-'u IwI_rh6Q,c3C%nhdC9|L֕^mfHI>>q>jcwuiE(@혀4[[0_5tFV!/_@ G߇=)̪pjrw~v{9Fc/@4ݰ,Zm_bi˺_pfoj|/M0PßI5{F8gvJyk5Uk_o^(4NHӂ7n^*δJ[O&2S}?#(0~G^m;2 ^W\hyy2^uyAMT]wbqrN5*Z@o_C;)4@1<!m].Za/8q8.:@MU9&cJnu؈,_+qPx 5:cd=: ܀67>\s6߃nJFڸv~A ٔʾZH=TU*q.'Jz3aIH֭{.yقyβ>(Y#\:)y/lo}ƴ>BwBo9ܫH[m|>:x xbke d>jթ[e_5 `yφ)fD\VVJH jH-?k:K};ERh;;2 h Ġ =1!"?ݽ| HȚ߾.Vo.>ܗq=ntqDdP*o@! T/ΦY9.9hs$jNSyYgmuDz( XV!ǫԀ}^j[&-4]8)VL;28Ȕ+dz4)^?hN)L\$'ѽ)QQ+БP‹XՓ,Zm zm,"GFU=B-9n b !isogYLW9\W\XT4JpYN+xin;VBl5dJCWgN@A7)&Mh=%pRXW/[: -%'|ϺHA|I;&/AW^k ltt~]7߈FL`YLiu "WI;WOR﵀ I֣gl9]۟jNL pĠ\ԀN+<"W.\!q:; 5W _ [ѝ0z,#2*wZKO0ic薠Շ݁ |g\8uqTf|Qʉݑf˾ȁ1V0ą'~(~L,Ex:>9вa9̹JcMRNG#@-FPS4]iilkUeRͽ)tKM$* ya s_]e׽̺Z,J'~F`eUT^{ڭ.NvT)6@,F"d xliNv2fHʪ<WYub*vnEĊQľ u'tגXC 8B0Lx ΄ølF &zj:)uJ\;\6&9OTg *8}ΊRfz D>8+4A ۉ͊Q/5mqڷ++6ǙطOit5QQF0v<РhPA7c64bw^LHeih!PgoM:?yclTq&4[EIQ^0Y=~EThxƹrRU!c9? Cl4wb`ᔻjPy,s[AO&X:NAEޭeKw;Dmerx_yPIgllJJ b?e0G$"迂%*3XieT{n׷QHnj/i\ҧ=}k3; D'AHGy/PTe"w%@ vWyj02=kA8)}vcWxj0M>97vDW5`P"5@ ~%KղĹ2<<NJ444U"*gZ ;A(DSΕDZ2X'ky$,ܒT 2gD{Ú΁ʬ~fX 0(}wE]ty˷@(?]l&1/| e)Wƾ4V76nև"g3Ý~͋#(%4|!H$^%P'8̚xտ>1f_ldR_,sVAԿj@>_還#|@(:Smk%g-7KxJs_s/lP:"0qtbvEL\m6T7OkNݼ b-?w9Fǫy%ЗHQ~縨RJ`|Wgө;!Fν&殔CVBqǔ՜Ȧc2t~| eO\+%퀷k]%CZ|7H֐rQ t&f!LlWꕼZE./b͊&(g\f [s\|>=kT,gXt+8D?}z$82ot da%Bn)rOO a`b=6f@b#Oo(Y@<%[uʳ (| \2Gq`5ς3#vxxD}u|y P?\VcN\H$G zJ#ǒ[J|S3ղv~SKĝɅluWM[&|j@1lr s,\m0$@3w^;t2%s P`Wyddv=֗/Mkf='d;͙u%/Y3RslIfY7fs37uLEyq}L gޣV1uXZ?r^VuhW!}蒲 ER1խ/H8U5v3*p]dشOԩZ _D 'kFiOnC65ASᤱ\_[ɻʌ!͚Ty6g=52pO [4K%t׃n[kE6宅&,/W)ƺDbXt̕ c"b쌖a6Sd娬C=ջx9DkCg 1W1^@LV 3o$#IW;ͥP;{/a tԯ2*+Q\+gw7,fZG^mbUoBAV[=u׭ b|AeGWyZ ݸObL2)q:Z Ł֯DGQ<"ˆy;+8 ,#M=/!=dYDj&:9mR<ޭ6=_ +#v7h)U;'g`Vx&NO+~Tmʮ9ӾFm}s>(}r3UEY6g >Sf|{@R5mo) pT"#)x$6>z0zARLY:!A^^M,/˫u9#AcQR63nY4 gW=r2Pj s ;azz?SLk/TY`~LuʒhssAd-@kq7qObاk(I FuQ%P4`f1uw]8r~ҍ[c˧B>bl7,6Kt>[/zj<'x}4(kl7Cb(j${r)> $=`T<~D̯ C:ڋxV7d`P`z9_ds5sׇ,f@~:Bd;\.f[{)9J2}rvPS_XkH*ÚrMNPBbp}gou[P{zPcԎ8m܇hZy0U^aW? :(`8 "D/cG3tl &*7U~[$K}h![~3.78r0M2YYb7`Uk)~K3pbqoWzkuOZ7;SK5;OU.2dۗU˧dyqV:1<^ i74/HH<; Oda9q{Hؼ3(_diΧF.tM!d4ܡ]  8=D* r_yx8:h׷䎐iʅZ' f3ϙ͡~s2hߖkA|AzS$cZ&o^xB$o$4wZQSv[4wF,_fj¹P31gk^/"K,M]!+tiXˆg}ZJE+(P3$4 U=|QunհqY:PG(h0\.MCqB4 ;jܜ Q{z[]Hò*JH&⻓MxM}#׸eRIتA.[MH"" t" `t(|JVbrD!x5e eQ˔J|AvLw"Xgy营^6SYw|e,)RxWHqR`Үq'$(CkTb31L?k` j,ry}1z"Ǔ:s.9I>A,z&}(Р.JG,d^ڕI@7pװS?G Չ(gSҟ _*T t։\uC4~ r [@aÔ|A'픲{x½=\jϦ?Q@B2S.68{fMNtqp.;ڋqARhZFk,zI˹b%UR判yiB(;l!bM5ao:rn#p&sιhR;/pRwP* |L4_h=ANC|6!2g2_gsF0<*QuKI`1$hQS`$(fc4d+ Loeb(A8|Piwӓ0Dez'ys_{$!$AF}M!!;.Ҿ}G"> r)[Y+ _3 .e*eAP=vp''$#Wb~f g8h Қޝ4=Q@DGYs7s_tz۩,rt V^}Zez_z,?2~_1Ov;s#)WukkK0R ~\gP9a׎+!)^G&e}F4UNh'Eki_?R!#u: Vsj0¸a Vw6U\GM#擀kx>f) XkRXIgm f u~աr kQ_0](2] j&eɭTS?< #-m13*+Fq ExzlxQV{`kOY!)@nl }^c тeR1F 2n"?@aFB5#۽Ƙ^EyG)$C3^2-G~D9ش?Aj=%޲0ST=!7=vV"$d@fN+},K~Zҡ nl",TTV2Z&iԿ;p8P6d^0qԀng;7v==.!Aߝ̓{GCkO@5cX1s@σbtnWWxxRa^X[ޢU͖q-;TZ^-W׌ /E"R`XI;$18ќ+]l.߃K-v{w<-,>B!֮-g=7yŽ>qJ261A)]{]|tiAvUD &7Bu{{.0EGA"pV¾a[n|A3 Lc}(ƉSЭfq(0,>feUQu?1sfشHWWUc:Q/#rn\ QPLK|c3wxuYS6-`*v{RkVP,}.gS15T&MymUAcĺǞF^%HjaDϫeU Z}wZ+(TZiWcKA5R @蔟.ÂpG=XZ=j$?i%$E?v ?#UgU=:h&Wb9cR[%2>4g茆PA:f U>#o2]GX*Hf;l*"ٗJ&"޺ x^>R_D.AXk6OMOދ|l}Uڍ+z1ؒ+@vZWSkabfZE:GDN~ Iϡa& I<*8}c$}i-"|Իy=\9js݉-/}1ZO @A2\UѼ_`E|~y~RסH8όkHe"GL]X3tzb'@]2ZV^T J:PN4k*> 7]þ T[Vm X}<5uAZ?/ߙ͏Hef1VC cw!-WPZdܘVg^U%W:}FѴp`zh ɆؾҹBc}t4nwLal5 Rm Fm!bz7_ʂ'GM܂6| d KOUwG%aJ&WF@>z=jإi7dǛp覫$ذ]Ou83]!bumro)-+ ' rnS^s_ձ-%t[eDmf& OSȏG SnV{l*4&PjsC,q,[Y*Fsooc/Oaltb i_r>DӀ1V{,6Ypo6u9ЛԧdK^H328QtږMa۹W }xS_Q1qOn*N\GP_TSWUS8@4kR6KKf{2=+OBtkmX']AssQU72~3?^}]Rlu!/gy?s"F]8!uϯdɝ学_y J 4j7},[~pUmӔ 5ѨU XKD'%_{_O;M&n(]aSӬ.{¬*wS&PU„Fd;p۔8&MGPu_kIk 2Mks̾:00{Zr SVGP ;;lPPK+,%6]w'K(1uW%r)t^=u{ײ=&Uu-*A$$P WHh\8a{}I&H_ CB<3B՚ePI^ j\~KoyƂ<ͥ,XfQȆT#x}ԦhJ PAd%þꤥϱj%F $Wk]=עl#qk~;cEՀ~fp4{엡TK1ɟs^d/;TfE| OMER2ڵ`¥NaߩșVף"7v3ObD=G"*>CZQ9h9*d?UBTm, OCY84~&7)ǫ_ʹT~(|Q*,^l „ n~ڃ\sxԹ1\ ,M ׫jiMƔkgb0#[]z^oFvBMOV@bvs97G̔jۧw]'ܧ1wLZҌGQPEi Dٿlz_ fGttp~&Z$30)wׂGa;"y֤$-pmU=n%%9Mxդ])h`(.u4eh`zQ( T߷:OȦoij/.86˖W tE8(2Ш׃: ,: W,JlT9 c.I`ˋe5Mp'!W)19_{8J3O,7Lۙ Hqh GF i(bT[[諓[7S$5] fCm%^PT^&]7O4Z 07k~ &MЩo+Dǹ3kܧY{&yC4Bg7tXNi}6 oA]td{)/1zɶUcsj=J& vnfH#(XS(. ?PHq$.Nh%%%AmŎ:TEKߤ-:FvHOuJSfsжP1W:C)/"+@)2l5\av.dʥCC 3$W7 4ob^?|}ov}_y BJɢ$7Qw{r'gd\8"u̥2U@/b4@D,L0l j0Qw'壆R L&o+ >!9֝p`U?G Lo>R K˂PdeK<ڌ:mʮ g K$_ԵDbceʩ71W1Apzl7^og N+̈́{G\c9EZ&,p||oelŌeouNӰL.*PhChw|~\0j*2}Xv3)H3  %i=֭[5ahu2% hAxg{9L'S0J2 jF\5"B`ָ.坄4)B!S`00&{Uv|(?VSG;4O@P!T0RTpV;j&oCBܩuM[To~R"N`YQJk}ߣ=Y|Ÿ(swB"~РP>fo_ŗD75E$#?1(^[tidĸ#ZK}&e3C{#r,re6'7haF4bPt ו׻#S8JоNعLr?嬸tk7Q ֪ 6|_mOx>ksjk JXmp33h<9a&5^9T4~_G8C_fXB[& Ά^;ZFbu8},J򹢙cA$n$1A#VRV4X6y@?Wny_Q KV@Q:~t\ ␒x U*C>X4Bl*#$BBKڱv ~K*Ur{Ʀ 7"kH0Ol<.k)HptnFét;Cv̙ܳމz+RuZ"Lƒ]mVw2zT3!é!D9zTn3hCZP jt_]bwV゛gn2U*a/'UQ͗x>1|6\y05̾{ևSN[b8LKK= Dd(oe|Fj.Xp'Mw= (h,|QD ?uMcnݾomWٛ{UIl:?MCI©8n2)ey5;B6z JrќRCB)H)pq]'L;υԿ(뮦Pg2jEco:D;^_ 5'Σ־ ?r}Ԛjt5V*2Fbry$GcM>Qi(P9CjFUd&-VS[vgB2_ 59}삤POsD 6QK_m6k/̡D莥AjqQO_X#vKV[WBwb+6mm֓?ۨm/9,Ê uMw]zu$4nrQ<`DC+K `N楴7@KyKkK=1Mmc *46.L@I׃9}5M^:pO ^>S{x;yXݗ3vFRF+gI ^bl2,E;s ř=N|3}J,`JT@9Nh.uurUFIK֢Cq$]N+a/_DnR|Yz(Q=ϑ/r)迧%Θ~d  \v÷mG~?d M'뀞!FY26JDjtiE[Zy}oWw~iٙ1I$w0T(hk=)q?߶ʁ"daI&p2څ l|J``M9a~Ke*2vvǏg2l>~Cm)O$~($&bIo%>ª3;"}}Ul3dN;h} IrH$;YѰEyGSdY+ k=S!3g`.Ȝ-7z8)k&T}x'=@nOup={;1nu(CL'X#Ռ,Qoio+@Ȯׄ"Hz\/&M}a]cphZ zoq7LB :ZV-ڠbZ #Ӡ Al {md endstream endobj 763 0 obj << /Length1 1630 /Length2 9014 /Length3 0 /Length 9852 /Filter /FlateDecode >> stream xڭveT\m5w C EE U;AH 8'Xp$w\Gw{VkT}>}e5s)B\|ܼm;Lɥrpױu!L&&(v(A@0 nP#jo/?H`~z9 'u;`g@AGLM[mPA@PgS+@&@l{W( i %`n ) 8n {za 4+ :)nWAnP''L`78)umrO0''npO.[ ss~DU; qW(j hL_}[6nnEpٞ)' ,j{Wv;w` _b3lOEعBv {LmWSJNe#G>;}nW&=lk^0&/6OC8<  S{tp#ifٍ v 3z>fAox CcSin 1rK/ Y{yyyOdo4Jݟ1@잖ퟆ?0 }Z{ ĜqJ:H+ww!} s+b)/µ#05rU2vD{z~S}['3K{a.?[WsV"=ߣ)¼[kz/ PGZGlA yADn5ĭU{~]^8AڤȊ`! H٥K{[CϿPntկǎnh2Z+jsBգ 48'*j("d _~8l<(UDƽ)(RCP)/ lݝ*r͵/ 0ƴoQav:3`S}ܗbii ژWa~I=ځfM] w&ڟd„UDEIԴZb]K.Qo͕O`_(rh~ aݠF-{aacc.b7WrJpXԆ"%?2q }يOPo-kg{Vr{_Vg_̪QB4 w'jzgws %X*mK–5O .C 0*m \q=%Xqy/%v?4sm3a4=۹JUh1JնKy.N)AanwG6K<]R~bKt1?}؛nnmwk<'ְnzzf0{b*|y`ۈ C,'kΆmq`i2`MN&lP[L^*< ]^COe՘ \KM |<3iz(˃h1MFҟ{/ q+l86:rxxNAMid_|<YkȢct*)}MHs!-6,ٔA"88hr;~] C-/"ey>/ !Ʉ]); 8,t[* ?/ɠS@ ohHKFwd?m%8jufA/5E(H?$e4q&銵f!עɪOQ uU:To‹I{=l[k>f?ܠ& +~X ˓b[IJ~j 3ZJ}d^۷PUkxjuA]ܜy˩''}Avتk`Ǔ54c9!7o{(yZ>x~ ?|]6^1ڣ ;yF/2qe4V\v؈nPyWʱ@A9+ֿQ4 P§'z<|U(ϿlkjbyRP<5!\ s'7 [[#A >*h91ol3+ͧ޻E{N[H;vG~_,x{nJm/=Zz *k̶̵@0;Abi:i5yh~*-tDnYz dAW^4.)Z^zk Ci_eƤHX]@]I+l&5)w]<7^y'WG$g#ɣvȑ_& t=yPNjda(<"dRMkk>;zQ]jQِX.q_$e kV$}oQ+Te!4*J,W?ȜM5mAgqe o*M.{1 DҊ ߷9Sp2!?9{/k }?C?q,abU0 َ{ASP~+^z}*b}Nwi)WO4c얀T>-a C:3b3DOehoܜgU E/j16lQ:Wox?頖AR^JB3\mpRdfLb9<,Ut_)\`Z\mDvk m㼗C;0p*?/ Epύ2*̒SU1)m7mgd ^̳7~~=BK2,{"dhk4BZKH''/FDur1Q 9_DJd]~%/Fol|G9D+OWIWB7Q#7d(,$ϋfX}pivc[Bsy1Q(^  z%K7q~x5N\&[MQջ5І~*Qn/.L+eg4p}XM3b*@>쵫p5!@t.(Z~]{Lc/ L>w^VtǺygRh~Kp CbrŻJqZ)ͷDaWH]_m[oh2BNW:+͇|1{$% oE[IxXtcUbC}erE$ 46̯zk t{Ȣoz3eqfE[~~XҰ~$ *o7 JXP/ylɞ#H1G<Šլcݖc$'Ir@m`½Ţ WeyOy8Iu@~r@omnܼt,`.v˭nkq  GF( 7}2b-C-MgJRV#*C8zNeO,lmB.3رvKZPuː'CGdJ\=.Bh6`冁c0F ~fQŰB-UЗ 39]ѵv& R,|+`m4ôq]A7>u#"WN4m/s;ʑ|Q)o+fӰ/ a[T=oo_Tw#{6gۛ-~<[~^{F[^75CܥӒ44KTHm71"NNnkv~9`4MnL'qtL+!m- {^V x8F& ׄq/G]CZH$N?NHv1nJ! yoYY3C7_`ytM~x测>X)e&\HwbP=Y!nn`ȕ~7'A"<δz{,%[N!Z/"6p0at pfSW\RV՛v+G^B=_&(Yj;D|6.]ЙB{t}'RU \! H?z':Tln;2Zȥ!Lnaxg3Dlǎ+̿-Bv^܂TؓG%Ll+ZD٧"u/̢. PԿbh4q}L;[JaxDlک43w5 2FP6Lu<8/k]R+\D {pC. 'nB2dn JLM>gW !hYyYR$y4j$JX_iyVݟ$/Q %z",&|[YDM:DJw=5*jz8J&kn$}{h j [22w`~_&Dعd+i d\sy(R̜{Oy2o`w0BS|L\fw$XZ⟚mE9e ZtW *赻ZGc-oc۹&S|os1/֓)s);H..>J{g/} We~ !h^7S d{^,3]r W=^I#x^jJ 3k)A)|7D9-?C]|ZgJb){N]\:+&X8yFK"*p ˳E{Ss"Њ䎱 aZ䖾7cM=0;fұ / eJݷZ/qhc bX^Dc^*\Nѓ뭯Pis/>td|C|2LF;#p?'W}E?do(0 }Rϫ$I!.QuNȡolя.W?Avw%fn^s_*᏿Fd ޗ9JhĶn oRͫTa4dXbZ'nH$qz1&>([.HґCrbW8ߝ+ ~Ld Kγ >`VWujZJQUv.̪_Ĕ!e#H5}-p[x2R|VRhC` f4TH+qg̕$#C'SҋrאxB4U1`BYӖV*HUF~37ѥ,ś3sfr?wά4ߘ mo^[{^l;qi2 oXH5Xڔnr}D)eшwDi"1 WLWF,铘G‚x|CR۞fӳq/nS,ͣ{NKTj ;:UMi(mվ ZA ox+&Lʀ)s;%%lmf(npR~L\ |{:LNsm9Kx[~w) @7Fӯqk=^|%ܴ|c[>ՠ/}99ĉ5¬ %Vm(-'Jq!l40l[LL>uZjQY=%ƶ%;xiJ_hfxZJAdu}ٚ6^ WEQZ^+T~;LιEo~u|_W!ґ}!8^idk@|i1$(| q; 8 N4vmFEEf)&bQm̧\FzЮrԑ'sVw@'\k e7s`F f%lxF%׋Qu/ 47_ lҬz{wܨz2p@WmtcoYݹm0ucd+cOs:+`a_{|+Io1FgQWч X0f!f8f.BPf/(r% g =/q`(%R;㫛+6wY}꠫O/VG׈yT^I;5>ӞMM 0rujas@vZ{Kt s4CY1&~0@lIŗ16"1+moB)Wy"fP. 7 Ǥzjɯ? ~=9uosٝ ;>D֫*H#"R zfH~bXRYjX7O| H꽋{*OmaWғUq))UG>"1>сV{7ZW#n完'i_=`O]Jrmő~cC3 ?K±R+ k7V829> PhqH !"sT9.l7 Xnꮳst>gR۔y]4{hMu#NՒ!σUQ纕_V X{z ?uv 9ElSvnV GW#Qakt"#hS}9>R1%əKRtlZx9O$:a5"j;~ y4 \王8iӌs iNqS)s^k}_ UV+<#a桡7\iZpKN/ġ({I;V]2SwhwM/R˧WBf ZmY%*,gNNŋRn(RAoħIanY|(R4p_EQ{OxIZ%A,TZ3eQ i7SIw''%},_|o΢Y7(x,ƑM7CGTa2X/GL WQ 1'%VQ:iH3,ݨtk9N_EgԠ߸c;ݑׁ\t˞)>o`tu:-d:tHLFw->I_G6^8å4i$.=XG3W⨋F̚gAnf`-=JE9δ̃@sMofWգ}f%qgT/==]4ЄC޶Jn\axc$D$~ 4BK ;X24ze l`ޥrIQWpҔN~CuД~wʩX|-]"^XxXHxNg$͔l "2|ߎ/ 1NP~wjfeK7l7$Z5*9NlaapAH? eSE볿17)b$V31nmCE¶zBng + 1y8\~5(d֌ MeSNv>=^<<VԭoxRĐ\,[=]42xP}-8.'k~t1xG`̼SJtXHAg]x"( Bnm˂i't] AE]wATTPDŽ޼Z ug|,eTTnǤ]߸3e<5H22)ݜ:v&mOKlns`,YM0{@irV9uϯԛɇ<(pP  =h[RE܅H:ZyIOhW]w"YqїjM_p3DN]/+e2į=&K|F(r ^#Mzk]%})IIݮa? ޢ L>x| l/JszL}5?ߋJё2R0Q4JHz\QÿcCW6II.euވkw@%AY >Qe urlg!nvcƝf|j,3(c]f KeO 8@`]z\> stream xڭveTݒ5.%8hw܂; -x;wͯk=ή]j U f13 3; ?PWdw544`$%@ ;(leaRax_B&݄XYi>v`{7E 0b [ق*zr2@ze-  ZL0h ,oXb qZ]{r1vV7 pٻheojj7߄"|o` -?xX\ zs"L]*ơde=\eYAmAo &3lf @`ްοAv;?9X@,v.o- v3W7ax#2s.o)3YD?DywFoCK* a @E_;Yz7D1{7)XaH[yT\L- ۷mײ7;Zكߴ@fv.iZZtn]`{g&߼Y%TĔd6;JMuMO7bQwz3p9x'o @.V@.?~:_s7{46uuv~SV?96Xt0NRK38.i;XҠYPWaT8p+ϸ7܋oKד>#bZy-X'|^qNM{o{\Mcd3=C[~.#ijNF(ڂcă;=}$ﳿ (\1΀4I~TO(nZ2(DOކy^/tEP1$@6&^h:3"c 8w؝YFڎQf.coLR > 9>c͓܋N }^9%%:E~h* V_ACI)n5* zz*AvLhtA ]K)uU"Q+qƧ1%WK,J l_(_Y}jRߧnJ|[R'?\R*bIT5֭.f]ZŇlES~C!rxPy!5+9(ر303IEȥPܙo>|ZM{dcKeCk,m$'Ln` IOՙoczT܃59~:bߝYLU1Ps<@# !9j-AγW^P'e %"xΘlX*s^zҭԬ#m|Z)M#*l/K'<Ӯl6ROU-0+tQaPۅפ-Vr3 [mf|A=JROYWc{h%ܓ铽Jo*&aJw9~_uqyy"0 _pbtmJѼ,N[+sii*=W:\BZL0v#/4]mi7m,6O\_O5k^u #F8]JHU")$|\P=F'9{J.Aa5#ܬq9#HOV>$QX/{fo75Q8:ijɵ_CW [eG Pm\"">9_ ɛh#~s3rv*PAh$-9.Wf3ah*eG‹t5>3:#=/-b%1`ًV=(EGI]/h OY$ۚ|_Td&VwgL]a )xjhڃ5.kOJ-)nWAeXQ Ù8KP`*tOC 9`4=h3UmlIAgB&|"= 8w@Ӊ?6'^Goz_-G(|f8[:(AX3KQњ#>@ͩJ&6-鯈z#M|V[òB<˿C"6AJhv7# cjU^.Dq :J;Pґ^}'EZ/y/VTQ非̀҈ξ|6®S5 +Iqd}bŽ fe^/79jV[LI5g4CD ; yZ_'!SvH!hM?ȰX=cRK٠:im+͙xA&0LJLh]n[w1@hCJt iCe#TVjoZdtrSRŜ .Uߵy(hiYڋ /t4p@th#xkmLld-.VPJlnMuH(kѩmSE9F%WBvi@q@=W %aI_޹O<1~z^Ǝ{U yaJSq3WP=ԝL1an MCu̝17*u".4%ӓY[#_c:{ ݥ\xgT0#ptlWXة0=odj";^܆SF{%C7nIE(_v2Qj%'ÅQ۝SBr;ŋ[Z,Sݾ)ҥwN0O wKwCDZ1\8MK~oT^ >5__0FgzbWp;,cqS.пY.Es鏓o]˲:'npie-; ^wM U =qeQQGv2FTTLQeݕhӻ|NiR#5yS!C 6OaK(cg<6F딽N1z Țw+Uɐq-ȑԻl(g-21yED#ʄC/K(NQ ݡ0#>qN ukmrok-X.]|w+%9yI RJ&;% c7s1w#,#F]^Lz&[ݹ`ItgC8%g_#+'f)$I7$@=ĬGכ5;uX6Ta Fp"29Za'ij){ мKHݥtST TDߵ䤜$'z_v&-IU]OJ;Sȑs.p Q Ie]oV!(U 0(crENؽ֝Sbt\"#K1GOcf{^VY ´[P&<_aU?ڿ9aQۚl~M9-h<9)2*ݶL@e2d~9VV[VbSN?Fd1:jKX bq(; n+ RgZFyugzq Owf>~.CoNqr?8][%]FH  w/&$cĸ8!lOXLxn^~~۳0neO;u/6K$*6;37VRd*n}Dן~L'[Rmma:+A}=Sg:9%<% 9:x}nᲣۉfԈv#I\9P:u|;%B*':KRKô-T~`F0,4$3>h`A+ոc޹:3JI]T~2@'CZC#OHh]mfmF)ӷXgplJt a>`o9gQndvIkGr4#ڦDF~]qޡ/afd^Us\EۄZ&v];)̱ ԫ=sᥙ6]3n ʣ֌S13ET9׊D kjЎB⬠!7h$aCkJ\Acxx- p~& 8<6NyhҌa||T&RKy$7p& h.?3&L%o fvqpO5xRxJnL>JuMlTb:y+Z|G~;s/mj"d"ρt?qqY?mx|㺔m}e{ 4M"0& 7苵A3P vГBV}1作+ZyVTez& [ue&0H -oeK䓎jU&qv Dj0iJ0ʹ2 $.d,jhIfA'< uٸvk5/IԔF(ñf9hၦ$)i-4HpӁY:,6LEgN'I+is$W3|KC @RP:|ɇdG 5om'ȸђ]h=8q֩.Q2 !>ؗm#38ow#d)w Q04m|]f!dQwbPpH ,Ꭓ DDI3|et4;oATRՆ/샥nH4%=̤!nU H6N3v"LH^ C.y$S.CF]Esq> QmY[ mdAE Y$IgDJt|՟ayU_#Dy"yqG v 2,Y_pƶN!p+Nם-]^Ց+$AЈܣ@H*g.[B _tcJ+53\$ӘY\A@/;I5pB% r^FR41j:/M.\2M6[y,?wKKLG\84z30[/pwuX8VpɁc؎LSؕcsbQR,A*^G}NPc @5| N5 "QMi!{ZjȘ2LVd>u%p0$}GdAS(c](SaQ9wh(rlCCg Cz,QP{=l:$ _v[aC. N?e(9K(5/_)d[~>1'r~ޟVxw1N(|,b6/C! ?,J(ݵk,* vkKDvs``}kDž45Վ^[MQڝ;GC)Cns,s Wph[!Kh 5e^RmnG>JI4oƼ^,}};E$` MkuMo:[Se)L0.y\y,y1OAKз')aT"&5Z uD]IZ ލBxzh-,:||۶rV~I'25^'B߆mwz?] CF<50Ɵn'S[ ޒsR1DM5@P ͞tj?4,vg᷋ {wyC$i74>?OVxΉ+9C񎗢f7X;&rDNR)daOZ\W )E,ޫ87wB|ӈ=iE08u Sr+H8D=<.dq]2ߖ5rfFn}&Xo =2啈Li/-,6щ?t(Y֟o]ѵ]X ݢ{g (E:*wE() -vɖG:*pi˽%]jSpeJw }lgD/f7B?g>Ѫα &) Pl *=( **@[Hy;Ľ}GLBI?ZScKIDf2/{",;|34NŠQW?9]0R]q/% jmoWFI"+OR8æƥfCW҆Kmko mR'YFEZg;xYR}y5Wg89@8d+"pɗʁy(٥N ީ$pNLffvI &dZT$>,B"B}θs):.*b/yC@.@tuQk> [G?PXwgc"s7e_SGLQ=*ùWЪjU=ܹmt>6c١`Wӂ*_iU' uN+zp&ٌO2C`3Dܱ_x_8pTw=+gp֬SPW#`P$~I$\yg)qO$ë#EejSmhM@{jSȝa@KK (IL1dבͺ0D))٘b:D1r̳}:ðQUwF8L4!h~=݈_}"quo<tbNw]r[#gά)=ﺸʐ&ט<35:e?4dE#f;SK4° Bi)7IX00-x6y%wF@f*CClyF£Gv{%tb.X*o'u/Y! M@t:; "ݽF/rO-{iJOӳhm'=m̫cwo|kC7ͬjGmOi`+xjt(^k"Nֶ%4$Uѡ;A"O˶?%h蜙~\plH H=J~L ?Wy\Ff o;~,Rl`lm w0L&]o1(sls~[OB2F_A~;gݟ3;t\1/J4k_3|1w]~ػs}ocB(5seGm^|gAU|*AwIgv1t UicvqBršiz2At M3}[˚A+l=t:j~bl`ovR5,~7zm ʔQ\{βVbEUmݡpZ:X6=fEO `QՈ0%RkZf endstream endobj 767 0 obj << /Length1 1166 /Length2 7092 /Length3 0 /Length 7864 /Filter /FlateDecode >> stream xuveXٺ5 45 ݂;C.A_fΝ3ߙs~kګ)wLbs4 7wu0sPdR\ &_+!4sC$\^yMkWf+PuC>T.@';+% p:h::ځ@gЙ`WH@= k/ tԯ 7J)d@צ-U21.ő 1;[1;]X^r$N@ס7eT#z();6T*řȕ"<[̇]v5N:xi믃{ H(]R:  ܩQ[2!YE"{ig VGO#ѱ .^ʕٌٟ}X k,Y>FA(C$p>W qU$Qņ"~":KUrê0XjYHyXZ.iˍp# Jh =S+K}3]"@cACGi%3潵ThViڇ=ULUY7HHOP1Ȟ-'*cdPYV0OO%un`W ;w5?3)1"ɂZti, lڌdݵ&H- VS3 )ONO`Qt{.{v$"b2ES9iY5>qaB3,}c>TO!d7"ZT o.]/HFv2ㆇ- 6xK7ԽWriW[$7D,4Z #Gy ؙK}Dڏ uSP&BjVP5MwF'րG8“R-9{ک"JŔĪV5?$oxq[,%W#f&7ʮ3R>LP4LܯrG@6/\RgLS -Z Qzw1[s:NY vgK( \ G"ͫ!L-[Oypۋ~?#amZx4~ܛšc@8fKG>b[Xh fx܇ʛ >&I9ӊ]fc#]ݗV4Nq'QGt*M 0Q 3ĉhWBuP3巽n}Qؓ0/U@=,}tx:ޅGPȱa̬ 9\SEVw?k{y+Yn5y&I͛͒sdH%/b~GuR<1DZ8Ve#j<1MICL兼YXŤYG/ݲdAj[]9ka"`W.l0Yi,*AzL?TfIH9Ng[ PbWkYrBho0"ILaؽ …gXSTtOh=_Ri.yw8,ȱuh#ԍkl^=y_G\U RըuX2|Sy<0|{vev8bѶK oZ zs)"inbv_z 2ioL^X#ˆRBbkl&q2l(>a0,]NĘ?Ky.'W%gkݢuCwklxwNcjj2ode /i?Ӡy[.(MNlhN?(*=f穼!{ oϜ ) {yAs؃!Ϋ+B#϶HW/ԹlK$TS=O3Ȯ'+$W3~#S]N\BFH$nƬtQ"AU&iЏ;3qO-)D`m뒰_!e1ƑOXtehgIȞC='afԣ*OM'q'/>DIJ>ι%ɟ8{B|&\r?OҔTwnNzEgГiSuJqxTLaH{P&/XwS9+,W^Oh4GWlu=56%34 H? ?Μ+1MR \,˼l!Q9뙞dT`ʕ`4 Q7xq9Pnt;? Ifݝ{/5tg})&&87i7m,NnW&3].@sۓ nW-+WlAQAهLc i"P)(+X g X$G2t+%n5nY՟05h֋_/>i!hQc]NE>`݊$Wޤ"#I_P]ġ"#U| _@h0͛D,a:O@uүZ,Zq@\v3 ER^h{ Q .+,Ȗb'Gkh0Xoaϛ/ø FyحQ#0m=[876JxRʛ"d~J".g#]x^B  CǑB?2r*b6# T%D.A{8g!vXK~qD:j>M ɱMSC%dd|Y= ë|5Dtq6^泵Y4 g%);it٭9쬑w 3/ 4K7XKI^ч_Z..bQԳ߭dP!z6w].Ju9| CѤ]}B~Q^%5FCDֹsLKW>4RA<2ʵvs/;ペ;Kӑ[. p%xlPT kg.uCoO6);g261is)d6˝%Zr w,3quQ6S'5P8[OBChXWNgpmYvkz4IeR&M&W{aZ~[J;Iը6 We+? @͝O^6g췞,jmXE{0< ' ~xFҍZYǔO|%K2Nwq K)f1y :??H(uG9OSB$n~V%BS*HWO(\R Ib*mlRV131y9@Y|!4n|, i["` BA0~(L%gȻ kx,dм;.I5,xg#yąLiq$קa%ыU+/kSTa E95fnބpϵ>3pߢ۽Nh{J9 &&FzLIp`/R2@TLhʉ 5j`$$_)Yaʺ,.7FgyT&_ >~:r,lިR%f= /bFB~&JDe :le2V~"MGȎO$T]D3 bpI7sy܇KQ GK 3v2,u{mOc%*cZC&~lt)ZMoɸO ( vN0}w*n#<JWi(g2=KxOzᘊ 9|cMBʳ_Iǟ4$:+[$"e’5b|rmMYWw*F$-{A#gٞU *)ԣO$_Z_jk AZ(8̷]><Y9d2spČ%/FXjyt5J׋,)J$?p[CI3cJd8wu,CE6OmbdBȂb2(ÔETMR Oh BIf Bge޲jA@vyu1CJw1uEVˠBi3὜B^ʳ_97d@A3%FNu".I~~~Gyڻy!  fD_x #RF`35~gnu <7.t?,X(yyb߸wI@9wFP\M$: {R߉D1:_KpE31]~& tuRaym}DߴwmqMC`H]`~x :DVB뎕sC{t1(EQ#Ź{x)kA,;` hHB%xF RLWLm$^G*Cw,aPT%ЭEˆtfU|D~ZDIg0L#c߰- nΦ+1te|^OyJ%M ۗ3߅-\'̇HYXPTq& Ǡ937oo^ n?Wٛ)k(8DAcfM ;66C:1@3gСY'\ LCH,pG-1IdFǔ;zIz_/ KH#:_iU+ỲմrxE?m*Hgoɯ?y ~Y9}g3Ѯx=W endstream endobj 769 0 obj << /Length1 1199 /Length2 2416 /Length3 0 /Length 3170 /Filter /FlateDecode >> stream xmSy99ϑcaKtKx iM*[#,(Q х 3@Ba ,Q76`F` 41ӑ 'Y Jq!,i,k@& L @V̀>݋à1EE_$\8? 2)4`R^kٸF dp 'Z $ kmbyap/2TdȂ+p5kL5H6ƁICݗGLGb{mho6xO$ BFh7kr rL^@e2 0 > b &D$ '5w3A*@}KӨ_x'zzt.2RCPVTHnhSV Z(t%?LOgQ 5F;AC{C6]I&LXS]5e(EP9c!Ks2R4$ cv~MIY[qn vԍBL&QC [RN\kwD ҿ5f0:})n;-@@ox0Խ8|H<ڪVsf~-.My ^#=xkv <h >mgE"$ޫ=Mf5œ3'9=r[Dłƽy r 7w)w,|4QOYbx;*dA%v%l+uFu3`O@m50-U*Lt*yEfɏ›Ww_,.<eyMR[kQ֥9O+63~ӷYNuu<t{RG]{Aͥ%~=N%ro3Re?%Cx衄2G$[wۤ37\*D2v-*I'-鄰1 h(78 ecqyH N`Ë|p[Y|@ޔKZ! %2 {*eѸlF%ƾИ1%ڦhAXhYᙼ!󂛪Q'&v>T%84[ 'Jz[f| F.]OC _OYG.BN\v-n0Pnx'yդկݖ'϶؝&žƭ13+OfgMM:Mh߃`ʭb"Z$E<뿂G+ۖ*]"Ri^XjVǔM.{ ُU>g>-5si`gxN+[޸HY\.ƶwNЌHFF!͗qce'"er][o 8%jZ] hyĭ,0[ԣAL=&{MY[x.5R2z=3eZ%rXTy]K'X:G'[cm+06|FM&-g/+Qn%NMiި:-y=M jDz Zǣ5u$Dh#'`3W u`_{sSM,}u% f5B^``54ꖐU|f卼yFd?qoCKs2ٸW0 0|Yȕ}͂MN 9H&NE~˜}fUƲ o"Bb>VWTZ}Of]aVΉ]vU!C:x-;vT* aݱa>B1z澭T9c : &EϟXzuʹBCaSXG9p٪ 6ߟ {&}Ǔ>7]9]WZ,mb{z;K"Sw쳍Zʀ%orjYxh{1B S,2r_*L 0}`۶UNAyYi_*cD7/^])es^&=$ZnUqs:Z!l#NE%o /fSM2ʍʟPCׅm\=tO닝J/pt |w:dq2gCLp;ŭCϤY+M n#]084hH,"-sY9}%V):%岠'FnÂ? qYCa)7¾^pPL]Pdhα+]6gi 1e-ܤjl;vRY ½Ľ3 bcg&r"/z<1&ep;;y2 ~zU6wjCQ6t '⚴K=m>hy֥yڴhBN>VJnlJθɴRs@ElD|BG[vZsT }w/\Ͻ>xXISH6[ݳmrtR@ y O=07j]w53e=mogeU]_[:qB+٭s&1BF'עSc<+O%OjZ&pXR!Gs6 ==|NG2N UiS WsBN_Z|v)XSTm!Rg25C@htNnE-'GYY* o 9!z8@U^xm2"ӓHZPC7=A}C]˫Tj"@F54Nny?R92 endstream endobj 771 0 obj << /Length1 1626 /Length2 13148 /Length3 0 /Length 13995 /Filter /FlateDecode >> stream xڭveTۖ-5@ !8Hp ]ܾ}{OQc|{\sEI(jfgufdeb(lL\Tlx?@w;'"%#dg+a h@S ngthj3W㟞L'-:CՀ@%`J:iE 4h (A) H 0sqٚj͉K ` pӀ@\ { rX8:5Enn7!{Gw;#^UYB<-zw#L]jo;̻dp;U09ك=k;# trzyk:_7{mwr9;Ll5Mk[lY[s;+?f._;CN0#2+9TfAW5/>; hlxc-(zh\lcZO}$ﲰ0r͔AΦsckؚ [໮o>uK_p5wRMYR[KZJy\T~_guwng;<#&fbd0s߽wB\,>MɿXulrwI`$mMZ5gc[MO_nSGw]@S9;S Ԍ49#ݝ%vR6x+k^[=f_vv;?%O}i1Vڸw JPҎfaphn?;"cSڣⴣ7@`~/8'iGKOJ;4Aǥ>juE7:Ä"Npp2cBnщ~HS*7)ƙ4^ėSY$}7qu'{punH\$Zmo/45O!wɓ|md :N?>vH;jÄw薬y-zb"hi;mw-YڢqMm>iphRU MX`x$)HTnb?Lk AL4pomY *HI=II= a‘s~̡LE0O)™abjA(3xϚ_śO+¯p&B1ɏ"S"^ vqI}qVӷRf*4e 4nox㲜̑?tZZsWn-?Q,Q'\qpiIljk>MzuJ)ڧ?8L HLxrq'p~g/%%X }w[D!KLm)۾'8!-ƇH;`]:ėn_ |5SXR,Jvʄ:aF`ބ,*6ոKAF}#ha責o 8Evb^db:d?ya$Z0E싒Y&f6mʽĺy%gKqnC=u=8x2TriAy ~qEPֆ^Ĥ15g8VEw~+DDBRRr`&Zh"}d޼dYlSl1 >dd_bq)ڨA:n avrx5`*lW=3Jn\IJen“{hXBB8o/6'hܨýaC8B-EG~Y-/2.sUg:#=$Zأ#Og֩Na^~N^|)Dz$J$">,/ͦl4DKd Daà\N g< ޘRM$LJjQEEsPWP`y 炮 ~S] {"Ȇ~:kЊ -7F^@aJWz,oCڠuKN gOA|tRimjpS XeMx]>guT9u ؁-on5ځJO 3fX_׻nF!l;ownnqq5h(H{ UҌT14?sdAKtpBMp/L9U` EG, $JL]R_A<}MFr0OJՀgyiob5{huL &sS"򌶎XTHynxmñUN51Mt{Md=ل|˷P}fG*4}5ozUt;[^!EB_5ﾖ-TVʒx?]Fb a5Gł*s*WĪdÉ \].e;)8!C@|_﷬X?*b(ڢd?_\$ӥ dwi:=efiW ޒjpGC$!!N$LFGpɑ XhwxC % fYk:H=:-^L ]b !Hkj"ׅ4܉+2*= ܪއ63:&CM]cѕ8l =t/eO BSbVE/&(Ɓ:rGv<#]Zv>㣾uKYHn79'ْntώm "Nr3@D@:h&Q flu^v7A1q S%  0Wb/ۿW'lԬ֎R&[;W1 {0oqn0/*pwg]|%-ޫefZOH |=D.-qvQWec~k)wmf\IS"Z+aU%V2j80qp  G a4CN -i=kT!RF-˝Rnij(%ػ#CM,H`ycj}!?u~x>}Mhc{F?LOnUw٭yxpp7gݓ4"F=_ =toNuuJD9mA'Pޜ P9®?}r׭,z+  ىVbj[<2E>% tPEmJ |- 8m? 5c4Đ0)<ؼg2GF(˭8[#Ja*dVPGz1;շlht_[~JI:\E]^>@~۾;!+cyug3=,J;;eIGgŹ eIaT"|clfoKK1Foh2Bڇzƿ\z!5-$'.Ÿ33[>O y'et;EL3 {Rv*avXXDReӼ6"um679bxrb% m?$))) KBRb-ȖtunF7,:2 QEiErE?LS-H&ؓ MVw$w/T<nb vhq?_FLv|ir_stƼݦWNI[vSFDc{DWI Ȫ*mIɽWT5Mϟ;C ۊe8i]SpK `:sy<%0eX(.W6]<ʶ5 rrG05 LL.d #$49A`r@GNh x=Ax^}UHj6xV1V}hҏgoQPF>" oDȮT#s1ҠW5ysALe'ID6L %eUrQ|WBm\ J^܅m}'^}*e\X Dj NglV 6 Jzό_2MOLGo!MľY C-W\ǣ\} {c5"Ph`AħPo%%{ʃJN 9Ef{(\{!aiTMӛrK-\XsH+BXo@hLzj0VrXFM!ʃ`3ެ8p@oEuJ]>]@A(c92#e][^y󃂺O Xz{bG'pSbjدvFlQYŗ3A73YtfHyl^oi i|HO\ᡑ493o/R1p~RD=|g5/ vng=uӮS+Z.z"Xߟ.A-9GWT813KA|jL i;r}'>qhsL3IcM؁[OxtTdԷ0nP2C5GŁϖ'](=f"&!ΏC FvSTb2 rKu!;ؽwgܧn/XJTˈu v)򓑒ꉷcކcR }a]/d섌g4t-{ mk@Ӎ/=f zQPణܱ`K 1lO1pB1 94P130 Irgޭ,u4'V6됿80q`KW2##[*U-$_eH<=ūCG Ks0wuK+Hv5v'*s?UtC 'O'a!\m/)FMA! }|kDԴئ#k%~c뿧7 "D^5SsɻUx+lkU廛5^qKSQI96]|v, QImo4?EjݽVXXGxaEmTrs4԰*E v]zݙ!HM h=O> QOZZ/jSb9ȈĢ0z$ӧ! Y")V +y5}^UMF0IV3m m;evtu(BV@\]=9ˁ#Z, 㤪}K̏ gOI"JE;Q2dd XVl.0i*^eZ^sG[ĭ2kN/5(rX]t2}'0o`>gMqBh1yF=ӌ; Rs t:EL masDC\—!H,'0q㿕(nib@zP-O4yGu|6,&h#[4بa 7C5ob8DB8 v\8I$몫΁ڙaxb=u~QzS?i4߷֐GѴ&1NjPPxdL,&ƖwiNB7J@ s0~%!5BRL|ÁK1;C`߾ecaTW|rƒ/M{ Q$sD7A q%*+W8?ś4/.b ·`߳Ӡ9ahSz2j'SW߇eGcZ[K?I`~n HdK!u(Ep l`,7yhΘ0|~\CJ~k<<Ֆq)'+\XR&? Y; ^~:w$NXǏ=2|[P.T,+\)\~pkc~7 ۼ ((9=xe],>C%'frNn3u Ai׈us Α4Hi+WE*ՇET_SΛd`~ g&CG2@B3_^b?Ud`bgǸ^ @OKhD?~(};|i}OCHMn/BLܬw)~1l5RElU4c<=ocT`\O2RY) Vxo͔]4>9[7!¤YP3$KŸT;;N`_GK#ǎ)tr6$:e?|zk)F8(L?9$m %ȹ褙o\@lXybܙ_Ϙc%kK-)H4VqPTL+ % 1:~~'> y|KF~phʪkOYlyѣN3~Y-!(he\;S 9F/+4suyl>dCBV\#vM*;5snP{ ;A%}܋nP:"~쪶'^/s .;js9$f,A ? 9prÕc~ҥd& 0FGgՋJF_ru8mYw7YlʙQ'%Ƶ/],>s.fڄpGFf5UH )J4əuETzOE!Aq'^g1?Eۜd,/[Ytpl&(ײO6`?MݞB.UyvC5? J%/ zac5ۗc<;Jgo0lf@*LEV,\vc&qBBedp=i'BA$,r=fme/UY^@W,0s?F`® [ hǤӁC򗝮ya+kuFi e=rb!I}Os!WY8_E$ocٟR?IY"pUYW '~Er@pұRǠ5Ez3oVRF.usr8 ƒ}蒤+Hǭc~aBB^?8 #5yduki*Wf%ԵˍL7+ك=DQ˵O|0 f-C@c+_[>1OxscخՌM-b (mZ{90KZ~v:5}gȆ}$-7!qu4u b,B'0ry\/L*52lYŠ'>@n)jwSFkp#l H[7;Y_«Q>Ί8@[fyGG鵞^x=O+ }<%g X ~Yu}9_Zۭh΂Rlʂ9KT~J]*9zgKv}_e8xtJg2Xh%׏-vX!lohY\N[?]Zv"V[M.j1Q{tOvrGj)*)GDO.1+G!yE^¦E h8Cȉ$ MalY;^ (bkkELFe]έ=Q6yX "Nz6'72zw]-LYZ~`A1[>ϑ nLk2:%jt!g櫟{ip=NCh!Yn"4*ek=ѩqꊰ>ԻA\gзyy,ݑ)m7+d}FT,_LX9 ASH$f#A*/anrएwڕIc/>ϸgE!J(lqvhXFM (ǘ!D)3'/ugUhDx3 N0vy1u-+4SRNdq|[MV`Pb` $לAJ}?+iM% ^,}VlGD]!Cgƾ,|AɯqSMX>M<;h)db2Vr 4tN!P ;׎cFJqpo਱jVxSK2զĆ*Ei8K;ddc.vyu95sxϺ 3FvIR[,8 }moȲ V1 .|T'*P|Zu`a2ӴvR&Ƅغr[z8CNo=2YSC,QM?n&57R6/^O6B$nb|xw`Cc ͰoIn DLgro\wi~S(dž1`7(f|_n`u1n0+Whs%5A1!sC ̙Uevdei`798&CTC*pJуiD*iau%4{LI:VnHUK2!O*3^XV9s%O'԰_E:h*W~'iNC)DraZ@@P/"e Nk'MaywG?uRTNHkBq&)!2cþMs=,?ZUKwqߊFjڭ¯ռ@C 8lyjrếJ4RVnSP3kqd&xR!cQ'f%Pqi+~f7V[QVxCQl!+W^=Гl.m*Xւo/MۿلaE w9f_&<;u"z=I9T9AVͲsce6{`b`6gx*u0_;XZ3J,Y>0qx̚ IjcTㆲ,3[B wHoul~r{fߗR')2&ܘ*z#{YR_+d( >i9OO|m(܈@? sI\N*UiF7Ĭk%8j)@ &Ǩi/5pdևpC} OM6xdNH6H]6{L[=c.-*,t'b_?Ik|%K=t8\Fjaqd/' +s*4VZG/6z΍B/(YGtƧ=Ҍ#,=]Mˉ޶|`na>5ʾ]u:+ ^?q}Uft}ceGRrǑIKi.Fi|HO!6k LO_,v=|&cq$$AL|ywN0~D8v4" f dRN-/U:dP!d+b@΢E! ~+Ʊ?Ѧ9uw=[#q[Ϙ+ HT/ qAQ r &#Rcl)`u~|U۹aCP뾔sDT>v,(LӤ @C*t4l,wH*SH2 endstream endobj 773 0 obj << /Length1 1630 /Length2 18243 /Length3 0 /Length 19077 /Filter /FlateDecode >> stream xڬceݶ%mGm۶m۶m۶Ȱ9uVO[[s1Zm)650qaė16pvT吢Q06u+g"!t0w2w2W5626gdg"sw075s'WVPO?&hnjO/111(>2!1տ6FH#>_7c7CcTv掎MmMl_ 뿺`rNvN ;O'3}b;Uۚ45t:8;9Jo`vJ?3w06w02vt gKvvVʄoLCMmq[|ˍCb337r726ue>(o!7r+G%ZJF{]26 ?Jomn֪N&-mLRCOKoߞKlcd`enc -m!*cZ_?*fP 8)T#mk?غ{003`d߄5M?OFQtҷ1;mS/Zj}֐+"-3ݩ=wdJHsx$خQƶ7-lR6i}Hx͊7:ۛq8N6B5fIjD^xJ^A gȥ0! 4lh|td*'K' ]݅ͱj9U1Qc)f! 7!=Auht cQ/5ބ଒N}׊e/geG94"oDr~Lx#1zvtyuHY6_|$¼pu~I:N޸<=Jir4#<4 \#-B(/ʙcl7 TL[T-5t#ֺJ^0c"m[7qFҙ[IԨA6sujDbh4G[J}No ~%UnEBzd.Vv.95{&k5mͺemęXਦ"+Mv7K`庸)YvӔ߂ RHg?_؆ p\F;L*XXOAyZƒL; bF_;-Z ͎@SdK_RgOA90j&̷V~;Z `g(\ U)|SR]<% EnQ-teb52+WV{컫Ef34 V#*ֹwT0x6毵H:*4u}6YzBVG\:s ?!/> "2+(]({i 6"r7t)xsWnkEPį>dANCyrՈvn 3\y0,Z8]Ć|IqJtʂ?j}y '~@6#M" B S).+6-db^KU?jj #L,s{G 05Z\ a֥ۖk&2D<\,*MA=}CcpqiUiw$s2&5$}E秊>/OȃO8ި" |.4xtm qH|乖< 32\ch>!k}ĥZCg̴֞ oF3ׁ( =Z\*}k٭r%9b<#Qj݁?t|Ƭm=˱f j8< 8Nʈ" 0~ A(Oh'{uORVXnD WK_{/>&:*69Ix֪ĊnM`ݛh=^ wk*F^!%p^>Mf~,NZ͖{thgb8sMv4.>4g:S$AKCM:65pfHw$ ,ɺqd̳n ko0X%|Z]9N{vK;d_bd [E"1\ѹ OH_/6SW{=趢;, tL\Fl򼛂I7X'NSt) ~Zo&kNݺwiuLR; «?JyrIazVu ;ϊ}(൉ 5o zMcYPO&ئ&7ONg'QrE-TĻg[3/Q%OuG)_S d_Zp,oo3/~coRdh==Ҝ,.Fb^xJ/o0yG?|Pܸ ܼ]W*XvTX-o siqIEOBl =_WxA?VU:b2Q,)IqDE^c3K lSR3'_&*V,8uj/q3BDŽb ':( i=l=ƧNVż] D!dkfɂ`uVMf;FXK,v{0}E.U(-[4PiѳUv,PIao¢Fiklk*;G~ꇰ9!7ς͆i# ͕;cA SO)VX"@}D~s,)K=A#x@ɞgs sXXd-{8ʳ ו( Bz)wu4t&G^2f&׻Yt@qݲyf!A#`'v 2yevmuZHiˬg9KpD C* J#L\l񰭯[WS ܚC t.~O]UAwhnd;8N*?Rba!I^>F-c\jE$Xl"Ĕ=[a}nhm㯹ạ#܏YWAIfMҡ8>'Η 6_%!|o>\QhSEu쌌f`>h_$ydqxY͋ cQ@j'bp8|H'ޒ*+N\X``HMQ9d*b14gyZ)HW7spĤ]vEn9~=GW:bRRc.2uou\[q %)\δ́"BCW5K3({z:Lhh >e$CB\\(2-sEE* ;i9BmuLQw %Mނ7fPyj;U3?qY NSO{ƴ̉ +YA\wXwqƟ໼MFJ>H24Ocz*LiF;ne;xi|mV+D0wzq HL>wKڜyO#riM jtFgYֲ`͛,,WH@TdqtXFV,ػgNdER9 .CơП@t _̃ AZ^)gsVU^Vw=/&SBct t &ėuvfyZyh,r(K l_'G-L)Pb^ѡf3^|b@IM`W~`GTZ.eg]oȖԷMǤzC8hi|a_BphF[JT5I $DI5b,7Y< QMN$0{L-f,'qgz.4$T- J'} V9pv7 {e"ImAMʙ|Eyu[W1eJJPg其'W mHḙ DVO"ܯxrO0J #ߝj?/Y ;< j P$}FBNJ_4,*6y_!(kp4gMGi Oޙ=Sۤ'x_Qb\8cRə3gqM>Fxp8JoRtP@'C wgst/.n֞wUݝOyӋV/vҚ]1vna.p߁2Z~5~XOT2c fJ3<²?QvCGw[vA }aJ ۄ> 8!w]j`u'PYL"LJ R2"z2xxtz_v G$[gN]Vz3.1_63(1PX҄0xs[(JK fir+9;u_[esT*dwFi8&11Ln^H3)=]@xVK3NC÷/B`~Aka~|!}mБK'6`߰Ct901ٺ}熤H-u7i8܂Vprl=rSt^V3ޯ!kt^*_k m<Đ`I3]Ȟ/nK) סRonV0%Lckֿ/B"BgO,O.lP]<"&z|OHQQmHHGZH VS.HR;Vj V kMO6}wU'ozyC:;O)[ui0 @{kЂ)P_i8{zu_?=Ȧsiz)LA62Ub*"<ӡ5l`Αƈu 5U#+PTwMӰ Gg~8yPE$e|oX4Ԗ 20S7KMt0/PO,!'9y*@  .lQL}L&u/wc#avN$'`)_04̉"^ E=oX8c-4 n QD֣|vy4#S2ͫKX#9?MH'*YPphhpi/X*ZͿ eF9ŷz˗F 7rL^AEH!?#m|5X̴t@欸DqֿWd&տ s$ \#d"b^M{lϞ?fs8wdv^%@Ap$zuz_ DHDҝ|30: sY' cFP|"Ď:yG[FK^P ?kҔȔ.dAo G:>FsORp|~%KmxulU k]-Tnq%/ZmY3:?Z¡'aD W5vܫ ա }< sn1VF^|X$p)Nu7[p3Nxg)@Lu@eV;t9RDP\"@4mcD<_ &rܳu_ kH3T%yQVnN;tG *"ݹץi<9M3UqnzQ?#W Xi14L4(Qu}V|ڿGS@m `@\Y`KP"ǣ#=VWUdLJIYfbN9Śj= = J>&` gY, d5ap-LO'#N9h-etKokzLj뛱, g @7WQSoVUGֱ-|eH%blv7G.f⡴&z#:-].gh0. RGhp$ak:R9Fg bl+)7YAv#ecD:ŧ"p::J/ 1γiUv4X.9*)O78^T9̈́쐈M?չBq8(c# 4y%}M~AM{;E8(0) T;mOďp@Od#ḛ4Ef.&wy,0<@Aw>67k&u[R?u_vwв29Wr ց6;e}`T^1>9D3EV|Kk+^N΍kvCAt@~$sI_w0>g_v zڎ50e$ iqvp-X .Pjqє8ݮ{[:pu.*6BF}|$j |f-xcWCєPIP2@ENk!BmUIFzp YQ,[(n<1Ԃu:V?0~v.fIly$`0_;0kI`G_*wۘWZ&@c & MFt'Z_e=#f-іꘛd쾔6tppP3紗c~[}'?^?d>pfqQWk(zo78ڔhrOn}@@l~^/DA3K<,X,$I$,l5h^ N#@q+\gSOrA}bB|$4lcLh|5{I1Hn2 >S? $mnT^,ab, @m?gY:Z;c%$xD{׍HP*- L 滩KHfb"sҒrx<'ZڧcnҎL WV&Kj`oUQm2P´ej߆w䮳%$ ɍ(2h& q$왍:Rb,_ߣ_~wy_~j;;Jݵi) c_T"Su]vwA Z>o7%jMI' ָ}f2_ff!!MmyO yFP8~&ŗHFLlEWGDs9\D,lPHq'Ptk9k֖,2:3$PnN[/&̵|K|Cw,QIk#G #p>Ah[pd3 oh %OmT"wGU]DuM^Ok'zUHJJw8jeq-t[{=]y,C lͤ>&V?Iyw7NL]CR/fc35h3u+%?pFXx$u)okRh'8bN5/+nBČOEi.d+5jЈ;zV %5xC)\AR~B5[?[ښS.y& +F;`s3!vi5-@8R(ߨ$\3 Rkz`4X:`h A?Vkoj[̻ xM*gکHB]3`BYп?$r{jc[\ٌzVYgsaPŕlq 3]Xpd[Pb lZony؊{V[49%s5L!jlbYy|v)Z%dR=w0%UAjUJy{Ij("VvG)v>qhCOc?I;1[\ǐShOؘƜUpRo@.BOgLnzLr ; ݐbhť&롙L@^-}SY1ZNggL-V/Xw!a>yM@eH64;[}:m]JxwV] wVJ_vZ3v;ӦՒdd1PUϱERO9:H;jrPXY8А$wȫl=tfxm&ư\kžHc7H?AW#pMƲ~`4\nza)<Ğ[ g$fP[}m58 SɠݫX( |*VLC ߖ1~ e'{?/v_焙(RҋBsl.E =`@:bӭ.yK mwU*5-/+>Ψ-*XjiOO»uniH ſ!#9<qKl ;1u܈XڝmVr6`}-rND9g9;㗙냿z=[|B0ΆJ)a2&X` }oY0ju9wVPB #)cHU6cءĨrD()AM %D1|/zLaExލ9rf kDsFcWhu ~/pzS$ gh~@ɛ}) S&6y !Y'YPaIh(LUM)vgq!oFTWER\|z*xy86@r6SkCa+fR6e1JShkej/=Lޠu%Lu:pFv|6 R+lzgJbUV qd*ť6qbktԒ2089$Z Areyň(q̄VWm$zwh: 7NJM~TN7VV#JFQ{=N[Y?ՏzIt+d<`s쐒QGc8 E;V@υ pKfLK7$em`\ҘC4G7n|3*tzŸT)OY@T^ +5YR$Q4鴠|0QTL 2:LzJϼ}ګqa piʏزɤ n-'R7RvZ9@A B:OVBg^2;4i]..wf@)JER?0!13> qBlacouL{2mF2|D Ģ6YvPZ㉂<s JXYSȢR2ME!mHoYAI#de0H$5[} y֯>ʊ8[{{7OGe_,*yG-@L'ٔYw*z*)K}^↯ [&F`p_'Ng#BWcH잩Ú\u#.2o0cjq a 1$0q=.jic V 5ıQW~ <̔]0231}2IYvLF%':f^{8E.Ów@i,vbyIWT$ E.6 xpYu {PH-Ȣߦ!݇UX{㋣}JV;JZn|K]Vi};h pOH3PN$>rgM.j=.-UcрmըCaY aƱdjIc"Ce si6BMH1r4!NQ|ą^'=G8>/R6g~[d>=ßsD7Ԫoufۓh!ѳ$k j Ȕ1`Y92؀3^ 5@>@Bҙ V\uQ"u'{f8N4 o[ѻˣ;|FL%ֶH";+#:Ȗ׏㉺Z-d /'1{A tG0GyPHuߩ8'=!+crhdT'O~B>6R,7bW!\DM/_#`PSo+ثb[Ieh6$&hc+;92^ &5#>`MӉ%ᚾx4P(}a_xDadg뀛 k@ׯY|(Mڳ,s .CboΨy<^FO4C=+s"x$)vjV0,~sWQpJgKp\,g0yrjOEcS}` 7TLsWTO@(f蒹Ozp{cŮeULO Kb=gj: ƕbnf{cu; @.xX&NɄ-D[4hZɬdG0I'nqeLk 5NL@=`"9)0݃AN_ۉ]qKoȺ6ćӰwxgf 4GA%f*N6O, QS˭T1%Ḓd*#,{N$~gط\$Zٷ[ڐ=]GC27N2ѝJdZ AAE vc w/Hajnq*nտ- tW?m4J LvtLj*PZ cgDJj !2r"] uGyEeaQk 41`oR3$Zᔓ@i"Iܝ3-8&r݋VRB=} ~(3SmR%E $LLvsW౹d}O;7S'Ӝ\? (cH)7g뤎EJE\17V8 hxā}̻?˕H]5zx|OQ#ƞ2 y#9gR Z^Uɽ(6Oae|wqYS NVN#1l6c3;q4 { _Si3!u *>L^ӼqՓ os-T@yYƥ2K*:ǂ[=fӿ6Gq&p˵D&;5%jnYRGɮ6m5ş҉*Dg# K[*ULjn^dqzAF(j"짨*5HOocgqrVTᒿj>ye9ڏ*NR?B飠CnF.q0^#(d#yQO@6Ul7^^~fn60IEF3_]Ө&ǫBw4RNLyvǂǦ/u_z €5,5jX 97͏h/D$> ӛf(4ME KTR4<ősTsdbUSkgwڧmxϦ//5z"(zm5~p_vCxd ҐpYg٣kLEJWԵ[_H=v}dr+"%iBmz:[} $ %o ~ '*Mz3, /B`OBs9y5$||3r2?܎װjS\٤J\Q,=eGY9?,v^@hŞ2EIIc-sZ5$9JhD=4hb;?9z 鉶&4^!^ʔhީ]":MZ=?샟>]r#f0ҧM[TV[-0;pBL?44䮋x~k m$sjlif\ʼnQ}6߲O $y0, e: S^R|[8WZ Iop|:GGAЛz%I H Yuh8_T䶭Ȑ.;=p.aH\*h\ЊtĩEBy]]bqespe (14h8C&@`}GMg3٧88߷j(Hdf4Ú!-JL"du|)w d~Цn/+Z ==cNQDs# #ogkLyFbf IٞL:,_S. >p< d油3DZ|P}J%ﲭu]ktWgIļAų˷'SYbA:(x$jy}x?<6\- S@}_ۭO' \ĥcy`W3YٽN3d)FɆ_ʎ|nN*UKMмE ir* J4tThXs5Sih/"7[w26Ñ(R{)/IhUl2㪂Ivy1 *Zb}<3;˜z$i9isI'A#,+a)τO [:?I2ow8$N1_7Of_u v&f?I5Ķ]ȺO3sE7Q4Y7Bk15 'ŧXg6hH ,!R#ߦhhԲvjeٻ.> stream xڭweT]ݒ--sC@p Kpww]Bݾ}{OثYUk֪3PPٙ8))2\Mm"#d4uI9LJHwpYY;hԵek Ȼ ~p;cG l Xl U]9e@:bf 2(́`' `l4'w.1')hzw@G;7r4;=6u+w 98ڿ{T흜A΀Nw`o寒iQgS tw+`rr5xN; '_0V@'wwN_uK{?s9;m-c;ǶY9=v b@ǿ{OlZ"(;TfAW5/>;{c)>k#ு2\M@#w!V 1q1s r-TAKSۮ:ڂw>w'V4Au1=9mfY+5=do񟋿^Ll|&v~9a&bZgefeekeo4R`s{Hlzi 6wqt|Wi^?_ h`o.d\=8.=P\YWiWf\\?1+O7܍cKӕ <%C_na `1*FI;юSAָQ3,d#=ko>)h'ԉiG`zv bLq}%9{8֙< xaPS%jhD_Vm! ⽤oKӄq%pqg5CK,RP|L[d[@ cE7asB ~]|G#21(|$ k;4RDV0ַu&9d dAn61#=Y}CI!nx[Efi"?B %7>9RI)g]*`Y^GB*Ey+ۏ94ǹ {v] J]ys|Q9A|%,U$+6qhMYQA貧^归jnDzYך*vԛp)i';,ba]6;Der>u;tސt\u(̷* sJ̈-uK@Y;ÎMSHG#K ,>6'&( ƲLkA TEWng3G eOo?0kTDE &;*f]k(@sNkzp41 >)/2(!olk]d.^giJ|k8Nس)"] EE}f[nmIYM5zBM#gf8bĨ!vHtװ(|@>ЧX'i~َ KZ#kkxhJ&U0ɽE/}SDj+ SE  Ĺ,Zi!&n};*1Ы9<9'ʷw]zvl;-8ag-:jK:u>t#M$/)AUzrk}hy?A+Щ0IrFd}^hEy=%}%,B##m`#;I0)qf ݊/-@[=dθT2A Yq@ rPI*!dW xAH)m;ZҶ9"8%٧O#_Elԟdh\/$cjGP04C/ÌYl}ƾG؛Wtod[CSYis$hE;E鷩[#,ɀ욜* GQ?}UˢmfaTs?\:RYUCi*Ѳ H ݇vBm=Lϼ_fvF\Cq wC\ٟ5F% ;WB[%烮Y"WVʧd.;b0BF/SyX4}T)]M_jDfc*)mѝ :^o9kM0壵?qq\^hYLNvNr&?%YRdDbFY2 wCgΞiκ2cOG*COEc`BIhU$Y!~.q%#^ۇ&fvgKh@pl0߁&I5L=IC V#gdWJIA0tMMCO.?ߖ,~XqIGl Ix,4BX̟N7gp;)m84ScT[ħβ3mfWZa$l>kˣ?|)J2+ljQLπTM:Q?ܠFeWb)X%ZHح Z;th`.dG~9+~C0h']3u[#l1lkXt9sRjYe^]mʜ#:[+HȩG%ۥ;hlҸe^lK (񥚚պ&*J_9.>NKA4csqW="G^嵶͖9*g,\NF@͌ŕhmzA)E0RKrϿ&jy~S _^7S8$4_ *@;͓2&wuFHfl3t"~hD. 񐙹8S=1LӜ6i/Kl%!6d.K/z/{E?d%4",J0ZI%T5}" g=c\yD&wJ7YsqC؉-^8T~%`<_ò{H!SM?;f7zŴ7'!h~1{ܝ.Y5*w9>3 gq e3вoח([T}܁OJN1sV\' ۲֬ (d `Ρi%E7f_z\?aH=f3YR]] 3+ n~TXKc g(+>ɐ#8np6Q4 6+/&;LhKοhrjZ|CՌpXX_G86= >^Ȓ}YVj]]:o {˨>7^i $1`BTlP"Gwj)h2&DIԲ0Ll|uĿ8}q H^T^$SNArK;b yht˯FVO;Y-qI⬢9@9?]% wYlYgd]6ltx$i+j']xk/G8#^3i~.XsvHڡҪߏe+Ȓ ɟ v?0c)<ڛP <\(pƶakLn(:xɲvwstCq jdke: YF޸hH &>*LpVy~@S5\C= 1l)w>Owjx$o^>Ysj-8}IlXwPudl$`M1-3%*?j'u>qk]F(aWw6Tj>ic7 a]]%Ld!վ6拃#!kL#",캛z⨇ $8=dl[^)cV= 'y>zTy,-\a;r5h Uڮӥ-$l㼛P_aoףWƺTfՊ\U%\Yvp L9iLD.W#,ՎEm*_ FNr(ŨЮ[Jw㘈+mgFX?%*ICjY[k_l>R=męM`Xhfevْw]z:Lo~AŹ$ 5 gn߹X|bʎ涼-bk|8ʯ ⓤPTZ]֐C\.e_ثDEJf}$&&$i5Kyٺ4dW͕AL6e4.YdUK& hGQ~UƯ$zɩ1+j֧zˆ5P#)KYi&:9/J͞S>T,.gcIH tOLDT'< lyyglXi熿z@"Ŭ$E$CèGd

d(pnw4"aVNd6YN*ʿx[_%;V~YAcD >y{*m>V1:<9E.2ܔtAz4(;<$ŕ{'U6b.J?jKmKp7U7 p 5['43FYmЕwmX~qgV3OK3Ȓc"Wu|sxb)ͺξxH<6q+A KGщ|q1L߭2J/zlF^NvԲ{n nHәlrSiW7v?&2Ų3^Y _A;8wCmSʟ8.iK{O D3{?l+vg*]K&A> 4]_L6ZyI1; $3c{mbC,{lI&;Fԧ4Y1Z8-dܓB|Uh ?m:T# (iɻc9:M> e% Ӕ F'|$TV? }K64qBPu1T1PnFzi rIL'{ۊɑ+=7Ͱ7v*/O~6 s³IW=ȥW 9ن~= <]gY+ k[݃G&G"505aY鱆._ϯvxc5+$=n. ,ûVwhaPԊ@ 1lorbatzXf*WW<}(k%fHOj%i=ȍz, c7iz+P|3bP{k~OP(zR%znp.]ʉ*HGʝsJtx]>i;'+2*Hdݘ1v7^3XAENc.^zΌv-}lug;%2+U"<7Gg㥘;-Bd D{#rb_{8|fzk7|gQopPI رl';z FU:@8_b>s*8 5ʹԻ̕5kSV 7f"G8#Q _ad𪎖8+P- Au}ũHdWl?~0ذ& MĮL7 Va{Qòk!]m#",yXqUBA&Z ­'I1]7 n.&3;2ywT7š G CWPڌOy$-&T}DaV9C¡#֖Iy(~=J }#=F)9|z5<ղrem? -T݈nE;2]uLKT&gWiDš hq"UJoϸ[rC}?z^7~SBWo(?YCazȣ3`1#<ˇ}ňгv抢;m ??L!<~e%OXt_֭g91^ I2 A(ź4IfMEjuuYy}#ʌ'|WE;?bx{¬CFen3RdsCdi q4)BJ )Ydm2hOG]"wʺ.32=z䚋~zRfEѺD8@Y>#( I:-zĝŜQPa}s=.1ᝲcr)- E&KaɔPj[>Y̡#kkA1l&0&u,`Ħ5Gww6حկ{Ʈ]aD.E8`ʳ9F٨Հ K!T&(j:&.r`6LdJ b+{":R}G>,@#2!ǟ|_,j05=LlYr=2G[Usw9w"X*ʫx"aϕ7q]QPjl ֟5TCҵ ~Z/rV]P}uI Wv+Mͧ;6ӏ[j}tznB|Lcl[/!Oj!}L$ƂdU԰[.c{ܶ`|*Y!QO!VO5֖|_PLN Q&!TY4!F*I瀟7rkb;yGOcXn|8p(sEaR%^*JELM9O9QBC`ceb!F WϟQ=yFv,ڒ>TGZCaI>7Tmi6z7ú[SnVrL[^]Y'7' wY !(deB֦[cvW/RA,GIy.s47ZK{Ʀ+wm ω{/ĝ6Fgq (<I%Z3j-U Ј4QR/G.H#9.B1ޠƒqzμ ʐĝ9x!M&sDD!O Xqq{RqK1 AlN䅎-!k'y~@шf4.@(zPOXa5#z]oJ=wĶÅ iIuơ-2+)KV?1 aqsç$o jbTj󂛪h+3H 1Gf#7"@t.-=Gs;^8Z@XCփ+hKVv4BR+{c<Ƀczc^8uѿ>An 21_kv%bZ% lԵ Qj hCrv"˚ƅ&l/C$MnkxhĬ~S=T.\?';=Gr=&&^_`I:d|9>!Яߎ5)72(-[@trϏ!V%bUWNb-uR*!?V@֘55_[#S#!7Pܳ4~[NTRdyp\3~&˺-՟j06E"tFaai,m7}^z] WA\Ow.'cNX]_B%Q.+iiD^]B! ![ A<]\jfja1e-_Cyai=8՗pqsrWlwnL:#.`t9Oa~>2VWG3؇N3CQB)]ƕʣ1;f^z&;!%_#cPP>OKWe):nFl+8N`6WY )3~kzezU9_ faK;?_D3XmSmFyQkj{\ $/.a@gߖf-Vϥj0c9)gki-tomFD'R]s FSdr{gld5slJ"S#HM:w|\cw0 kڔ/4[$tTïvǘGw-1.Z5GX==7 Q3h-9n>ح4EjU: <׫8_μb8 Qb5( _d?rř6E}JJ۝wo8{QѮ2#;*]IÞCULD^$ge'd8CqNpƑ_|iE0tW#MB;VVed>Mcʄ:X~㝠蚒m~C2iwyqŋ'}6[utܺ 7H /lÐ~Rh4vY'H5ʍp_91~IvrT&ƲЮC"{Txe;?HV 2$):F>|OU"d,ō4ob{G/?9>S/IݩG5o_2F K!ܪ5VoUT44<2#XS;#g =9J($ lxG2Ĭ۩v4g۽6tJVd N Y|5w 4}aB7N(r;; ѫӾe'cbׅ? zK[.FƳHdؒVVB̻][?Kxq]_I8f+_e ,<E4f,h?iÿh6ߚ}Y&.BKJَ^ndG!jcϳB$$vt^snNeڊ0Q34G ]./%FG `% ȑ;j-}^$`X}m+M܉kSPߪ:c+4}_mxR.杊›&a"${?x74ŏoIt endstream endobj 754 0 obj << /Type /ObjStm /N 100 /First 939 /Length 4895 /Filter /FlateDecode >> stream xZ[s7~ׯǸ|ITmmĉ/Ma,94FeC78=bK>C6| q ]bHcw Ĺs1.šQȀ:]As%.PqG) ]$hH'ĎAT:b8x9]t>tbsH9}wEtсI%Rp-A2`D 9g]*ԥQ EFAF1")˨\hĆ4AlH(q %EYO8 f 2A*6\ ?$Hņ, :q>jņY"a$6^lb#ЀQ{HFDGً 2V, e kbBHlai%#AI琐dekǃ8" b3rLؐTl#<f-؈G? s?eɽl9} E6GPc|9(HPqއr I Mre>†}ϱa]OӳD7D hX~-rnBoc*½}@ B<(Uǡdw.yX5}ϯgq& d3,6MuӌT1 3r'UˡI5$+WDh ﺌ8aY/,-y-ؖΞemsUX*Γݾ盡>nqN,,_ Cor +ꄯ<>7ƒRp7sX̞hTW1%>52HճYܿ27;*V/e>7T!-a߶l}}%BO9wף߭br{q3ٗ=/={\ͮO?p_ڛsݕU&˝W\o޼iG=@vAru9~pt-W7{>_NOQpeIm)CAp^|y9{u{=ze`alE4NpybNs\q J:=*G'Y{EgWgIo6ӓ /OjVFtr] e< \=;['T{_|:_7۫MbޮMOX֟ub}u4@"7ۓծj{>yuZ:߭6ӻ/b~_o/m_H؎ۃ.Yɋ6Yիrfv,PDfI 7Sɡ1VDzf` u+YyyCOz)H߬$HnOOnzrz)EC$t"yws{|7I `ӅӺIҵFPK}IVt9y{W>)[U z4ߛ F~  ? qK/_1qS3,OyVr1Я4v/xpp޺7oے.uNf0a4NI\ծ@+ P&0¢֬&H[!, ad 0Y5ZI1E,lcLfXTek)U*md:9 ps5 ܶVvF2jG@MV=Vhu۞~Ǭ*VU@PM%R@e5N!̢`E *m,`fQ:c65YU`8 KgAWKH`M@@@s] H[Xpʃ3}7}u޻v.(XrCX<40Ю0Ka0y` 0` r[ B0B`-0h9P 20Y,y/\v6Y+.%=Aʱld8烵<<a}ծÀh" ALhv@QzCJ[ CRP@9x0rssmB'-y,`l8c'F=A0 Bl7pK!Sd#glFV,7֮&VYJ,t[ V*m h\@`L`L`L`L8PP' ! է!: jBJ[ g2"P?6WLOF꧖UJ TP?հ;J@d}b@@axU`w P?Apյ'֮&șw P?A'k OT݀ծÀhXnW/zB#@#t(CE@;OhB#@)xґDdw@Kd}/ }Y_@ (֮rR^*hȚB@v'P DNJExN5Vd|B+Ax/ t d}K,[jzUP:} l_<8+nN]ܖ,(Wic.\Me^]D:F'@KUJ ci}J:vATNKi"мtg=t 0lʨbΠ{z5S uDžRɠt6gP:ٞl a6~f0%3H]a.qAlI0T]6Jf.%3Hcikvgp+%3 dcamrª] XKjtAc)K'p^bCv 6\M!~ƍ(MUJf;ظ1ٸ1}67Fp#7Fp#?v.Raq#vmlqJfƈS2EAF2ƍL#2_vԐ*5 6uѨ1ʢQcQFFѫ v.&;JGit00j`fAV"h3UJ[h(.[uHGfn/6ojjWa@nF;:+DGe42 rv1TK)cgSF_L۷Ѫ]j?e endstream endobj 901 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.14)/Keywords() /CreationDate (D:20180801012435Z) /ModDate (D:20180801012435Z) /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-2.5-1.40.14 (TeX Live 2013) kpathsea version 6.1.1) >> endobj 849 0 obj << /Type /ObjStm /N 52 /First 457 /Length 2109 /Filter /FlateDecode >> stream x}XMo8Wcj:AJ>df M~dq"gN%=&)sd78N#r%ޅkp]+8bqeGCG,dFf)x Q$(e ^I ;? < *gvrĹ Ž|rsw9 @KtBd P=W\ š(b1"IdXXF)@eςL3ge..?b 鈹J* 7 XFޥAp .Q’ĸ&€{ R\٥v:evӉļÉћEYV4K2ܗgs-xbͰ&VRK\c d-'j )7OHj pM`A`dB(2wj[qsbU2AAT1 ũa0!ü1dbz IƐj k',T)d`SPƩ ȓ˅Vl Ml +T))x/o:`xo UUb : /ɀ U9Ě͂Ẑf5*9{X"'X&<,SH)bA V mu8SH)$e 2 14xz"!L(2$z%;`xo E&CQ%dzz۠z\|XqDy ʛQ ʛ"ח87+,d,FJ0B,7Il"؇"+ P&$( 7B>kJF%S5 cpV{\mQIB ʦ*eexw5=^HTRU|@BUqM`GMH"/NwCyZBzL_-lխ.'M˜8_# Td(g~^o-8w")즉Կh(z)Z wvDE C#KJ.-x.5^E&EEO*d yTZz(z(z`=Е8'iu;YO< }B{(/[MҦ ۢf8q}*/-ɂB n-e'稼f-*}^7RHa_zg@8BS$1*Z9wY{=֎apjRYXyOַ~U{֞KyPY/keͿ5r]5_˚~Y/;ҋ5_ z?=9kY=}~xE3M~zx~㯣[J/I}\p6}뿿=6NΨ|i=N멍rE6J262mT{a G$1X4h#H@I#(ի8G\\?zzb0z׏~#ٯӛ?|wdA!R endstream endobj 902 0 obj << /Type /XRef /Index [0 903] /Size 903 /W [1 3 1] /Root 900 0 R /Info 901 0 R /ID [<69755E09C384CF788D529FECC086932A> <69755E09C384CF788D529FECC086932A>] /Length 1942 /Filter /FlateDecode >> stream x%׹\IWmό=>{=>Ʒn}nZ -$BHE68$dH؈J+OM^u{]B7(p躱كy0 ! 02ybXKa rhZ `g@;ZXalM&a l)aLN i vqh \'aoxi<8G?[ y鹣 =igCa8pnt}8p N8 <\޻ \knn7܆;p}x<'| Ϡ ^sѻЍ=|f_T]`mnrB7IJ\J ((=6]}___A_______T],NnDEEEEEEUw . $ $ $ $mDlH\XeegC7;(((((xeee]$j#j#j#j#j#j#j#j#6޲5{UxFB3R {􇶩q{ymmmmREEEEEEEEEEEi'""""bZ*)(((((((((}LnAEEEEEEEŔQQQQQQQQQTLEEE ŔQQQQQ/CvU(7̈́omyȢH7@@@"JOeQdQdQdQdQdQdQdQdQWE\lQ>8z0 ,6q"X K`)2X+`%qX k`:X`#l0 [`+L6;`v}}~ݡ,3~8#0 G8p N8 <\pUnmw܇cxO<0/7{`?g~f?g3~f?g3~f?g3~f?gH>'_t%%%w. g3yg3Lwk`gg3~f?g3~f?g @֧}K0X!"X KҠǦ X?Ms0/ V?oSЖaL E{`> X6p pNI86 nsp.E \kpnMejwK߽lmY܇cl?g^W`-7/ۑ߁$$$4y-ϯڦJM^?I I I yIII4iO:Y`?O'~b?O' áT?w endstream endobj startxref 165155 %%EOF plr-REL8_4_5/plr.c000066400000000000000000001503751414122415700140070ustar00rootroot00000000000000/* * PL/R - PostgreSQL support for R as a * procedural language (PL) * * Copyright (c) 2003 by Joseph E. Conway * ALL RIGHTS RESERVED * * Joe Conway * * Based on pltcl by Jan Wieck * and inspired by REmbeddedPostgres by * Duncan Temple Lang * http://www.omegahat.org/RSPostgres/ * * License: GPL version 2 or newer. http://www.gnu.org/copyleft/gpl.html * * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * plr.c - Language handler and support functions */ #include "plr.h" PG_MODULE_MAGIC; /* * Structure for wrapping R_ParseVector call into R_TopLevelExec */ typedef struct { SEXP in, out; ParseStatus status; } ProtectedParseData; /* * Global data */ MemoryContext plr_caller_context; MemoryContext plr_SPI_context = NULL; HTAB *plr_HashTable = (HTAB *) NULL; char *last_R_error_msg = NULL; static bool plr_pm_init_done = false; static bool plr_be_init_done = false; /* namespace OID for the PL/R language handler function */ static Oid plr_nspOid = InvalidOid; int R_SignalHandlers = 1; /* Exposed in R_interface.h */ /* * defines */ /* real max is 3 (for "PLR") plus number of characters in an Oid */ #define MAX_PRONAME_LEN NAMEDATALEN #define OPTIONS_NULL_CMD "options(error = expression(NULL))" #define THROWRERROR_CMD \ "pg.throwrerror <-function(msg) " \ "{" \ " msglen <- nchar(msg);" \ " if (substr(msg, msglen, msglen + 1) == \"\\n\")" \ " msg <- substr(msg, 1, msglen - 1);" \ " .C(\"throw_r_error\", as.character(msg));" \ "}" #define OPTIONS_THROWRERROR_CMD \ "options(error = expression(pg.throwrerror(geterrmessage())))" #define THROWLOG_CMD \ "pg.throwlog <-function(msg) " \ "{.C(\"throw_pg_log\", as.integer(" CppAsString2(LOG) "), as.character(msg));invisible()}" #define THROWWARNING_CMD \ "pg.throwwarning <-function(msg) " \ "{.C(\"throw_pg_log\", as.integer(" CppAsString2(WARNING) "), as.character(msg));invisible()}" #define THROWNOTICE_CMD \ "pg.thrownotice <-function(msg) " \ "{.C(\"throw_pg_log\", as.integer(" CppAsString2(NOTICE) "), as.character(msg));invisible()}" #define THROWERROR_CMD \ "pg.throwerror <-function(msg) " \ "{stop(msg, call. = FALSE)}" #define OPTIONS_THROWWARN_CMD \ "options(warning.expression = expression(pg.thrownotice(last.warning)))" #define QUOTE_LITERAL_CMD \ "pg.quoteliteral <-function(sql) " \ "{.Call(\"plr_quote_literal\", sql)}" #define QUOTE_IDENT_CMD \ "pg.quoteident <-function(sql) " \ "{.Call(\"plr_quote_ident\", sql)}" #define SPI_EXEC_CMD \ "pg.spi.exec <-function(sql) {.Call(\"plr_SPI_exec\", sql)}" #define SPI_PREPARE_CMD \ "pg.spi.prepare <-function(sql, argtypes = NA) " \ "{.Call(\"plr_SPI_prepare\", sql, argtypes)}" #define SPI_EXECP_CMD \ "pg.spi.execp <-function(sql, argvalues = NA) " \ "{.Call(\"plr_SPI_execp\", sql, argvalues)}" #define SPI_CURSOR_OPEN_CMD \ "pg.spi.cursor_open<-function(cursor_name,plan,argvalues=NA) " \ "{.Call(\"plr_SPI_cursor_open\",cursor_name,plan,argvalues)}" #define SPI_CURSOR_FETCH_CMD \ "pg.spi.cursor_fetch<-function(cursor,forward,rows) " \ "{.Call(\"plr_SPI_cursor_fetch\",cursor,forward,rows)}" #define SPI_CURSOR_MOVE_CMD \ "pg.spi.cursor_move<-function(cursor,forward,rows) " \ "{.Call(\"plr_SPI_cursor_move\",cursor,forward,rows)}" #define SPI_CURSOR_CLOSE_CMD \ "pg.spi.cursor_close<-function(cursor) " \ "{.Call(\"plr_SPI_cursor_close\",cursor)}" #if CATALOG_VERSION_NO < 201811201 #define SPI_LASTOID_CMD \ "pg.spi.lastoid <-function() " \ "{.Call(\"plr_SPI_lastoid\")}" #endif #if PG_VERSION_NUM >= 110000 #define SPI_COMMIT_CMD \ "pg.spi.commit <-function() " \ "{.Call(\"plr_SPI_commit\")}" #define SPI_ROLLBACK_CMD \ "pg.spi.rollback <-function() " \ "{.Call(\"plr_SPI_rollback\")}" #endif #define SPI_DBDRIVER_CMD \ "dbDriver <-function(db_name)\n" \ "{return(NA)}" #define SPI_DBCONN_CMD \ "dbConnect <- function(drv,user=\"\",password=\"\",host=\"\",dbname=\"\",port=\"\",tty =\"\",options=\"\")\n" \ "{return(NA)}" #define SPI_DBSENDQUERY_CMD \ "dbSendQuery <- function(conn, sql) {\n" \ "plan <- pg.spi.prepare(sql)\n" \ "cursor_obj <- pg.spi.cursor_open(\"plr_cursor\",plan)\n" \ "return(cursor_obj)\n" \ "}" #define SPI_DBFETCH_CMD \ "fetch <- function(rs,n) {\n" \ "data <- pg.spi.cursor_fetch(rs, TRUE, as.integer(n))\n" \ "return(data)\n" \ "}" #define SPI_DBCLEARRESULT_CMD \ "dbClearResult <- function(rs) {\n" \ "pg.spi.cursor_close(rs)\n" \ "}" #define SPI_DBGETQUERY_CMD \ "dbGetQuery <-function(conn, sql) {\n" \ "data <- pg.spi.exec(sql)\n" \ "return(data)\n" \ "}" #define SPI_DBREADTABLE_CMD \ "dbReadTable <- function(con, name, row.names = \"row_names\", check.names = TRUE) {\n" \ "data <- dbGetQuery(con, paste(\"SELECT * from\", name))\n" \ "return(data)\n" \ "}" #define SPI_DBDISCONN_CMD \ "dbDisconnect <- function(con)\n" \ "{return(NA)}" #define SPI_DBUNLOADDRIVER_CMD \ "dbUnloadDriver <-function(drv)\n" \ "{return(NA)}" #define SPI_FACTOR_CMD \ "pg.spi.factor <- function(arg1) {\n" \ " for (col in 1:ncol(arg1)) {\n" \ " if (!is.numeric(arg1[,col])) {\n" \ " arg1[,col] <- factor(arg1[,col])\n" \ " }\n" \ " }\n" \ " return(arg1)\n" \ "}" #define REVAL \ "pg.reval <- function(arg1) {eval(parse(text = arg1))}" #define PG_STATE_FIRSTPASS \ "pg.state.firstpass <- TRUE" #define CurrentTriggerData ((TriggerData *) fcinfo->context) /* * static declarations */ static void plr_atexit(void); static void plr_load_builtins(Oid langOid); static void plr_init_all(Oid langOid); static Datum plr_trigger_handler(PG_FUNCTION_ARGS); static Datum plr_func_handler(PG_FUNCTION_ARGS); static plr_function *compile_plr_function(FunctionCallInfo fcinfo); static plr_function *do_compile(FunctionCallInfo fcinfo, HeapTuple procTup, plr_func_hashkey *hashkey); static void plr_protected_parse(void* data); static SEXP plr_parse_func_body(const char *body); #if (PG_VERSION_NUM >= 120000) static SEXP plr_convertargs(plr_function *function, NullableDatum *args, FunctionCallInfo fcinfo, SEXP rho); #else static SEXP plr_convertargs(plr_function *function, Datum *arg, bool *argnull, FunctionCallInfo fcinfo, SEXP rho); #endif static void plr_error_callback(void *arg); static void remove_carriage_return(char* p); static Oid getNamespaceOidFromLanguageOid(Oid langOid); static bool haveModulesTable(Oid nspOid); static char *getModulesSql(Oid nspOid); #ifdef HAVE_WINDOW_FUNCTIONS // See full definition in src/backend/executor/nodeWindowAgg.c typedef struct WindowObjectData { NodeTag type; WindowAggState *winstate; /* parent WindowAggState */ } WindowObjectData; static const char PLR_WINDOW_FRAME_NAME[] = "plr_window_frame"; #define PLR_WINDOW_ENV_NAME_MAX_LENGTH 30 static const char PLR_WINDOW_ENV_PATTERN[] = "window_env_%p"; static bool plr_is_unbound_frame(WindowObject winobj); #endif static void plr_resolve_polymorphic_argtypes(int numargs, Oid *argtypes, char *argmodes, Node *call_expr, bool forValidator, const char *proname); /* * plr_call_handler - This is the only visible function * of the PL interpreter. The PostgreSQL * function manager and trigger manager * call this function for execution of * PL/R procedures. */ PG_FUNCTION_INFO_V1(plr_call_handler); Datum plr_call_handler(PG_FUNCTION_ARGS) { #if PG_VERSION_NUM >= 110000 bool nonatomic; #endif Datum retval; #if PG_VERSION_NUM >= 110000 nonatomic = fcinfo->context && IsA(fcinfo->context, CallContext) && !castNode(CallContext, fcinfo->context)->atomic; #endif /* save caller's context */ plr_caller_context = CurrentMemoryContext; #if PG_VERSION_NUM >= 110000 if (SPI_connect_ext(nonatomic ? SPI_OPT_NONATOMIC : 0) != SPI_OK_CONNECT) #else if (SPI_connect() != SPI_OK_CONNECT) #endif elog(ERROR, "SPI_connect failed"); plr_SPI_context = CurrentMemoryContext; MemoryContextSwitchTo(plr_caller_context); /* initialize R if needed */ if (!plr_be_init_done) { HeapTuple procedureTuple; Form_pg_proc procedureStruct; Oid language; /* get the pg_proc entry */ procedureTuple = SearchSysCache(PROCOID, ObjectIdGetDatum(fcinfo->flinfo->fn_oid), 0, 0, 0); if (!HeapTupleIsValid(procedureTuple)) /* internal error */ elog(ERROR, "cache lookup failed for function %u", fcinfo->flinfo->fn_oid); procedureStruct = (Form_pg_proc)GETSTRUCT(procedureTuple); /* now get the pg_language entry */ language = procedureStruct->prolang; ReleaseSysCache(procedureTuple); plr_init_all(language); } if (CALLED_AS_TRIGGER(fcinfo)) retval = plr_trigger_handler(fcinfo); else retval = plr_func_handler(fcinfo); return retval; } PG_FUNCTION_INFO_V1(plr_inline_handler); Datum plr_inline_handler(PG_FUNCTION_ARGS) { const InlineCodeBlock * const icb = (InlineCodeBlock *)PG_GETARG_POINTER(0); char * src = icb->source_text; Oid langOid = icb->langOid; /* initialize R if needed */ /* save caller's context */ plr_caller_context = CurrentMemoryContext; if (SPI_connect() != SPI_OK_CONNECT) elog(ERROR, "SPI_connect failed"); plr_SPI_context = CurrentMemoryContext; MemoryContextSwitchTo(plr_caller_context); plr_init_all(langOid); remove_carriage_return(src); load_r_cmd(src); if (SPI_finish() != SPI_OK_FINISH) elog(ERROR, "SPI_finish failed"); PG_RETURN_VOID(); } PG_FUNCTION_INFO_V1(plr_validator); Datum plr_validator(PG_FUNCTION_ARGS) { Datum prosrcdatum; HeapTuple procTup; bool isnull; char *proc_source, *body; Oid funcoid = PG_GETARG_OID(0); if (!check_function_bodies || !CheckFunctionValidatorAccess(fcinfo->flinfo->fn_oid, funcoid)) PG_RETURN_VOID(); procTup = SearchSysCache1(PROCOID, ObjectIdGetDatum(funcoid)); if (!HeapTupleIsValid(procTup)) elog(ERROR, "cache lookup failed for function %u", funcoid); /* Add user's function definition to proc body */ prosrcdatum = SysCacheGetAttr(PROCOID, procTup, Anum_pg_proc_prosrc, &isnull); if (isnull) elog(ERROR, "null prosrc"); proc_source = DatumGetCString(DirectFunctionCall1(textout, prosrcdatum)); ReleaseSysCache(procTup); remove_carriage_return(proc_source); if (!plr_pm_init_done) plr_init(); body = (char *) palloc(strlen(proc_source) + 3); /* {}\x00 */ if (NULL == body) ereport(ERROR, (errcode(ERRCODE_OUT_OF_MEMORY), errmsg("out of memory"))); sprintf(body, "{%s}", proc_source); pfree(proc_source); plr_parse_func_body(body); pfree(body); PG_RETURN_VOID(); } void load_r_cmd(const char *cmd) { SEXP cmdexpr; int i, status; /* * Init if not already done. This can happen when PL/R is not preloaded * and reload_plr_modules() or install_rcmd() is called by the user prior * to any PL/R functions. */ if (!plr_pm_init_done) plr_init(); PROTECT(cmdexpr = plr_parse_func_body(cmd)); /* Loop is needed here as EXPSEXP may be of length > 1 */ for(i = 0; i < length(cmdexpr); i++) { R_tryEval(VECTOR_ELT(cmdexpr, i), R_GlobalEnv, &status); if(status != 0) { UNPROTECT(1); if (last_R_error_msg) ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("R interpreter expression evaluation error"), errdetail("%s", last_R_error_msg))); else ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("R interpreter expression evaluation error"), errdetail("R expression evaluation error caught " \ "in \"%s\".", cmd))); } } UNPROTECT(1); } /* * plr_cleanup() - Let the embedded interpreter clean up after itself * * DO NOT make this static --- it has to be registered as an on_proc_exit() * callback */ void PLR_CLEANUP { char *buf; char *tmpdir = getenv("R_SESSION_TMPDIR"); R_dot_Last(); R_RunExitFinalizers(); KillAllDevices(); if(tmpdir) { int rv; /* * length needed = 'rm -rf ""' == 9 * plus 1 for NULL terminator * plus length of dir string */ buf = (char *) palloc(9 + 1 + strlen(tmpdir)); sprintf(buf, "rm -rf \"%s\"", tmpdir); /* ignoring return value */ rv = system(buf); if (rv != 0) ; /* do nothing */ } } static void plr_atexit(void) { /* only react during plr startup */ if (plr_pm_init_done) return; ereport(ERROR, (errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE), errmsg("the R interpreter did not initialize"), errhint("R_HOME must be correct in the environment " \ "of the user that starts the postmaster process."))); } /* * plr_init() - Initialize all that's safe to do in the postmaster * * DO NOT make this static --- it has to be callable by preload */ void plr_init(void) { char *r_home; int rargc; char *rargv[] = {"PL/R", "--slave", "--silent", "--no-save", "--no-restore"}; /* refuse to init more than once */ if (plr_pm_init_done) return; #ifdef WIN32 r_home = get_R_HOME(); #else /* refuse to start if R_HOME is not defined */ r_home = getenv("R_HOME"); #endif if (r_home == NULL) { size_t rh_len = strlen(R_HOME_DEFAULT); /* see if there is a compiled in default R_HOME */ if (rh_len) { char *rhenv; MemoryContext oldcontext; /* Needs to live until/unless we explicitly delete it */ oldcontext = MemoryContextSwitchTo(TopMemoryContext); rhenv = palloc(8 + rh_len); MemoryContextSwitchTo(oldcontext); sprintf(rhenv, "R_HOME=%s", R_HOME_DEFAULT); putenv(rhenv); } else ereport(ERROR, (errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE), errmsg("environment variable R_HOME not defined"), errhint("R_HOME must be defined in the environment " \ "of the user that starts the postmaster process."))); } rargc = sizeof(rargv)/sizeof(rargv[0]); /* * register an exit callback to handle the case where R does not initialize * and just exits with R_suicide() */ atexit(plr_atexit); /* * Stop R using its own signal handlers */ R_SignalHandlers = 0; /* * When initialization fails, R currently exits. Check the return * value anyway in case this ever gets fixed */ if (!Rf_initEmbeddedR(rargc, rargv)) ereport(ERROR, (errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE), errmsg("the R interpreter did not initialize"), errhint("R_HOME must be correct in the environment " \ "of the user that starts the postmaster process."))); /* arrange for automatic cleanup at proc_exit */ on_proc_exit(plr_cleanup, 0); #ifndef WIN32 /* * Force non-interactive mode since R may not do so. * See comment in Rembedded.c just after R_Interactive = TRUE: * "Rf_initialize_R set this based on isatty" * If Postgres still has the tty attached, R_Interactive remains TRUE */ R_Interactive = false; #endif plr_pm_init_done = true; } #ifdef HAVE_WINDOW_FUNCTIONS /* * plr_is_unbound_frame - return true if window function frame is unbound, i.e. whole partition */ static bool plr_is_unbound_frame(WindowObject winobj) { WindowAgg* node = (WindowAgg *)winobj->winstate->ss.ps.plan; int frameOptions = winobj->winstate->frameOptions; static const int unbound_mask = FRAMEOPTION_START_UNBOUNDED_PRECEDING | FRAMEOPTION_END_UNBOUNDED_FOLLOWING; return #if PG_VERSION_NUM >= 110000 0 == (frameOptions & (FRAMEOPTION_GROUPS | FRAMEOPTION_EXCLUDE_CURRENT_ROW | FRAMEOPTION_EXCLUDE_GROUP | FRAMEOPTION_EXCLUDE_TIES)) && #endif ((0 == node->ordNumCols && frameOptions & FRAMEOPTION_RANGE) || unbound_mask == (frameOptions & unbound_mask)); } #endif /* * plr_load_builtins() - load "builtin" PL/R functions into R interpreter */ static void plr_load_builtins(Oid langOid) { int j; char *cmd; char *cmds[] = { /* first turn off error handling by R */ OPTIONS_NULL_CMD, /* set up the postgres error handler in R */ THROWRERROR_CMD, OPTIONS_THROWRERROR_CMD, THROWLOG_CMD, THROWNOTICE_CMD, THROWWARNING_CMD, THROWERROR_CMD, OPTIONS_THROWWARN_CMD, /* install the commands for SPI support in the interpreter */ QUOTE_LITERAL_CMD, QUOTE_IDENT_CMD, SPI_EXEC_CMD, SPI_PREPARE_CMD, SPI_EXECP_CMD, SPI_CURSOR_OPEN_CMD, SPI_CURSOR_FETCH_CMD, SPI_CURSOR_MOVE_CMD, SPI_CURSOR_CLOSE_CMD, #if CATALOG_VERSION_NO < 201811201 SPI_LASTOID_CMD, #endif #if PG_VERSION_NUM >= 110000 SPI_COMMIT_CMD, SPI_ROLLBACK_CMD, #endif SPI_DBDRIVER_CMD, SPI_DBCONN_CMD, SPI_DBSENDQUERY_CMD, SPI_DBFETCH_CMD, SPI_DBCLEARRESULT_CMD, SPI_DBGETQUERY_CMD, SPI_DBREADTABLE_CMD, SPI_DBDISCONN_CMD, SPI_DBUNLOADDRIVER_CMD, SPI_FACTOR_CMD, /* handy predefined R functions */ REVAL, /* terminate */ NULL }; /* * temporarily turn off R error reporting -- it will be turned back on * once the custom R error handler is installed from the plr library */ load_r_cmd(cmds[0]); /* next load the plr library into R */ load_r_cmd(get_load_self_ref_cmd(langOid)); /* * run the rest of the R bootstrap commands, being careful to start * at cmds[1] since we already executed cmds[0] */ for (j = 1; (cmd = cmds[j]); j++) load_r_cmd(cmds[j]); } /* * plr_load_modules() - Load procedures from * table plr_modules (if it exists) * * The caller is responsible to ensure SPI has already been connected * DO NOT make this static --- it has to be callable by reload_plr_modules() */ void plr_load_modules(void) { int spi_rc; char *cmd; int i; int fno; MemoryContext oldcontext; char *modulesSql; /* switch to SPI memory context */ SWITCHTO_PLR_SPI_CONTEXT(oldcontext); /* * Check if table plr_modules exists */ if (!haveModulesTable(plr_nspOid)) { /* clean up if SPI was used, and regardless restore caller's context */ CLEANUP_PLR_SPI_CONTEXT(oldcontext); return; } /* plr_modules table exists -- get SQL code extract table's contents */ modulesSql = getModulesSql(plr_nspOid); /* Read all the row's from it in the order of modseq */ spi_rc = SPI_exec(modulesSql, 0); /* modulesSql no longer needed -- cleanup */ pfree(modulesSql); if (spi_rc != SPI_OK_SELECT) /* internal error */ elog(ERROR, "plr_init_load_modules: select from plr_modules failed"); /* If there's nothing, no modules exist */ if (SPI_processed == 0) { SPI_freetuptable(SPI_tuptable); /* clean up if SPI was used, and regardless restore caller's context */ CLEANUP_PLR_SPI_CONTEXT(oldcontext); return; } /* * There is at least on module to load. Get the * source from the modsrc load it in the R interpreter */ fno = SPI_fnumber(SPI_tuptable->tupdesc, "modsrc"); for (i = 0; i < SPI_processed; i++) { cmd = SPI_getvalue(SPI_tuptable->vals[i], SPI_tuptable->tupdesc, fno); if (cmd != NULL) { load_r_cmd(cmd); pfree(cmd); } } SPI_freetuptable(SPI_tuptable); /* clean up if SPI was used, and regardless restore caller's context */ CLEANUP_PLR_SPI_CONTEXT(oldcontext); } static void plr_init_all(Oid langOid) { MemoryContext oldcontext; /* everything initialized needs to live until/unless we explicitly delete it */ oldcontext = MemoryContextSwitchTo(TopMemoryContext); /* execute postmaster-startup safe initialization */ if (!plr_pm_init_done) plr_init(); /* * Any other initialization that must be done each time a new * backend starts: */ if (!plr_be_init_done) { /* load "builtin" R functions */ plr_load_builtins(langOid); /* obtain & store namespace OID of PL/R language handler */ plr_nspOid = getNamespaceOidFromLanguageOid(langOid); /* try to load procedures from plr_modules */ plr_load_modules(); plr_be_init_done = true; } /* switch back to caller's context */ MemoryContextSwitchTo(oldcontext); } static Datum plr_trigger_handler(PG_FUNCTION_ARGS) { plr_function *function; SEXP fun; SEXP rargs; SEXP rvalue; Datum retval; #if (PG_VERSION_NUM >= 120000) NullableDatum args[FUNC_MAX_ARGS]; #else Datum arg[FUNC_MAX_ARGS]; bool argnull[FUNC_MAX_ARGS]; #endif TriggerData *trigdata = (TriggerData *) fcinfo->context; TupleDesc tupdesc = trigdata->tg_relation->rd_att; Datum *dvalues; ArrayType *array; #define FIXED_NUM_DIMS 1 int ndims = FIXED_NUM_DIMS; int dims[FIXED_NUM_DIMS]; int lbs[FIXED_NUM_DIMS]; #undef FIXED_NUM_DIMS TRIGGERTUPLEVARS; ERRORCONTEXTCALLBACK; int i; if (trigdata->tg_trigger->tgnargs > 0) dvalues = palloc(trigdata->tg_trigger->tgnargs * sizeof(Datum)); else dvalues = NULL; /* Find or compile the function */ function = compile_plr_function(fcinfo); /* set up error context */ PUSH_PLERRCONTEXT(plr_error_callback, function->proname); /* * Build up arguments for the trigger function. The data types * are mostly hardwired in advance */ /* first is trigger name */ SET_ARG(DirectFunctionCall1(textin, CStringGetDatum(trigdata->tg_trigger->tgname)),false,0); /* second is trigger relation oid */ SET_ARG(ObjectIdGetDatum(trigdata->tg_relation->rd_id),false,1); /* third is trigger relation name */ SET_ARG(DirectFunctionCall1(textin, CStringGetDatum(get_rel_name(trigdata->tg_relation->rd_id))),false,2); /* fourth is when trigger fired, i.e. BEFORE or AFTER */ if (TRIGGER_FIRED_BEFORE(trigdata->tg_event)) SET_ARG(DirectFunctionCall1(textin, CStringGetDatum("BEFORE")),false,3); else if (TRIGGER_FIRED_AFTER(trigdata->tg_event)) SET_ARG(DirectFunctionCall1(textin, CStringGetDatum("AFTER")),false,3); else /* internal error */ elog(ERROR, "unrecognized tg_event"); /* * fifth is level trigger fired, i.e. ROW or STATEMENT * sixth is operation that fired trigger, i.e. INSERT, UPDATE, or DELETE * seventh is NEW, eighth is OLD */ if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event)) { SET_ARG(DirectFunctionCall1(textin, CStringGetDatum("STATEMENT")),false,4); if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event)) SET_ARG(DirectFunctionCall1(textin, CStringGetDatum("INSERT")),false,5); else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event)) SET_ARG(DirectFunctionCall1(textin, CStringGetDatum("DELETE")),false,5); else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event)) SET_ARG(DirectFunctionCall1(textin, CStringGetDatum("UPDATE")),false,5); else /* internal error */ elog(ERROR, "unrecognized tg_event"); SET_ARG((Datum) 0,true,6); SET_ARG((Datum) 0,true,7); } else if (TRIGGER_FIRED_FOR_ROW(trigdata->tg_event)) { SET_ARG(DirectFunctionCall1(textin, CStringGetDatum("ROW")),false,4); if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event)) SET_INSERT_ARGS_567; else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event)) SET_DELETE_ARGS_567; else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event)) SET_UPDATE_ARGS_567; else /* internal error */ elog(ERROR, "unrecognized tg_event"); } else /* internal error */ elog(ERROR, "unrecognized tg_event"); /* * finally, ninth argument is a text array of trigger arguments */ for (i = 0; i < trigdata->tg_trigger->tgnargs; i++) dvalues[i] = DirectFunctionCall1(textin, CStringGetDatum(trigdata->tg_trigger->tgargs[i])); dims[0] = trigdata->tg_trigger->tgnargs; lbs[0] = 1; array = construct_md_array(dvalues, NULL, ndims, dims, lbs, TEXTOID, -1, false, 'i'); SET_ARG(PointerGetDatum(array),false,8); /* * All done building args; from this point it is just like * calling a non-trigger function, except we need to be careful * that the return value tuple is the same tupdesc as the trigger tuple. */ PROTECT(fun = function->fun); /* Convert all call arguments */ #if (PG_VERSION_NUM >= 120000) PROTECT(rargs = plr_convertargs(function, args, fcinfo, R_NilValue)); #else PROTECT(rargs = plr_convertargs(function, arg, argnull, fcinfo, R_NilValue)); #endif /* Call the R function */ PROTECT(rvalue = call_r_func(fun, rargs, R_GlobalEnv)); /* * Convert the return value from an R object to a Datum. * We expect r_get_pg to do the right thing with missing or empty results. */ if (SPI_finish() != SPI_OK_FINISH) elog(ERROR, "SPI_finish failed"); retval = r_get_pg(rvalue, function, fcinfo); POP_PLERRCONTEXT; UNPROTECT(3); return retval; } static Datum plr_func_handler(PG_FUNCTION_ARGS) { plr_function *function; SEXP fun; SEXP env = R_GlobalEnv; SEXP rargs; SEXP rvalue; Datum retval; #ifdef HAVE_WINDOW_FUNCTIONS WindowObject winobj = NULL; //set to NULL to silence compiler warnings char internal_env[PLR_WINDOW_ENV_NAME_MAX_LENGTH]; int64 current_row = -1; int check_err; #endif ERRORCONTEXTCALLBACK; /* Find or compile the function */ function = compile_plr_function(fcinfo); /* set up error context */ PUSH_PLERRCONTEXT(plr_error_callback, function->proname); PROTECT(fun = function->fun); #ifdef HAVE_WINDOW_FUNCTIONS if (function->iswindow) { winobj = PG_WINDOW_OBJECT(); current_row = WinGetCurrentPosition(winobj); sprintf(internal_env, PLR_WINDOW_ENV_PATTERN, winobj); if (0 == current_row) { env = R_tryEval(lang2(install("new.env"), R_GlobalEnv), R_GlobalEnv, &check_err); if (check_err) elog(ERROR, "Failed to create new environment \"%s\" for window function calls.", internal_env); defineVar(install(internal_env), env, R_GlobalEnv); } else { env = findVar(install(internal_env), R_GlobalEnv); if (R_UnboundValue == env) elog(ERROR, "%s window frame environment cannot be found in R_GlobalEnv", internal_env); } } #endif /* Convert all call arguments */ #if (PG_VERSION_NUM >= 120000) PROTECT(rargs = plr_convertargs(function, fcinfo->args, fcinfo, env)); #else PROTECT(rargs = plr_convertargs(function, fcinfo->arg, fcinfo->argnull, fcinfo, env)); #endif /* Call the R function */ PROTECT(rvalue = call_r_func(fun, rargs, env)); #ifdef HAVE_WINDOW_FUNCTIONS /* We should remove window_env_XXX environment along with frame data list after last call */ if (function->iswindow && plr_is_unbound_frame(winobj) && WinGetPartitionRowCount(winobj) == current_row + 1) R_tryEval(lang2(install("rm"), install(internal_env)), R_GlobalEnv, &check_err); #endif /* * Convert the return value from an R object to a Datum. * We expect r_get_pg to do the right thing with missing or empty results. */ if (SPI_finish() != SPI_OK_FINISH) elog(ERROR, "SPI_finish failed"); retval = r_get_pg(rvalue, function, fcinfo); POP_PLERRCONTEXT; UNPROTECT(3); return retval; } /* ---------- * compile_plr_function * * Note: it's important for this to fall through quickly if the function * has already been compiled. * ---------- */ plr_function * compile_plr_function(FunctionCallInfo fcinfo) { Oid funcOid = fcinfo->flinfo->fn_oid; HeapTuple procTup; Form_pg_proc procStruct; plr_function *function; plr_func_hashkey hashkey; bool hashkey_valid = false; ERRORCONTEXTCALLBACK; /* * Lookup the pg_proc tuple by Oid; we'll need it in any case */ procTup = SearchSysCache(PROCOID, ObjectIdGetDatum(funcOid), 0, 0, 0); if (!HeapTupleIsValid(procTup)) /* internal error */ elog(ERROR, "cache lookup failed for proc %u", funcOid); procStruct = (Form_pg_proc) GETSTRUCT(procTup); /* set up error context */ PUSH_PLERRCONTEXT(plr_error_callback, NameStr(procStruct->proname)); /* * See if there's already a cache entry for the current FmgrInfo. * If not, try to find one in the hash table. */ function = (plr_function *) fcinfo->flinfo->fn_extra; if (!function) { /* First time through in this backend? If so, init hashtable */ if (!plr_HashTable) plr_HashTableInit(); /* Compute hashkey using function signature and actual arg types */ compute_function_hashkey(fcinfo, procStruct, &hashkey); hashkey_valid = true; /* And do the lookup */ function = plr_HashTableLookup(&hashkey); /* * first time through for this statement, set * firstpass to TRUE */ load_r_cmd(PG_STATE_FIRSTPASS); } if (function) { bool function_valid; /* We have a compiled function, but is it still valid? */ if (function->fn_xmin == HeapTupleHeaderGetXmin(procTup->t_data) && ItemPointerEquals(&function->fn_tid, &procTup->t_self)) function_valid = true; else function_valid = false; if (!function_valid) { /* * Nope, drop the hashtable entry. XXX someday, free all the * subsidiary storage as well. */ plr_HashTableDelete(function); /* free some of the subsidiary storage */ xpfree(function->proname); R_ReleaseObject(function->fun); xpfree(function); function = NULL; } } /* * If the function wasn't found or was out-of-date, we have to compile it */ if (!function) { /* * Calculate hashkey if we didn't already; we'll need it to store * the completed function. */ if (!hashkey_valid) compute_function_hashkey(fcinfo, procStruct, &hashkey); /* * Do the hard part. */ function = do_compile(fcinfo, procTup, &hashkey); } ReleaseSysCache(procTup); /* * Save pointer in FmgrInfo to avoid search on subsequent calls */ fcinfo->flinfo->fn_extra = (void *) function; POP_PLERRCONTEXT; /* * Finally return the compiled function */ return function; } /* * This is the slow part of compile_plr_function(). */ static plr_function * do_compile(FunctionCallInfo fcinfo, HeapTuple procTup, plr_func_hashkey *hashkey) { Form_pg_proc procStruct = (Form_pg_proc) GETSTRUCT(procTup); Datum prosrcdatum; bool isnull; bool is_trigger = CALLED_AS_TRIGGER(fcinfo) ? true : false; plr_function *function = NULL; Oid fn_oid = fcinfo->flinfo->fn_oid; char internal_proname[MAX_PRONAME_LEN]; char *proname; Oid result_typid; HeapTuple langTup; HeapTuple typeTup; Form_pg_language langStruct; Form_pg_type typeStruct; StringInfo proc_internal_def = makeStringInfo(); StringInfo proc_internal_args = makeStringInfo(); char *proc_source; MemoryContext oldcontext; Oid oid; // FIXME same as result_typid ??? TupleDesc tupdesc; TypeFuncClass tfc; /* grab the function name */ proname = NameStr(procStruct->proname); /* Build our internal proc name from the functions Oid */ sprintf(internal_proname, "PLR%u", fn_oid); /* * analyze the functions arguments and returntype and store * the in-/out-functions in the function block and create * a new hashtable entry for it. * * Then load the procedure into the R interpreter. */ /* the function structure needs to live until we explicitly delete it */ oldcontext = MemoryContextSwitchTo(TopMemoryContext); /* Allocate a new procedure description block */ function = (plr_function *) palloc(sizeof(plr_function)); if (function == NULL) ereport(ERROR, (errcode(ERRCODE_OUT_OF_MEMORY), errmsg("out of memory"))); MemSet(function, 0, sizeof(plr_function)); function->proname = pstrdup(proname); function->fn_xmin = HeapTupleHeaderGetXmin(procTup->t_data); function->fn_tid = procTup->t_self; #ifdef HAVE_WINDOW_FUNCTIONS #if PG_VERSION_NUM >= 110000 function->iswindow = (procStruct->prokind == PROKIND_WINDOW); #else function->iswindow = procStruct->proiswindow; #endif #endif /* Lookup the pg_language tuple by Oid*/ langTup = SearchSysCache(LANGOID, ObjectIdGetDatum(procStruct->prolang), 0, 0, 0); if (!HeapTupleIsValid(langTup)) { xpfree(function->proname); xpfree(function); /* internal error */ elog(ERROR, "cache lookup failed for language %u", procStruct->prolang); } langStruct = (Form_pg_language) GETSTRUCT(langTup); function->lanpltrusted = langStruct->lanpltrusted; ReleaseSysCache(langTup); /* get the functions return type */ if (procStruct->prorettype == ANYARRAYOID || procStruct->prorettype == ANYELEMENTOID) { result_typid = get_fn_expr_rettype(fcinfo->flinfo); if (result_typid == InvalidOid) result_typid = procStruct->prorettype; } else result_typid = procStruct->prorettype; tfc = get_call_result_type(fcinfo, &oid, &tupdesc); switch (tfc) { case TYPEFUNC_SCALAR: function->result_natts = 1; break; case TYPEFUNC_COMPOSITE: function->result_natts = tupdesc->natts; break; case TYPEFUNC_OTHER: // trigger function->result_natts = 0; break; default: elog(ERROR, "unknown function type %u", tfc); } if (function->result_natts > 0) { function->result_fld_typid = (Oid *) palloc0(function->result_natts * sizeof(Oid)); function->result_fld_elem_typid = (Oid *) palloc0(function->result_natts * sizeof(Oid)); function->result_fld_elem_in_func = (FmgrInfo *) palloc0(function->result_natts * sizeof(FmgrInfo)); function->result_fld_elem_typlen = (int16 *) palloc0(function->result_natts * sizeof(int)); function->result_fld_elem_typbyval = (bool *) palloc0(function->result_natts * sizeof(bool)); function->result_fld_elem_typalign = (char *) palloc0(function->result_natts * sizeof(char)); } if (!is_trigger) { int i, j; bool forValidator = false; int numargs; Oid *argtypes; char **argnames; char *argmodes; /* * Get the required information for input conversion of the * return value. */ typeTup = SearchSysCache(TYPEOID, ObjectIdGetDatum(result_typid), 0, 0, 0); if (!HeapTupleIsValid(typeTup)) { xpfree(function->proname); xpfree(function); /* internal error */ elog(ERROR, "cache lookup failed for return type %u", procStruct->prorettype); } typeStruct = (Form_pg_type) GETSTRUCT(typeTup); /* Disallow pseudotype return type except VOID or RECORD */ /* (note we already replaced ANYARRAY/ANYELEMENT) */ if (typeStruct->typtype == 'p') { if (procStruct->prorettype == VOIDOID || procStruct->prorettype == RECORDOID) /* okay */ ; else if (procStruct->prorettype == TRIGGEROID) { xpfree(function->proname); xpfree(function); ereport(ERROR, (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), errmsg("trigger functions may only be called as triggers"))); } else { xpfree(function->proname); xpfree(function); ereport(ERROR, (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), errmsg("plr functions cannot return type %s", format_type_be(procStruct->prorettype)))); } } for (i = 0; i < function->result_natts; i++) { if (TYPEFUNC_COMPOSITE == tfc) function->result_fld_typid[i] = TUPLE_DESC_ATTR(tupdesc, i)->atttypid; else function->result_fld_typid[i] = result_typid; function->result_fld_elem_typid[i] = get_element_type(function->result_fld_typid[i]); if (InvalidOid == function->result_fld_elem_typid[i]) function->result_fld_elem_typid[i] = function->result_fld_typid[i]; if (OidIsValid(function->result_fld_elem_typid[i])) { char typdelim; Oid typinput, typelem; get_type_io_data(function->result_fld_elem_typid[i], IOFunc_input, function->result_fld_elem_typlen + i, function->result_fld_elem_typbyval + i, function->result_fld_elem_typalign + i, &typdelim, &typelem, &typinput); perm_fmgr_info(typinput, function->result_fld_elem_in_func + i); } else elog(ERROR, "Invalid type for return attribute #%u", i); } ReleaseSysCache(typeTup); /* * Get the required information for output conversion * of all procedure arguments */ numargs = get_func_arg_info(procTup, &argtypes, &argnames, &argmodes); plr_resolve_polymorphic_argtypes(numargs, argtypes, argmodes, fcinfo->flinfo->fn_expr, forValidator, function->proname); for (i = 0, j = 0; j < numargs; j++) { char argmode = argmodes ? argmodes[j] : PROARGMODE_IN; if (argmode != PROARGMODE_IN && argmode != PROARGMODE_INOUT && argmode != PROARGMODE_VARIADIC) continue; /* * Since we already did the replacement of polymorphic * argument types by actual argument types while computing * the hashkey, we can just use those results. */ function->arg_typid[i] = hashkey->argtypes[i]; typeTup = SearchSysCache(TYPEOID, ObjectIdGetDatum(function->arg_typid[i]), 0, 0, 0); if (!HeapTupleIsValid(typeTup)) { Oid arg_typid = function->arg_typid[i]; xpfree(function->proname); xpfree(function); /* internal error */ elog(ERROR, "cache lookup failed for argument type %u", arg_typid); } typeStruct = (Form_pg_type) GETSTRUCT(typeTup); if (typeStruct->typrelid != InvalidOid || typeStruct->typtype == 'p') function->arg_is_rel[i] = 1; else function->arg_is_rel[i] = 0; perm_fmgr_info(typeStruct->typoutput, &(function->arg_out_func[i])); /* save argument typbyval in case we need for optimization in conversions */ function->arg_typbyval[i] = typeStruct->typbyval; /* * Is argument type an array? get_element_type will return InvalidOid * instead of actual element type if the type is not a varlena array. */ if (OidIsValid(get_element_type(function->arg_typid[i]))) function->arg_elem[i] = typeStruct->typelem; else /* not ant array */ function->arg_elem[i] = InvalidOid; if (i > 0) appendStringInfo(proc_internal_args, ","); if (argnames && argnames[j] && argnames[j][0]) { appendStringInfo(proc_internal_args, "%s", argnames[j]); pfree(argnames[i]); } else appendStringInfo(proc_internal_args, "arg%d", i + 1); ReleaseSysCache(typeTup); if (function->arg_elem[i] != InvalidOid) { int16 typlen; bool typbyval; char typdelim; Oid typoutput, typelem; FmgrInfo outputproc; char typalign; get_type_io_data(function->arg_elem[i], IOFunc_output, &typlen, &typbyval, &typalign, &typdelim, &typelem, &typoutput); perm_fmgr_info(typoutput, &outputproc); function->arg_elem_out_func[i] = outputproc; function->arg_elem_typbyval[i] = typbyval; function->arg_elem_typlen[i] = typlen; function->arg_elem_typalign[i] = typalign; } i++; } FREE_ARG_NAMES; function->nargs = i; #ifdef HAVE_WINDOW_FUNCTIONS if (function->iswindow) { for (i = 0; i < function->nargs; i++) { appendStringInfo(proc_internal_args, ","); SET_FRAME_ARG_NAME; } SET_FRAME_XARG_NAMES; } #endif } else { int16 typlen; bool typbyval; char typdelim; Oid typoutput, typelem; FmgrInfo outputproc; char typalign; function->nargs = TRIGGER_NARGS; /* take care of the only non-TEXT first */ get_type_io_data(OIDOID, IOFunc_output, &typlen, &typbyval, &typalign, &typdelim, &typelem, &typoutput); function->arg_typid[1] = OIDOID; function->arg_elem[1] = InvalidOid; function->arg_is_rel[1] = 0; perm_fmgr_info(typoutput, &(function->arg_out_func[1])); get_type_io_data(TEXTOID, IOFunc_output, &typlen, &typbyval, &typalign, &typdelim, &typelem, &typoutput); function->arg_typid[0] = TEXTOID; function->arg_elem[0] = InvalidOid; function->arg_is_rel[0] = 0; perm_fmgr_info(typoutput, &(function->arg_out_func[0])); function->arg_typid[2] = TEXTOID; function->arg_elem[2] = InvalidOid; function->arg_is_rel[2] = 0; perm_fmgr_info(typoutput, &(function->arg_out_func[2])); function->arg_typid[3] = TEXTOID; function->arg_elem[3] = InvalidOid; function->arg_is_rel[3] = 0; perm_fmgr_info(typoutput, &(function->arg_out_func[3])); function->arg_typid[4] = TEXTOID; function->arg_elem[4] = InvalidOid; function->arg_is_rel[4] = 0; perm_fmgr_info(typoutput, &(function->arg_out_func[4])); function->arg_typid[5] = TEXTOID; function->arg_elem[5] = InvalidOid; function->arg_is_rel[5] = 0; perm_fmgr_info(typoutput, &(function->arg_out_func[5])); function->arg_typid[6] = RECORDOID; function->arg_elem[6] = InvalidOid; function->arg_is_rel[6] = 1; function->arg_typid[7] = RECORDOID; function->arg_elem[7] = InvalidOid; function->arg_is_rel[7] = 1; function->arg_typid[8] = TEXTARRAYOID; function->arg_elem[8] = TEXTOID; function->arg_is_rel[8] = 0; get_type_io_data(function->arg_elem[8], IOFunc_output, &typlen, &typbyval, &typalign, &typdelim, &typelem, &typoutput); perm_fmgr_info(typoutput, &outputproc); function->arg_elem_out_func[8] = outputproc; function->arg_elem_typbyval[8] = typbyval; function->arg_elem_typlen[8] = typlen; function->arg_elem_typalign[8] = typalign; /* trigger procedure has fixed args */ appendStringInfo(proc_internal_args, "pg.tg.name,pg.tg.relid,pg.tg.relname,pg.tg.when," "pg.tg.level,pg.tg.op,pg.tg.new,pg.tg.old,pg.tg.args"); } /* * Create the R command to define the internal * procedure */ appendStringInfo(proc_internal_def, "%s <- function(%s) {", internal_proname, proc_internal_args->data); /* Add user's function definition to proc body */ prosrcdatum = SysCacheGetAttr(PROCOID, procTup, Anum_pg_proc_prosrc, &isnull); if (isnull) elog(ERROR, "null prosrc"); proc_source = DatumGetCString(DirectFunctionCall1(textout, prosrcdatum)); remove_carriage_return(proc_source); /* parse or find the R function */ if(proc_source && proc_source[0]) appendStringInfo(proc_internal_def, "%s}", proc_source); else appendStringInfo(proc_internal_def, "%s(%s)}", function->proname, proc_internal_args->data); function->fun = VECTOR_ELT(plr_parse_func_body(proc_internal_def->data), 0); R_PreserveObject(function->fun); pfree(proc_source); freeStringInfo(proc_internal_def); /* test that this is really a function. */ if(function->fun == R_NilValue) { xpfree(function->proname); xpfree(function); /* internal error */ elog(ERROR, "cannot create internal procedure %s", internal_proname); } /* switch back to the context we were called with */ MemoryContextSwitchTo(oldcontext); /* * add it to the hash table */ plr_HashTableInsert(function, hashkey); return function; } static void plr_protected_parse(void* data) { ProtectedParseData *ppd = (ProtectedParseData*) data; ppd->out = R_PARSEVECTOR(ppd->in, -1, &ppd->status); } static SEXP plr_parse_func_body(const char *body) { ProtectedParseData ppd = { mkString(body), NULL, PARSE_NULL }; R_ToplevelExec(plr_protected_parse, &ppd); if (ppd.status != PARSE_OK) { if (last_R_error_msg) ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("R interpreter parse error"), errdetail("%s", last_R_error_msg))); else ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("R interpreter parse error"), errdetail("R parse error caught " \ "in \"%s\".", body))); } return ppd.out; } SEXP call_r_func(SEXP fun, SEXP rargs, SEXP rho) { int errorOccurred; SEXP call, ans; /* * NB: the headers of both R and Postgres define a function * called lcons, so use the full name to be precise about what * function we're calling. */ PROTECT(call = Rf_lcons(fun, rargs)); ans = R_tryEval(call, rho, &errorOccurred); UNPROTECT(1); if(errorOccurred) { if (last_R_error_msg) ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("R interpreter expression evaluation error"), errdetail("%s", last_R_error_msg))); else ereport(ERROR, (errcode(ERRCODE_DATA_EXCEPTION), errmsg("R interpreter expression evaluation error"))); } return ans; } #if (PG_VERSION_NUM >= 120000) static SEXP plr_convertargs(plr_function *function, NullableDatum *args, FunctionCallInfo fcinfo, SEXP rho) #else static SEXP plr_convertargs(plr_function *function, Datum *arg, bool *argnull, FunctionCallInfo fcinfo, SEXP rho) #endif { int i; int m = 1; int c = 0; SEXP rargs, t, el; #ifdef HAVE_WINDOW_FUNCTIONS if (function->iswindow) { /* * For WINDOW functions, create an array of R objects with * the number of elements equal to twice the number of arguments. */ m = 2; c = 2; } #endif /* * Create an R pairlist with the number of elements * as a function of the number of arguments. */ PROTECT(t = rargs = allocList(c + (m * function->nargs))); /* * iterate over the arguments, convert each of them and put them in * the array. */ for (i = 0; i < function->nargs; i++) { #ifdef HAVE_WINDOW_FUNCTIONS if (!function->iswindow) { #endif if (IS_ARG_NULL(i)) { /* fast track for null arguments */ PROTECT(el = R_NilValue); } else if (function->arg_is_rel[i]) { /* for tuple args, convert to a one row data.frame */ CONVERT_TUPLE_TO_DATAFRAME(GET_ARG_VALUE(i)); } else if (function->arg_elem[i] == InvalidOid) { /* for scalar args, convert to a one row vector */ Datum dvalue = GET_ARG_VALUE(i); Oid arg_typid = function->arg_typid[i]; FmgrInfo arg_out_func = function->arg_out_func[i]; PROTECT(el = pg_scalar_get_r(dvalue, arg_typid, arg_out_func)); } else { /* better be a pg array arg, convert to a multi-row vector */ Datum dvalue = (Datum) PG_DETOAST_DATUM(GET_ARG_VALUE(i)); FmgrInfo out_func = function->arg_elem_out_func[i]; int typlen = function->arg_elem_typlen[i]; bool typbyval = function->arg_elem_typbyval[i]; char typalign = function->arg_elem_typalign[i]; PROTECT(el = pg_array_get_r(dvalue, out_func, typlen, typbyval, typalign)); } SETCAR(t, el); t = CDR(t); UNPROTECT(1); #ifdef HAVE_WINDOW_FUNCTIONS } else { Datum dvalue; bool isnull,isout; WindowObject winobj = PG_WINDOW_OBJECT(); /* get datum for the current row of the window frame */ dvalue = WinGetFuncArgInPartition(winobj, i, 0, WINDOW_SEEK_CURRENT, false, &isnull, &isout); /* I think we can ignore isout as isnull should be set and null will be returned */ if (isnull) { /* fast track for null arguments */ PROTECT(el = R_NilValue); } else if (function->arg_is_rel[i]) { /* for tuple args, convert to a one row data.frame */ CONVERT_TUPLE_TO_DATAFRAME(dvalue); } else if (function->arg_elem[i] == InvalidOid) { /* for scalar args, convert to a one row vector */ Oid arg_typid = function->arg_typid[i]; FmgrInfo arg_out_func = function->arg_out_func[i]; PROTECT(el = pg_scalar_get_r(dvalue, arg_typid, arg_out_func)); } else { /* better be a pg array arg, convert to a multi-row vector */ FmgrInfo out_func = function->arg_elem_out_func[i]; int typlen = function->arg_elem_typlen[i]; bool typbyval = function->arg_elem_typbyval[i]; char typalign = function->arg_elem_typalign[i]; dvalue = (Datum) PG_DETOAST_DATUM(dvalue); PROTECT(el = pg_array_get_r(dvalue, out_func, typlen, typbyval, typalign)); } SETCAR(t, el); t = CDR(t); UNPROTECT(1); } #endif } #ifdef HAVE_WINDOW_FUNCTIONS /* now get an array of datums for the entire window frame for each argument */ if (function->iswindow) { WindowObject winobj = PG_WINDOW_OBJECT(); int64 current_row = WinGetCurrentPosition(winobj); int numels = 0; if (plr_is_unbound_frame(winobj)) { SEXP lst; if (0 == current_row) { lst = PROTECT(allocVector(VECSXP, function->nargs)); for (i = 0; i < function->nargs; i++, t = CDR(t)) { PROTECT(el = /* get_fn_expr_arg_stable(fcinfo->flinfo, i) ? R_NilValue : */ pg_window_frame_get_r(winobj, i, function)); SET_VECTOR_ELT(lst, i, el); UNPROTECT(1); SETCAR(t, el); } defineVar(install(PLR_WINDOW_FRAME_NAME), lst, rho); UNPROTECT(1); } else { lst = findVar(install(PLR_WINDOW_FRAME_NAME), rho); if (R_UnboundValue == lst) elog(ERROR, "%s list with window frame data cannot be found in R_GlobalEnv", PLR_WINDOW_FRAME_NAME); for (i = 0; i < function->nargs; i++, t = CDR(t)) { el = VECTOR_ELT(lst, i); SETCAR(t, el); } } } else for (i = 0; i < function->nargs; i++, t = CDR(t)) { PROTECT(el = /* get_fn_expr_arg_stable(fcinfo->flinfo, i) ? R_NilValue : */ pg_window_frame_get_r(winobj, i, function)); SETCAR(t, el); UNPROTECT(1); } /* below only works if last el <> R_NilValue (see commented out above) */ numels = function->nargs > 0 ? GET_LENGTH(el) : 0; /* fnumrows */ SETCAR(t, ScalarInteger(numels)); t = CDR(t); /* prownum */ SETCAR(t, ScalarInteger((int)current_row + 1)); } #endif UNPROTECT(1); return(rargs); } /* * error context callback to let us supply a call-stack traceback */ static void plr_error_callback(void *arg) { if (arg) errcontext("In PL/R function %s", (char *) arg); } /* * Sanitize R code by removing \r */ static void remove_carriage_return(char* p) { while (*p != '\0') { if (p[0] == '\r') { if (p[1] == '\n') /* for crlf sequence, write over the lf with a space */ *p++ = ' '; else /* otherwise write over the lf with a cr */ *p++ = '\n'; } else p++; } } /* * getNamespaceOidFromLanguageOid - Returns the OID of the namespace for the * language with the OID equal to the input argument. */ static Oid getNamespaceOidFromLanguageOid(Oid langOid) { HeapTuple procTuple; HeapTuple langTuple; Form_pg_proc procStruct; Form_pg_language langStruct; Oid hfnOid; Oid nspOid; /* Lookup the pg_language tuple by OID */ langTuple = SearchSysCache(LANGOID, ObjectIdGetDatum(langOid), 0, 0, 0); if (!HeapTupleIsValid(langTuple)) /* internal error */ elog(ERROR, "cache lookup failed for language %u", langOid); langStruct = (Form_pg_language) GETSTRUCT(langTuple); hfnOid = langStruct->lanplcallfoid; ReleaseSysCache(langTuple); /* Lookup the pg_proc tuple for the language handler by OID */ procTuple = SearchSysCache(PROCOID, ObjectIdGetDatum(hfnOid), 0, 0, 0); if (!HeapTupleIsValid(procTuple)) /* internal error */ elog(ERROR, "cache lookup failed for function %u", hfnOid); procStruct = (Form_pg_proc) GETSTRUCT(procTuple); nspOid = procStruct->pronamespace; ReleaseSysCache(procTuple); return nspOid; } /* * haveModulesTable(Oid) -- Check if table plr_modules exists in the namespace * designated by the OID input argument. */ static bool haveModulesTable(Oid nspOid) { StringInfo sql = makeStringInfo(); char *sql_format = "SELECT NULL " "FROM pg_catalog.pg_class " "WHERE " "relname = 'plr_modules' AND " "relnamespace = %u"; int spiRc; appendStringInfo(sql, sql_format, nspOid); spiRc = SPI_exec(sql->data, 1); if (spiRc != SPI_OK_SELECT) /* internal error */ elog(ERROR, "haveModulesTable: select from pg_class failed"); return SPI_processed == 1; } /* * getModulesSql(Oid) - Builds and returns SQL needed to extract contents from * plr_modules table. The table must exist in the namespace designated by the * OID input argument. Results are ordered by the "modseq" field. * * IMPORTANT: return value must be pfree'd */ static char * getModulesSql(Oid nspOid) { StringInfo sql = makeStringInfo(); char *sql_format = "SELECT modseq, modsrc " "FROM %s " "ORDER BY modseq"; appendStringInfo(sql, sql_format, quote_qualified_identifier(get_namespace_name(nspOid), "plr_modules")); return sql->data; } #ifdef DEBUGPROTECT SEXP pg_protect(SEXP s, char *fn, int ln) { elog(NOTICE, "\tPROTECT\t1\t%s\t%d", fn, ln); return protect(s); } void pg_unprotect(int n, char *fn, int ln) { elog(NOTICE, "\tUNPROTECT\t%d\t%s\t%d", n, fn, ln); unprotect(n); } #endif /* DEBUGPROTECT */ /* * swiped out of plpgsql pl_comp.c * * This is the same as the standard resolve_polymorphic_argtypes() function, * but with a special case for validation: assume that polymorphic arguments * are integer, integer-array or integer-range. Also, we go ahead and report * the error if we can't resolve the types. */ static void plr_resolve_polymorphic_argtypes(int numargs, Oid *argtypes, char *argmodes, Node *call_expr, bool forValidator, const char *proname) { int i; if (!forValidator) { /* normal case, pass to standard routine */ if (!resolve_polymorphic_argtypes(numargs, argtypes, argmodes, call_expr)) ereport(ERROR, (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), errmsg("could not determine actual argument " "type for polymorphic function \"%s\"", proname))); } else { /* special validation case */ for (i = 0; i < numargs; i++) { switch (argtypes[i]) { case ANYELEMENTOID: case ANYNONARRAYOID: case ANYENUMOID: /* XXX dubious */ argtypes[i] = INT4OID; break; case ANYARRAYOID: argtypes[i] = INT4ARRAYOID; break; #ifdef ANYRANGEOID case ANYRANGEOID: argtypes[i] = INT4RANGEOID; break; #endif default: break; } } } } plr-REL8_4_5/plr.control000066400000000000000000000002501414122415700152270ustar00rootroot00000000000000# plr extension comment = 'load R interpreter and execute R script from within a database' default_version = '8.4.5' module_pathname = '$libdir/plr' relocatable = true plr-REL8_4_5/plr.h000077500000000000000000000413531414122415700140120ustar00rootroot00000000000000/* * PL/R - PostgreSQL support for R as a * procedural language (PL) * * Copyright (c) 2003-2018 by Joseph E. Conway * ALL RIGHTS RESERVED * * Joe Conway * * Based on pltcl by Jan Wieck * and inspired by REmbeddedPostgres by * Duncan Temple Lang * http://www.omegahat.org/RSPostgres/ * * License: GPL version 2 or newer. http://www.gnu.org/copyleft/gpl.html * * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * * plr.h */ #ifndef PLR_H #define PLR_H #define PLR_VERSION "8.4" #include "postgres.h" #include "fmgr.h" #include "funcapi.h" #include "miscadmin.h" #if PG_VERSION_NUM >= 80400 #include "windowapi.h" #endif #include "access/heapam.h" #if PG_VERSION_NUM >= 90300 #include "access/htup_details.h" #else #include "access/htup.h" #endif #include "catalog/catversion.h" #include "catalog/pg_language.h" #include "catalog/pg_namespace.h" #include "catalog/pg_proc.h" #include "catalog/pg_type.h" #include "commands/trigger.h" #include "executor/spi.h" #include "lib/stringinfo.h" #include "nodes/makefuncs.h" #include "optimizer/clauses.h" #include "parser/parse_type.h" #include "storage/ipc.h" #include "tcop/tcopprot.h" #include "utils/array.h" #include "utils/builtins.h" #if PG_VERSION_NUM >= 80500 #include "utils/bytea.h" #endif #include "utils/lsyscache.h" #include "utils/memutils.h" #include "utils/rel.h" #include "utils/syscache.h" #include "utils/typcache.h" #include #include #include #include #include /* * The R headers define various symbols that are also defined by the * Postgres headers, so undef them first to avoid conflicts. */ #ifdef ERROR #undef ERROR #endif #ifdef WARNING #undef WARNING #endif #include "R.h" #include "Rversion.h" /* * R version is calculated thus: * Maj * 65536 + Minor * 256 + Build * 1 * So: * version 1.8.0 results in: * (1 * 65536) + (8 * 256) + (0 * 1) == 67584 * version 1.9.0 results in: * (1 * 65536) + (9 * 256) + (0 * 1) == 67840 */ #if (R_VERSION >= 132096) /* R_VERSION >= 2.4.0 */ #include "Rembedded.h" #endif #if !defined(WIN32) && !defined(WIN64) #include "Rinterface.h" #else extern int R_SignalHandlers; #endif #include "Rinternals.h" #include "Rdefines.h" #if (R_VERSION < 133120) /* R_VERSION < 2.8.0 */ #include "Rdevices.h" #endif /* Restore the Postgres headers */ #ifdef ERROR #undef ERROR #endif #ifdef WARNING #undef WARNING #endif #ifdef PGWARNING #define WARNING PGWARNING #else #define WARNING 19 #endif #ifdef PGERROR #define ERROR PGERROR #else #define ERROR 20 #endif /* starting in R-2.7.0 this defn was removed from Rdevices.h */ #ifndef KillAllDevices #define KillAllDevices Rf_KillAllDevices #endif /* for some reason this is not in any R header files, it is locally defined */ #define INTEGER_ELT(x,__i__) INTEGER(x)[__i__] #ifndef R_HOME_DEFAULT #define R_HOME_DEFAULT "" #endif /* working with postgres 7.3 compatible sources */ #if !defined(PG_VERSION_NUM) || PG_VERSION_NUM < 80200 #error "This version of PL/R only builds with PostgreSQL 8.2 or later" #elif PG_VERSION_NUM < 80300 #define PG_VERSION_82_COMPAT #elif PG_VERSION_NUM < 80400 #define PG_VERSION_83_COMPAT #else #define PG_VERSION_84_COMPAT #endif #ifdef PG_VERSION_84_COMPAT #define HAVE_WINDOW_FUNCTIONS #endif #if PG_VERSION_NUM >= 110000 #define TUPLE_DESC_ATTR(tupdesc,i) TupleDescAttr(tupdesc,i) #else #define TUPLE_DESC_ATTR(tupdesc,i) tupdesc->attrs[i] #endif #ifdef DEBUGPROTECT #undef PROTECT extern SEXP pg_protect(SEXP s, char *fn, int ln); #define PROTECT(s) pg_protect(s, __FILE__, __LINE__) #undef UNPROTECT extern void pg_unprotect(int n, char *fn, int ln); #define UNPROTECT(n) pg_unprotect(n, __FILE__, __LINE__) #endif /* DEBUGPROTECT */ #define xpfree(var_) \ do { \ if (var_ != NULL) \ { \ pfree(var_); \ var_ = NULL; \ } \ } while (0) #define freeStringInfo(mystr_) \ do { \ xpfree((mystr_)->data); \ xpfree(mystr_); \ } while (0) #define NEXT_STR_ELEMENT " %s" #if (R_VERSION < 67840) /* R_VERSION < 1.9.0 */ #define SET_COLUMN_NAMES \ do { \ int i; \ char *names_buf; \ names_buf = SPI_fname(tupdesc, j + 1); \ for (i = 0; i < strlen(names_buf); i++) { \ if (names_buf[i] == '_') \ names_buf[i] = '.'; \ } \ SET_STRING_ELT(names, df_colnum, mkChar(names_buf)); \ pfree(names_buf); \ } while (0) #else /* R_VERSION >= 1.9.0 */ #define SET_COLUMN_NAMES \ do { \ char *names_buf; \ names_buf = SPI_fname(tupdesc, j + 1); \ SET_STRING_ELT(names, df_colnum, mkChar(names_buf)); \ pfree(names_buf); \ } while (0) #endif #if (R_VERSION < 67584) /* R_VERSION < 1.8.0 */ /* * See the non-exported header file ${R_HOME}/src/include/Parse.h */ extern SEXP R_ParseVector(SEXP, int, int *); #define PARSE_NULL 0 #define PARSE_OK 1 #define PARSE_INCOMPLETE 2 #define PARSE_ERROR 3 #define PARSE_EOF 4 #define R_PARSEVECTOR(a_, b_, c_) R_ParseVector(a_, b_, c_) /* * See the non-exported header file ${R_HOME}/src/include/Defn.h */ extern void R_PreserveObject(SEXP); extern void R_ReleaseObject(SEXP); /* in main.c */ extern void R_dot_Last(void); /* in memory.c */ extern void R_RunExitFinalizers(void); #else /* R_VERSION >= 1.8.0 */ #include "R_ext/Parse.h" #if (R_VERSION >= 132352) /* R_VERSION >= 2.5.0 */ #define R_PARSEVECTOR(a_, b_, c_) R_ParseVector(a_, b_, (ParseStatus *) c_, R_NilValue) #else /* R_VERSION < 2.5.0 */ #define R_PARSEVECTOR(a_, b_, c_) R_ParseVector(a_, b_, (ParseStatus *) c_) #endif /* R_VERSION >= 2.5.0 */ #endif /* R_VERSION >= 1.8.0 */ /* convert C string to text pointer */ #define PG_TEXT_GET_STR(textp_) \ DatumGetCString(DirectFunctionCall1(textout, PointerGetDatum(textp_))) #define PG_STR_GET_TEXT(str_) \ DatumGetTextP(DirectFunctionCall1(textin, CStringGetDatum(str_))) #define PG_REPLACE_STR(str_, substr_, replacestr_) \ PG_TEXT_GET_STR(DirectFunctionCall3(replace_text, \ PG_STR_GET_TEXT(str_), \ PG_STR_GET_TEXT(substr_), \ PG_STR_GET_TEXT(replacestr_))) /* initial number of hash table entries for compiled functions */ #define FUNCS_PER_USER 64 #define ERRORCONTEXTCALLBACK \ ErrorContextCallback plerrcontext #define PUSH_PLERRCONTEXT(_error_callback_, _plr_error_funcname_) \ do { \ plerrcontext.callback = _error_callback_; \ plerrcontext.arg = (void *) pstrdup(_plr_error_funcname_); \ plerrcontext.previous = error_context_stack; \ error_context_stack = &plerrcontext; \ } while (0) #define POP_PLERRCONTEXT \ do { \ pfree(plerrcontext.arg); \ error_context_stack = plerrcontext.previous; \ } while (0) #define SAVE_PLERRCONTEXT \ ErrorContextCallback *ecs_save; \ do { \ ecs_save = error_context_stack; \ error_context_stack = NULL; \ } while (0) #define RESTORE_PLERRCONTEXT \ do { \ error_context_stack = ecs_save; \ } while (0) #ifndef TEXTARRAYOID #define TEXTARRAYOID 1009 #endif #define TRIGGER_NARGS 9 #define TUPLESTORE_BEGIN_HEAP tuplestore_begin_heap(true, false, work_mem) #define INIT_AUX_FMGR_ATTS \ do { \ finfo->fn_mcxt = plr_caller_context; \ finfo->fn_expr = (Node *) NULL; \ } while (0) #define PROARGTYPES(i) \ procStruct->proargtypes.values[i] #define FUNCARGTYPES(_tup_) \ ((Form_pg_proc) GETSTRUCT(_tup_))->proargtypes.values #define PLR_CLEANUP \ plr_cleanup(int code, Datum arg) #define TRIGGERTUPLEVARS \ HeapTuple tup; \ HeapTupleHeader dnewtup; \ HeapTupleHeader dtrigtup #if (PG_VERSION_NUM >= 120000) #define SET_ARG(val, null, index) \ do { \ args[index].value=val; \ args[index].isnull =null; \ } while (0) #define IS_ARG_NULL(i) args[i].isnull #define GET_ARG_VALUE(i) args[i].value #else #define SET_ARG(val, null, index) \ do { \ arg[index]=val; \ argnull[index]=null; \ } while (0) #define IS_ARG_NULL(i) argnull[i] #define GET_ARG_VALUE(i) arg[i] #endif #define SET_INSERT_ARGS_567 \ do { \ SET_ARG(DirectFunctionCall1(textin, CStringGetDatum("INSERT")),false,5); \ tup = trigdata->tg_trigtuple; \ dtrigtup = (HeapTupleHeader) palloc(tup->t_len); \ memcpy((char *) dtrigtup, (char *) tup->t_data, tup->t_len); \ HeapTupleHeaderSetDatumLength(dtrigtup, tup->t_len); \ HeapTupleHeaderSetTypeId(dtrigtup, tupdesc->tdtypeid); \ HeapTupleHeaderSetTypMod(dtrigtup, tupdesc->tdtypmod); \ SET_ARG(PointerGetDatum(dtrigtup),false,6); \ SET_ARG((Datum)0,true,7); \ } while (0) #define SET_DELETE_ARGS_567 \ do { \ SET_ARG(DirectFunctionCall1(textin, CStringGetDatum("DELETE")),false,5); \ SET_ARG((Datum) 0,true,6); \ tup = trigdata->tg_trigtuple; \ dtrigtup = (HeapTupleHeader) palloc(tup->t_len); \ memcpy((char *) dtrigtup, (char *) tup->t_data, tup->t_len); \ HeapTupleHeaderSetDatumLength(dtrigtup, tup->t_len); \ HeapTupleHeaderSetTypeId(dtrigtup, tupdesc->tdtypeid); \ HeapTupleHeaderSetTypMod(dtrigtup, tupdesc->tdtypmod); \ SET_ARG(PointerGetDatum(dtrigtup),false,7); \ } while (0) #define SET_UPDATE_ARGS_567 \ do { \ SET_ARG(DirectFunctionCall1(textin, CStringGetDatum("UPDATE")),false,5); \ tup = trigdata->tg_newtuple; \ dnewtup = (HeapTupleHeader) palloc(tup->t_len); \ memcpy((char *) dnewtup, (char *) tup->t_data, tup->t_len); \ HeapTupleHeaderSetDatumLength(dnewtup, tup->t_len); \ HeapTupleHeaderSetTypeId(dnewtup, tupdesc->tdtypeid); \ HeapTupleHeaderSetTypMod(dnewtup, tupdesc->tdtypmod); \ SET_ARG(PointerGetDatum(dnewtup),false,6); \ tup = trigdata->tg_trigtuple; \ dtrigtup = (HeapTupleHeader) palloc(tup->t_len); \ memcpy((char *) dtrigtup, (char *) tup->t_data, tup->t_len); \ HeapTupleHeaderSetDatumLength(dtrigtup, tup->t_len); \ HeapTupleHeaderSetTypeId(dtrigtup, tupdesc->tdtypeid); \ HeapTupleHeaderSetTypMod(dtrigtup, tupdesc->tdtypmod); \ SET_ARG(PointerGetDatum(dtrigtup),false,7); \ } while (0) #define CONVERT_TUPLE_TO_DATAFRAME(tt) \ do { \ Oid tupType; \ int32 tupTypmod; \ TupleDesc tupdesc; \ HeapTuple tuple = palloc(sizeof(HeapTupleData)); \ HeapTupleHeader tuple_hdr = DatumGetHeapTupleHeader(tt); \ tupType = HeapTupleHeaderGetTypeId(tuple_hdr); \ tupTypmod = HeapTupleHeaderGetTypMod(tuple_hdr); \ tupdesc = lookup_rowtype_tupdesc(tupType, tupTypmod); \ tuple->t_len = HeapTupleHeaderGetDatumLength(tuple_hdr); \ ItemPointerSetInvalid(&(tuple->t_self)); \ tuple->t_tableOid = InvalidOid; \ tuple->t_data = tuple_hdr; \ PROTECT(el = pg_tuple_get_r_frame(1, &tuple, tupdesc)); \ ReleaseTupleDesc(tupdesc); \ pfree(tuple); \ } while (0) #define GET_ARG_NAMES \ char **argnames; \ argnames = fetchArgNames(procTup, procStruct->pronargs) #define SET_FRAME_ARG_NAME \ do { \ appendStringInfo(proc_internal_args, "farg%d", i + 1); \ } while (0) #define SET_FRAME_XARG_NAMES \ do { \ appendStringInfo(proc_internal_args, ",fnumrows,prownum"); \ } while (0) #define FREE_ARG_NAMES \ do { \ if (argnames) \ pfree(argnames); \ } while (0) #define PREPARE_PG_TRY \ ERRORCONTEXTCALLBACK #define SWITCHTO_PLR_SPI_CONTEXT(the_caller_context) \ the_caller_context = MemoryContextSwitchTo(plr_SPI_context) #define CLEANUP_PLR_SPI_CONTEXT(the_caller_context) \ MemoryContextSwitchTo(the_caller_context) #define PLR_PG_CATCH() \ PG_CATCH(); \ { \ MemoryContext temp_context; \ ErrorData *edata; \ SWITCHTO_PLR_SPI_CONTEXT(temp_context); \ edata = CopyErrorData(); \ MemoryContextSwitchTo(temp_context); \ error("error in SQL statement : %s", edata->message); \ } #define PLR_PG_END_TRY() \ PG_END_TRY() /* * structs */ typedef struct plr_func_hashkey { /* Hash lookup key for functions */ Oid funcOid; /* * For a trigger function, the OID of the relation triggered on is part * of the hashkey --- we want to compile the trigger separately for each * relation it is used with, in case the rowtype is different. Zero if * not called as a trigger. */ Oid trigrelOid; /* * We include actual argument types in the hash key to support * polymorphic PLpgSQL functions. Be careful that extra positions * are zeroed! */ Oid argtypes[FUNC_MAX_ARGS]; } plr_func_hashkey; /* The information we cache about loaded procedures */ typedef struct plr_function { char *proname; TransactionId fn_xmin; ItemPointerData fn_tid; plr_func_hashkey *fn_hashkey; /* back-link to hashtable key */ bool lanpltrusted; int result_natts; Oid *result_fld_typid; Oid *result_fld_elem_typid; FmgrInfo *result_fld_elem_in_func; int16 *result_fld_elem_typlen; bool *result_fld_elem_typbyval; char *result_fld_elem_typalign; int nargs; Oid arg_typid[FUNC_MAX_ARGS]; bool arg_typbyval[FUNC_MAX_ARGS]; FmgrInfo arg_out_func[FUNC_MAX_ARGS]; Oid arg_elem[FUNC_MAX_ARGS]; FmgrInfo arg_elem_out_func[FUNC_MAX_ARGS]; int arg_elem_typlen[FUNC_MAX_ARGS]; bool arg_elem_typbyval[FUNC_MAX_ARGS]; char arg_elem_typalign[FUNC_MAX_ARGS]; int arg_is_rel[FUNC_MAX_ARGS]; SEXP fun; /* compiled R function */ #ifdef HAVE_WINDOW_FUNCTIONS bool iswindow; #endif } plr_function; /* compiled function hash table */ typedef struct plr_hashent { plr_func_hashkey key; plr_function *function; } plr_HashEnt; /* * external declarations */ /* PL/R language handler */ PGDLLEXPORT Datum plr_call_handler(PG_FUNCTION_ARGS); PGDLLEXPORT Datum plr_inline_handler(PG_FUNCTION_ARGS); PGDLLEXPORT Datum plr_validator(PG_FUNCTION_ARGS); extern void PLR_CLEANUP; extern void plr_init(void); extern void plr_load_modules(void); extern void load_r_cmd(const char *cmd); extern SEXP call_r_func(SEXP fun, SEXP rargs, SEXP rho); /* argument and return value conversion functions */ extern SEXP pg_scalar_get_r(Datum dvalue, Oid arg_typid, FmgrInfo arg_out_func); extern SEXP pg_array_get_r(Datum dvalue, FmgrInfo out_func, int typlen, bool typbyval, char typalign); #ifdef HAVE_WINDOW_FUNCTIONS extern SEXP pg_window_frame_get_r(WindowObject winobj, int argno, plr_function* function); #endif extern SEXP pg_tuple_get_r_frame(int ntuples, HeapTuple *tuples, TupleDesc tupdesc); extern Datum r_get_pg(SEXP rval, plr_function *function, FunctionCallInfo fcinfo); extern Datum get_datum(SEXP rval, Oid typid, Oid typelem, FmgrInfo in_func, bool *isnull); extern Datum get_scalar_datum(SEXP rval, Oid result_typ, FmgrInfo result_in_func, bool *isnull); /* Postgres support functions installed into the R interpreter */ PGDLLEXPORT void throw_pg_log(int* elevel, const char **msg); PGDLLEXPORT SEXP plr_quote_literal(SEXP rawstr); PGDLLEXPORT SEXP plr_quote_ident(SEXP rawstr); PGDLLEXPORT SEXP plr_SPI_exec(SEXP rsql); PGDLLEXPORT SEXP plr_SPI_prepare(SEXP rsql, SEXP rargtypes); PGDLLEXPORT SEXP plr_SPI_execp(SEXP rsaved_plan, SEXP rargvalues); PGDLLEXPORT SEXP plr_SPI_cursor_open(SEXP cursor_name_arg,SEXP rsaved_plan, SEXP rargvalues); PGDLLEXPORT SEXP plr_SPI_cursor_fetch(SEXP cursor_in,SEXP forward_in, SEXP rows_in); PGDLLEXPORT void plr_SPI_cursor_close(SEXP cursor_in); PGDLLEXPORT void plr_SPI_cursor_move(SEXP cursor_in, SEXP forward_in, SEXP rows_in); PGDLLEXPORT SEXP plr_SPI_lastoid(void); PGDLLEXPORT void throw_r_error(const char **msg); #if PG_VERSION_NUM >= 110000 PGDLLEXPORT SEXP plr_SPI_commit(void); PGDLLEXPORT SEXP plr_SPI_rollback(void); #endif /* Postgres callable functions useful in conjunction with PL/R */ PGDLLEXPORT Datum plr_version(PG_FUNCTION_ARGS); PGDLLEXPORT Datum reload_plr_modules(PG_FUNCTION_ARGS); PGDLLEXPORT Datum install_rcmd(PG_FUNCTION_ARGS); PGDLLEXPORT Datum plr_array_push(PG_FUNCTION_ARGS); PGDLLEXPORT Datum plr_array(PG_FUNCTION_ARGS); PGDLLEXPORT Datum plr_array_accum(PG_FUNCTION_ARGS); PGDLLEXPORT Datum plr_environ(PG_FUNCTION_ARGS); PGDLLEXPORT Datum plr_set_rhome(PG_FUNCTION_ARGS); PGDLLEXPORT Datum plr_unset_rhome(PG_FUNCTION_ARGS); PGDLLEXPORT Datum plr_set_display(PG_FUNCTION_ARGS); PGDLLEXPORT Datum plr_get_raw(PG_FUNCTION_ARGS); /* Postgres backend support functions */ extern void compute_function_hashkey(FunctionCallInfo fcinfo, Form_pg_proc procStruct, plr_func_hashkey *hashkey); extern void plr_HashTableInit(void); extern plr_function *plr_HashTableLookup(plr_func_hashkey *func_key); extern void plr_HashTableInsert(plr_function *function, plr_func_hashkey *func_key); extern void plr_HashTableDelete(plr_function *function); extern char *get_load_self_ref_cmd(Oid langOid); extern void perm_fmgr_info(Oid functionId, FmgrInfo *finfo); #endif /* PLR_H */ plr-REL8_4_5/plr.spec000066400000000000000000000041331414122415700145050ustar00rootroot00000000000000%define pkgdocdir %(pg_config --docdir) %define pkglibdir %(pg_config --pkglibdir) %define pkgsharedir %(pg_config --sharedir) Summary: A loadable procedural language that enables you to write PostgreSQL functions and triggers in the R programming language. Name: plr Version: 8.3.0.18 Release: 1%{?dist} License: BSD Group: Applications/Databases Source: http://www.joeconway.com/plr/plr-%{version}.tar.gz URL: http://www.joeconway.com/plr.html BuildRequires: postgresql-devel >= 8.3 BuildRequires: R-devel Requires: postgresql-server >= 8.3 Requires: R BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n) %description PL/R is a loadable procedural language that enables you to write PostgreSQL functions and triggers in the R programming language. PL/R offers most (if not all) of the capabilities a function writer has in the R language. Commands are available to access the database via the PostgreSQL Server Programming Interface (SPI) and to raise messages via elog() . There is no way to access internals of the database backend. However the user is able to gain OS-level access under the permissions of the PostgreSQL user ID, as with a C function. Thus, any unprivileged database user should not be permitted to use this language. It must be installed as an untrusted procedural language so that only database superusers can create functions in it. The writer of a PL/R function must take care that the function cannot be used to do anything unwanted, since it will be able to do anything that could be done by a user logged in as the database administrator. An implementation restriction is that PL/R procedures cannot be used to create input/output functions for new data types. %prep %setup -q -n %{name} %build make USE_PGXS=1 %install rm -rf %{buildroot} make USE_PGXS=1 DESTDIR=%{buildroot}/ install %clean rm -rf %{buildroot} %files %defattr(644,root,root,755) %doc %{pkgdocdir}/extension/README.plr %{pkgsharedir}/extension/plr.sql %{pkgsharedir}/extension/plr.control %{pkgsharedir}/extension/plr--8.3.0.17.sql %{pkgsharedir}/extension/plr--unpackaged--8.3.0.17.sql %{pkglibdir}/plr.so* plr-REL8_4_5/plr.vcxproj000066400000000000000000000113751414122415700152540ustar00rootroot00000000000000 Debug Win32 Release Win32 Debug x64 Release x64 15.0 {CC739A29-855A-4FB0-B859-ECD0EBC538C5} Win32Proj plr v140 DynamicLibrary Link true i386 x64 $(ProgramFiles) $(ProgramW6432) 9.6 C:\RTools\mingw_ $(pf)\PostgreSQL\$(pgversion) 3.5.1 C:\Program Files\R\R-$(rversion) $(mingw)\..\bin\sed $(R_HOME)\include;$(pgroot)\include;$(pgroot)\include\server;$(pgroot)\include\server\port\win32;$(pgroot)\include\server\port\win32_msvc;$(IncludePath) $(pgroot)\lib;$(LibraryPath) true Level3 CompileAsC false AdvancedVectorExtensions2 ProgramDatabase Win32;%(PreprocessorDefinitions) WIN32;%(PreprocessorDefinitions) Speed true AnySuitable true Disabled true true MultiThreadedDebugDLL true R$(PlatformTarget).lib;postgres.lib;%(AdditionalDependencies) true true $(mingw)$(PlatformArchitecture)\bin\gendef.exe - "$(R_HOME)\bin\$(rbin)\R.dll" > R$(PlatformTarget).def lib /def:R$(PlatformTarget).def /out:R$(PlatformTarget).lib /MACHINE:$(PlatformTarget) if "%CI%"=="" ( if not exist data "$(pgroot)\bin\initdb" -D data ) R$(PlatformTarget).lib Generate R import library plr-REL8_4_5/plr.vcxproj.user000066400000000000000000000015551414122415700162300ustar00rootroot00000000000000 $(pgroot)\lib\ $(pgroot)\lib\$(TargetName)$(TargetExt) $(ProjectDir)\data $(pgroot)\bin\postgres.exe -p 5433 -D data WindowsLocalDebugger NativeOnly $(OutDir)\..\symbols\$(TargetName).pdb plr-REL8_4_5/sql/000077500000000000000000000000001414122415700136325ustar00rootroot00000000000000plr-REL8_4_5/sql/bad_fun.sql000066400000000000000000000002441414122415700157510ustar00rootroot00000000000000-- should error out but should not crash PG CREATE OR REPLACE FUNCTION r_bad_fun() RETURNS int4 AS $BODY$ deadbeef <- function(,bad) {} 42 $BODY$ LANGUAGE plr; plr-REL8_4_5/sql/do.sql000066400000000000000000000001501414122415700147510ustar00rootroot00000000000000do language plr ' pg.throwlog("Hello, world!") '; do language plr ' pg.thrownotice("Hello, world!") '; plr-REL8_4_5/sql/opt_window.sql000066400000000000000000000011471414122415700165470ustar00rootroot00000000000000create or replace function fast_win(a int4, b bigint) returns bool AS $$ ##is.null(farg2) || pg.throwerror('Constants shall not be passes with the frame') identical(parent.frame(), .GlobalEnv) && pg.throwerror('Parent env is global') exists('plr_window_frame', parent.frame(), inherits=FALSE) || pg.throwerror('No window frame data found') a == farg1[prownum] $$ window language plr; select s, p, fast_win(NULLIF(s, 4), 123) over w from ( select s, s % 2 as p from generate_series(1,10) s ) foo window w as (partition by p order by s rows between unbounded preceding and unbounded following) order by s; plr-REL8_4_5/sql/opt_window_frame.sql000066400000000000000000000011471414122415700177210ustar00rootroot00000000000000create or replace function fast_win_frame(r int, t record) returns bool AS $$ identical(parent.frame(), .GlobalEnv) && pg.throwerror('Parent env is global') exists('plr_window_frame', parent.frame(), inherits=FALSE) || pg.throwerror('No window frame data found') r == farg2[[prownum,2]][3] $$ window language plr; select s.r, s.p, fast_win_frame(NULLIF(r,4), (s.r, s.q)) over w from (select r, r % 2 as p, array_fill(case when r=7 then 77 else r end, ARRAY[3]) as q from generate_series(1,10) r) s window w as (partition by p order by r rows between unbounded preceding and unbounded following) order by s.r;plr-REL8_4_5/sql/out_args.sql000066400000000000000000000016401414122415700161770ustar00rootroot00000000000000-- this is non-SRF returning record --create or replace function out_float8(out x float8, in a float8, out y float8[]) as $$ create or replace function out_float8(out x anyelement, in a anyelement, out y anyarray) as $$ list(a, rep(a, 3)) $$ language plr; select * from out_float8(42.5); -- NUMERICOID select * from out_float8(42.5::float8); select * from out_float8(42.5::int2); -- SRF create or replace function out__float8(out x float8, in a float8[], out y float8) returns setof record as $$ data.frame(a, a*2) $$ language plr; select * from out__float8(ARRAY[123,NULL,42.5]); -- window function can't return setof create or replace function out_fun_win(out x2 float8, in a float8, out p2 float8) AS $$ list(x=a*2, y=a+2) $$ window language plr; select s, bar.* from ( select s, row_to_json(out_fun_win(s) over ()) j from generate_series(1,2) s ) foo , lateral json_to_record(j) as bar(x2 float8, p2 float8); plr-REL8_4_5/sql/plr.sql000077500000000000000000000462511414122415700151630ustar00rootroot00000000000000-- install extension create extension plr; -- make sure we get the notices set client_min_messages to notice; -- check version SELECT plr_version(); -- make typenames available in the global namespace select load_r_typenames(); CREATE TABLE plr_modules ( modseq int4, modsrc text ); INSERT INTO plr_modules VALUES (0, 'pg.test.module.load <-function(msg) {print(msg)}'); select reload_plr_modules(); -- -- plr_modules test -- create or replace function pg_test_module_load(text) returns text as 'pg.test.module.load(arg1)' language 'plr'; select pg_test_module_load('hello world'); -- -- user defined R function test -- select install_rcmd('pg.test.install <-function(msg) {print(msg)}'); create or replace function pg_test_install(text) returns text as 'pg.test.install(arg1)' language 'plr'; select pg_test_install('hello world'); -- -- test simple input/output types -- CREATE OR REPLACE FUNCTION rint2(i int2) RETURNS int2 AS $$ return (as.integer(i)) $$ LANGUAGE plr; select rint2(1::int2); select rint2(NULL); CREATE OR REPLACE FUNCTION rint4(i int4) RETURNS int4 AS $$ return (as.integer(i)) $$ LANGUAGE plr; select rint4(1::int4); select rint4(NULL); CREATE OR REPLACE FUNCTION rint8(i int8) RETURNS int8 AS $$ return (as.integer(i)) $$ LANGUAGE plr; select rint8(1::int8); select rint8(NULL); CREATE OR REPLACE FUNCTION rbool(b bool) RETURNS bool AS $$ return (as.logical(b)) $$ LANGUAGE plr; select rbool('t'); select rbool('f'); select rbool(NULL); CREATE OR REPLACE FUNCTION rfloat(inout f anyelement, out isnull boolean, out isna boolean, out isnan boolean) AS $$ list(as.numeric(f), is.null(f), is.na(f), is.nan(f)) $$ LANGUAGE plr; select rfloat(1::int4); select rfloat(1::float4); select rfloat(NULL::float4); select rfloat('NaN'::float4); select rfloat(1::float8); select rfloat(NULL::float8); select rfloat('NaN'::float8); select rfloat(1); -- numeric -- -- a variety of plr functions -- create or replace function throw_notice(text) returns text as 'pg.thrownotice(arg1)' language 'plr'; select throw_notice('hello'); create or replace function paste(_text,_text,text) returns text[] as 'paste(arg1,arg2, sep = arg3)' language 'plr'; select paste('{hello, happy}','{world, birthday}',' '); create or replace function vec(_float8) returns _float8 as 'arg1' language 'plr'; select vec('{1.23, 1.32}'::float8[]); create or replace function vec(float, float) returns _float8 as 'c(arg1,arg2)' language 'plr'; select vec(1.23, 1.32); create or replace function echo(text) returns text as 'print(arg1)' language 'plr'; select echo('hello'); create or replace function reval(text) returns text as 'eval(parse(text = arg1))' language 'plr'; select reval('a <- sd(c(1,2,3)); b <- mean(c(1,2,3)); a + b'); create or replace function "commandArgs"() returns text[] as '' language 'plr'; select "commandArgs"(); create or replace function vec(float) returns text as 'c(arg1)' language 'plr'; select vec(1.23); create or replace function reval(_text) returns text as 'eval(parse(text = arg1))' language 'plr'; select round(reval('{"sd(c(1.12,1.23,1.18,1.34))"}'::text[])::numeric,8); create or replace function print(text) returns text as '' language 'plr'; select print('hello'); create or replace function cube(int) returns float as 'sq <- function(x) {return(x * x)}; return(arg1 * sq(arg1))' language 'plr'; select cube(3); create or replace function sd(_float8) returns float as 'sd(arg1)' language 'plr'; select round(sd('{1.23,1.31,1.42,1.27}'::_float8)::numeric,8); create or replace function sd(_float8) returns float as '' language 'plr'; select round(sd('{1.23,1.31,1.42,1.27}'::_float8)::numeric,8); create or replace function mean(_float8) returns float as '' language 'plr'; select mean('{1.23,1.31,1.42,1.27}'::_float8); create or replace function sprintf(text,text,text) returns text as 'sprintf(arg1,arg2,arg3)' language 'plr'; select sprintf('%s is %s feet tall', 'Sven', '7'); -- -- test aggregates -- do language plpgsql $body$ declare version_12plus bool; begin select current_setting('server_version_num')::integer >= 120000 into version_12plus; if(version_12plus) then create table foo(f0 int, f1 text, f2 float8); else execute $$create table foo(f0 int, f1 text, f2 float8) with oids;$$; end if; end $body$; insert into foo values(1,'cat1',1.21); insert into foo values(2,'cat1',1.24); insert into foo values(3,'cat1',1.18); insert into foo values(4,'cat1',1.26); insert into foo values(5,'cat1',1.15); insert into foo values(6,'cat2',1.15); insert into foo values(7,'cat2',1.26); insert into foo values(8,'cat2',1.32); insert into foo values(9,'cat2',1.30); create or replace function r_median(_float8) returns float as 'median(arg1)' language 'plr'; select r_median('{1.23,1.31,1.42,1.27}'::_float8); CREATE AGGREGATE median (sfunc = plr_array_accum, basetype = float8, stype = _float8, finalfunc = r_median); select f1, median(f2) from foo group by f1 order by f1; create or replace function r_gamma(_float8) returns float as 'gamma(arg1)' language 'plr'; select round(r_gamma('{1.23,1.31,1.42,1.27}'::_float8)::numeric,8); CREATE AGGREGATE gamma (sfunc = plr_array_accum, basetype = float8, stype = _float8, finalfunc = r_gamma); select f1, round(gamma(f2)::numeric,8) from foo group by f1 order by f1; -- -- test returning vectors, arrays, matricies, and dataframes -- as scalars, arrays, and records -- create or replace function test_vt() returns text as 'array(1:10,c(2,5))' language 'plr'; select test_vt(); create or replace function test_vi() returns int as 'array(1:10,c(2,5))' language 'plr'; select test_vi(); create or replace function test_mt() returns text as 'as.matrix(array(1:10,c(2,5)))' language 'plr'; select test_mt(); create or replace function test_mi() returns int as 'as.matrix(array(1:10,c(2,5)))' language 'plr'; select test_mi(); create or replace function test_dt() returns text as 'as.data.frame(array(1:10,c(2,5)))[[1]]' language 'plr'; select test_dt(); create or replace function test_di() returns int as 'as.data.frame(array(1:10,c(2,5)))[[1]]' language 'plr'; select test_di() as error; create or replace function test_vta() returns text[] as 'array(1:10,c(2,5))' language 'plr'; select test_vta(); create or replace function test_via() returns int[] as 'array(1:10,c(2,5))' language 'plr'; select test_via(); create or replace function test_mta() returns text[] as 'as.matrix(array(1:10,c(2,5)))' language 'plr'; select test_mta(); create or replace function test_mia() returns int[] as 'as.matrix(array(1:10,c(2,5)))' language 'plr'; select test_mia(); create or replace function test_dia() returns int[] as 'as.data.frame(array(1:10,c(2,5)))' language 'plr'; select test_dia(); create or replace function test_dta() returns text[] as 'as.data.frame(array(1:10,c(2,5)))' language 'plr'; select test_dta(); create or replace function test_dta1() returns text[] as 'as.data.frame(array(letters[1:10], c(2,5)))' language 'plr'; select test_dta1(); create or replace function test_dta2() returns text[] as 'as.data.frame(data.frame(letters[1:10],1:10))' language 'plr'; select test_dta2(); -- generates expected error create or replace function test_dia1() returns int[] as 'as.data.frame(array(letters[1:10], c(2,5)))' language 'plr'; create or replace function test_dia1_wrap() returns text as $body$ begin select test_dia1() as error; return 'failed'; exception when invalid_text_representation then return 'ok'; end; $body$ language plpgsql; select test_dia1_wrap(); create or replace function test_dtup() returns setof record as 'data.frame(letters[1:10],1:10)' language 'plr'; select * from test_dtup() as t(f1 text, f2 int); create or replace function test_mtup() returns setof record as 'as.matrix(array(1:15,c(5,3)))' language 'plr'; select * from test_mtup() as t(f1 int, f2 int, f3 int); create or replace function test_vtup() returns setof record as 'as.vector(array(1:15,c(5,3)))' language 'plr'; select * from test_vtup() as t(f1 int); create or replace function test_vint() returns setof int as 'as.vector(array(1:15,c(5,3)))' language 'plr'; select * from test_vint(); -- -- try again with named tuple types -- CREATE TYPE dtup AS (f1 text, f2 int); CREATE TYPE mtup AS (f1 int, f2 int, f3 int); CREATE TYPE vtup AS (f1 int); create or replace function test_dtup1() returns setof dtup as 'data.frame(letters[1:10],1:10)' language 'plr'; select * from test_dtup1(); create or replace function test_dtup2() returns setof dtup as 'data.frame(c("c","qw","ax","h","k","ax","l","t","b","u"),1:10)' language 'plr'; select * from test_dtup2(); create or replace function test_mtup1() returns setof mtup as 'as.matrix(array(1:15,c(5,3)))' language 'plr'; select * from test_mtup1(); create or replace function test_vtup1() returns setof vtup as 'as.vector(array(1:15,c(5,3)))' language 'plr'; select * from test_vtup1(); -- -- test pg R support functions (e.g. SPI_exec) -- create or replace function pg_quote_ident(text) returns text as 'pg.quoteident(arg1)' language 'plr'; select pg_quote_ident('Hello World'); create or replace function pg_quote_literal(text) returns text as 'pg.quoteliteral(arg1)' language 'plr'; select pg_quote_literal('Hello''World'); create or replace function test_spi_t(text) returns text as '(pg.spi.exec(arg1))[[1]]' language 'plr'; select test_spi_t('select oid, typname from pg_type where typname = ''oid'' or typname = ''text'''); create or replace function test_spi_ta(text) returns text[] as 'pg.spi.exec(arg1)' language 'plr'; select test_spi_ta('select oid, typname from pg_type where typname = ''oid'' or typname = ''text'''); create or replace function test_spi_tup(text) returns setof record as 'pg.spi.exec(arg1)' language 'plr'; select * from test_spi_tup('select oid, typname from pg_type where typname = ''oid'' or typname = ''text''') as t(typeid oid, typename name); create or replace function fetch_pgoid(text) returns int as 'pg.reval(arg1)' language 'plr'; select fetch_pgoid('BYTEAOID'); create or replace function test_spi_prep(text) returns text as 'sp <<- pg.spi.prepare(arg1, c(NAMEOID, NAMEOID)); print("OK")' language 'plr'; select test_spi_prep('select oid, typname from pg_type where typname = $1 or typname = $2'); create or replace function test_spi_execp(text, text, text) returns setof record as 'pg.spi.execp(pg.reval(arg1), list(arg2,arg3))' language 'plr'; select * from test_spi_execp('sp','oid','text') as t(typeid oid, typename name); create or replace function test_spi_lastoid(text) returns text as $$ version_12plus <- pg.spi.exec("select current_setting('server_version_num')::integer < 120000") pg.spi.exec(arg1) ifelse(version_12plus, pg.spi.lastoid()/pg.spi.lastoid(), 1) $$ language 'plr'; select test_spi_lastoid('insert into foo values(10,''cat3'',3.333)') as "ONE"; -- -- test NULL handling -- CREATE OR REPLACE FUNCTION r_test (float8) RETURNS float8 AS 'arg1' LANGUAGE 'plr'; select r_test(null) is null as "NULL"; CREATE OR REPLACE FUNCTION r_max (integer, integer) RETURNS integer AS 'if (is.null(arg1) && is.null(arg2)) return(NA);if (is.null(arg1)) return(arg2);if (is.null(arg2)) return(arg1);if (arg1 > arg2) return(arg1);arg2' LANGUAGE 'plr'; select r_max(1,2) as "TWO"; select r_max(null,2) as "TWO"; select r_max(1,null) as "ONE"; select r_max(null,null) is null as "NULL"; -- -- test tuple arguments -- create or replace function get_foo(int) returns foo as 'select * from foo where f0 = $1' language 'sql'; create or replace function test_foo(foo) returns foo as 'return(arg1)' language 'plr'; select * from test_foo(get_foo(1)); -- -- test 2D array argument -- create or replace function test_in_m_tup(_int4) returns setof record as 'arg1' language 'plr'; select * from test_in_m_tup('{{1,3,5},{2,4,6}}') as t(f1 int, f2 int, f3 int); -- -- test 3D array argument -- create or replace function arr3d(_int4,int4,int4,int4) returns int4 as ' if (arg2 < 1 || arg3 < 1 || arg4 < 1) return(NA) if (arg2 > dim(arg1)[1] || arg3 > dim(arg1)[2] || arg4 > dim(arg1)[3]) return(NA) return(arg1[arg2,arg3,arg4]) ' language 'plr' STRICT; select arr3d('{{{111,112},{121,122},{131,132}},{{211,212},{221,222},{231,232}}}',2,3,1) as "231"; -- for sake of comparison, see what normal pgsql array operations produces select f1[2][3][1] as "231" from (select '{{{111,112},{121,122},{131,132}},{{211,212},{221,222},{231,232}}}'::int4[] as f1) as t; -- out-of-bounds, returns null select arr3d('{{{111,112},{121,122},{131,132}},{{211,212},{221,222},{231,232}}}',1,4,1) is null as "NULL"; select f1[1][4][1] is null as "NULL" from (select '{{{111,112},{121,122},{131,132}},{{211,212},{221,222},{231,232}}}'::int4[] as f1) as t; select arr3d('{{{111,112},{121,122},{131,132}},{{211,212},{221,222},{231,232}}}',0,1,1) is null as "NULL"; select f1[0][1][1] is null as "NULL" from (select '{{{111,112},{121,122},{131,132}},{{211,212},{221,222},{231,232}}}'::int4[] as f1) as t; -- -- test 3D array return value -- create or replace function arr3d(_int4) returns int4[] as 'return(arg1)' language 'plr' STRICT; select arr3d('{{{111,112},{121,122},{131,132}},{{211,212},{221,222},{231,232}}}'); -- -- Trigger support tests -- -- -- test that NULL return value suppresses the change -- create or replace function rejectfoo() returns trigger as 'return(NULL)' language plr; create trigger footrig before insert or update or delete on foo for each row execute procedure rejectfoo(); select count(*) from foo; insert into foo values(11,'cat99',1.89); select count(*) from foo; update foo set f1 = 'zzz'; select count(*) from foo; delete from foo; select count(*) from foo; drop trigger footrig on foo; -- -- test that returning OLD/NEW as appropriate allow the change unmodified -- create or replace function acceptfoo() returns trigger as ' switch (pg.tg.op, INSERT = return(pg.tg.new), UPDATE = return(pg.tg.new), DELETE = return(pg.tg.old)) ' language plr; create trigger footrig before insert or update or delete on foo for each row execute procedure acceptfoo(); select count(*) from foo; insert into foo values(11,'cat99',1.89); select count(*) from foo; update foo set f1 = 'zzz' where f0 = 11; select * from foo where f0 = 11; delete from foo where f0 = 11; select count(*) from foo; drop trigger footrig on foo; -- -- test that returning modifed tuple successfully modifies the result -- create or replace function modfoo() returns trigger as ' if (pg.tg.op == "INSERT") { retval <- pg.tg.new retval$f1 <- "xxx" } if (pg.tg.op == "UPDATE") { retval <- pg.tg.new retval$f1 <- "aaa" } if (pg.tg.op == "DELETE") retval <- pg.tg.old return(retval) ' language plr; create trigger footrig before insert or update or delete on foo for each row execute procedure modfoo(); select count(*) from foo; insert into foo values(11,'cat99',1.89); select * from foo where f0 = 11; update foo set f1 = 'zzz' where f0 = 11; select * from foo where f0 = 11; delete from foo where f0 = 11; select count(*) from foo; drop trigger footrig on foo; -- -- test statement level triggers and verify all arguments come -- across correctly -- create or replace function foonotice() returns trigger as ' msg <- paste(pg.tg.name,pg.tg.relname,pg.tg.when,pg.tg.level,pg.tg.op,pg.tg.args[1],pg.tg.args[2]) pg.thrownotice(msg) ' language plr; create trigger footrig after insert or update or delete on foo for each row execute procedure foonotice(); select count(*) from foo; insert into foo values(11,'cat99',1.89); select count(*) from foo; update foo set f1 = 'zzz' where f0 = 11; select * from foo where f0 = 11; delete from foo where f0 = 11; select count(*) from foo; drop trigger footrig on foo; create trigger footrig after insert or update or delete on foo for each statement execute procedure foonotice('hello','world'); select count(*) from foo; insert into foo values(11,'cat99',1.89); select count(*) from foo; update foo set f1 = 'zzz' where f0 = 11; select * from foo where f0 = 11; delete from foo where f0 = 11; select count(*) from foo; drop trigger footrig on foo; -- Test cursors: creating, scrolling forward, closing CREATE OR REPLACE FUNCTION cursor_fetch_test(integer,boolean) RETURNS SETOF integer AS 'plan<-pg.spi.prepare("SELECT * FROM generate_series(1,10)"); cursor<-pg.spi.cursor_open("curs",plan); dat<-pg.spi.cursor_fetch(cursor,arg2,arg1); pg.spi.cursor_close(cursor); return (dat);' language 'plr'; SELECT * FROM cursor_fetch_test(1,true); SELECT * FROM cursor_fetch_test(2,true); SELECT * FROM cursor_fetch_test(20,true); --Test cursors: scrolling backwards CREATE OR REPLACE FUNCTION cursor_direction_test() RETURNS SETOF integer AS'plan<-pg.spi.prepare("SELECT * FROM generate_series(1,10)"); cursor<-pg.spi.cursor_open("curs",plan); dat<-pg.spi.cursor_fetch(cursor,TRUE,as.integer(3)); dat2<-pg.spi.cursor_fetch(cursor,FALSE,as.integer(3)); pg.spi.cursor_close(cursor); return (dat2);' language 'plr'; SELECT * FROM cursor_direction_test(); --Test cursors: Passing arguments to a plan CREATE OR REPLACE FUNCTION cursor_fetch_test_arg(integer) RETURNS SETOF integer AS 'plan<-pg.spi.prepare("SELECT * FROM generate_series(1,$1)",c(INT4OID)); cursor<-pg.spi.cursor_open("curs",plan,list(arg1)); dat<-pg.spi.cursor_fetch(cursor,TRUE,arg1); pg.spi.cursor_close(cursor); return (dat);' language 'plr'; SELECT * FROM cursor_fetch_test_arg(3); --Test bytea arguments and return values: serialize/unserialize create or replace function test_serialize(text) returns bytea as ' mydf <- pg.spi.exec(arg1) return (mydf) ' language 'plr'; create or replace function restore_df(bytea) returns setof record as ' return (arg1) ' language 'plr'; select * from restore_df((select test_serialize('select oid, typname from pg_type where typname in (''oid'',''name'',''int4'')'))) as t(oid oid, typname name) order by oid; --Test WINDOW functions -- create test table CREATE TABLE test_data ( fyear integer, firm float8, eps float8 ); -- insert data for test INSERT INTO test_data SELECT (b.f + 1) % 10 + 2000 AS fyear, floor((b.f+1)/10) + 50 AS firm, f::float8/100 AS eps FROM generate_series(-200,199,1) b(f); CREATE OR REPLACE FUNCTION r_regr_slope(float8, float8) RETURNS float8 AS $BODY$ slope <- NA y <- farg1 x <- farg2 if (fnumrows==9) try (slope <- lm(y ~ x)$coefficients[2]) return(slope) $BODY$ LANGUAGE plr WINDOW; SELECT *, round((r_regr_slope(eps, lag_eps) OVER w)::numeric,6) AS slope_R FROM (SELECT firm, fyear, eps, lag(eps) OVER (ORDER BY firm, fyear) AS lag_eps FROM test_data) AS a WHERE eps IS NOT NULL WINDOW w AS (ORDER BY firm, fyear ROWS 8 PRECEDING); CREATE OR REPLACE FUNCTION rlargeint8out(n int) RETURNS int8[] AS $$ matrix(2, 1, n) $$ LANGUAGE plr; CREATE OR REPLACE FUNCTION routfloat4(n int) RETURNS float4[] AS $$ vector(mode = "numeric", length = n) $$ LANGUAGE plr; SELECT rlargeint8out(10); SELECT routfloat4(10); SELECT count(rlargeint8out(15000)); SELECT count(routfloat4(15000)); CREATE table tbl(val integer); CREATE OR REPLACE FUNCTION test_create_procedure() RETURNS void AS $BODY$ version_11plus <- pg.spi.exec("select current_setting('server_version_num')::integer >= 110000;") if(version_11plus[[1]]) { pg.spi.exec(" CREATE OR REPLACE PROCEDURE insert_data(a int, b int) AS $$ pg.spi.exec('INSERT INTO tbl VALUES (1);') pg.spi.exec('INSERT INTO tbl VALUES (2);') $$ LANGUAGE plr; ") pg.spi.exec("CALL insert_data(1, 2);") } else { pg.spi.exec("INSERT INTO tbl VALUES (1);") pg.spi.exec("INSERT INTO tbl VALUES (2);") } $BODY$ LANGUAGE plr; SELECT test_create_procedure(); SELECT * FROM tbl; plr-REL8_4_5/sql/plr_transaction.sql000066400000000000000000000022621414122415700175570ustar00rootroot00000000000000CREATE TABLE test1 (a int, b text); CREATE OR REPLACE FUNCTION test_create_procedure_transaction() RETURNS void AS $BODY$ version_11plus <- pg.spi.exec("SELECT current_setting('server_version_num')::integer >= 110000;") if(version_11plus[[1]]) { pg.spi.exec(" CREATE OR REPLACE PROCEDURE transaction_test1() AS $$ for(i in 0:9){ pg.spi.exec(paste('INSERT INTO test1 (a) VALUES (', i, ');')) if (i %% 2 == 0) { pg.spi.commit() } else { pg.spi.rollback() } } $$ LANGUAGE plr; ") } else { pg.spi.exec("INSERT INTO test1 (a) VALUES (0);") pg.spi.exec("INSERT INTO test1 (a) VALUES (2);") pg.spi.exec("INSERT INTO test1 (a) VALUES (4);") pg.spi.exec("INSERT INTO test1 (a) VALUES (6);") pg.spi.exec("INSERT INTO test1 (a) VALUES (8);") } $BODY$ LANGUAGE plr; SELECT test_create_procedure_transaction(); \o out.txt SELECT current_setting('server_version_num')::integer server_version_num; \o \gset \o out.txt SELECT CASE WHEN :server_version_num >= 110000 THEN 'CALL transaction_test1();' ELSE '' END thecall; \o \gset :thecall SELECT * FROM test1; plr-REL8_4_5/userguide.md000066400000000000000000001663741414122415700153720ustar00rootroot00000000000000# PL/R User’s Guide - R Procedural Language #### PL/R User’s Guide - R Procedural Language #### Copyright © 2003 Joseph E Conway ## Table of Contents #### 1. [Overview](#overview) #### 2. [Installation](#installation) #### 3. [Functions and Arguments](#functions) #### 4. [Passing Data Values](#passing-data) #### 5. [Using Global Data](#global-data) #### 6. [Database Access and Support Functions](#database-access) #### 6.1. [Normal Support](#normal-support) #### 6.2. [RPostgreSQL Compatibility Support](#rpostgresql) #### 7. [PostgreSQL Support Functions](#postgresql-support) #### 8. [Aggregate Functions](#aggregate-functions) #### 9. [Window Functions](#window-functions) #### 10. [Loading R Modules at Startup](#startup) #### 11. [R Function Names](#rfunction-names) #### 12. [Trigger Procedures](#trigger-procedures) #### 13. [Inline Handler](#inline-handler) #### 14. [Stored Procedures](#stored-procedures) #### 15. [Transactions in Stored Procedures](#transactions-in-stored-procedures) #### 16. [Custom Type (Tuple) Arguments in Window Functions](#custom-type-tuple-arguments-in-window-functions) #### 17. [License](#license) ## Overview PL/R is a loadable procedural language that enables you to write PostgreSQL functions and triggers in the R programming language1. PL/R offers most (if not all) of the capabilities a function writer has in the R language. Commands are available to access the database via the PostgreSQL Server Programming Interface (SPI) and to raise messages via ```elog()```. There is no way to access internals of the database backend. However the user is able to gain OS-level access under the permissions of the PostgreSQL user ID, as with a C function. Thus, any unprivileged database user should not be permitted to use this language. It must be installed as an untrusted procedural language so that only database superusers can create functions in it. The writer of a PL/R function must take care that the function cannot be used to do anything unwanted, since it will be able to do anything that could be done by a user logged in as the database administrator. An implementation restriction is that PL/R procedures cannot be used to create input/output functions for new data types. 1. [http://www.r-project.org/](http://www.r-project.org/) ## Installation All of the following presume that you have installed R before starting. From within R you can find R_HOME with ```R.home(component="home")``` ### Redhat/Centos Family This presumes you installed PostgreSQL using the PGDG repositories found [here](https://www.postgresql.org/download/linux/redhat/) ```bash yum install plr-nn ``` Where nn is the major version number such as 13 for PostgreSQL version 13.x To set R_HOME for use by PostgreSQL. First we need to customize the systemd service ```bash systemctl edit postgresql-nn.service ``` again where nn is the major version of PostgreSQL installed on the system Add the following to this file ``` [Service] Environment=R_HOME= ``` Now restart PostgreSQL using ```bash systemctl restart postgresql-nn ``` ### Debian deriviatives This presumes you installed PostgreSQL using the PGDG repositories found [here](https://www.postgresql.org/download/linux/debian/) ```bash apt-get install postgresql-nn-plr ``` In the `/etc/postgresql/nn/main` directory there is a file named environment. Edit this file and add the following: `R_HOME=` ### Compiling from source If you are going to compile R from the source, then do the following: ```bash ./configure --enable-R-shlib --prefix=/opt/postgres_plr && make && make install ``` If you are going to compile PostgreSQL from the source, use the following commands from the untared and unzipped file downloaded from [http://www.postgresql.org/ftp/source/](http://www.postgresql.org/ftp/source/): Place source tar file in the contrib dir in the PostgreSQL source tree and untar it. The shared object for the R call handler is built and installed in the PostgreSQL library directory via the following commands (starting from /path/to/postgresql_source/contrib): ```bash cd plr make make install ``` You may explicitly include the path of pg_config to `PATH`, such as ```bash cd plr PATH=/usr/pgsql-13/bin/:$PATH; USE_PGXS=1 make echo "PATH=/usr/pgsql-13/bin/:$PATH; USE_PGXS=1 make install" | sudo sh ``` If you want to use git to pull the repository, run the following command before the make command: ```bash git clone https://github.com/postgres-plr/plr ``` As of PostgreSQL 8.0.0, PL/R can also be built without the PostgreSQL source tree. Untar PL/R where ever you prefer. The shared object for the R call handler is built and installed in the PostgreSQL library directory via the following commands (starting from/path/to/plr): ```bash cd plr USE_PGXS=1 make USE_PGXS=1 make install ``` In MSYS: ``` export R_HOME=/c/progra~1/R/R-4.1.0 export PATH=$PATH:/c/progra~1/PostgreSQL/13/bin USE_PGXS=1 make USE_PGXS=1 make install ``` In Mingw, MSYS, or MSYS2: If R is built and installed using a sub-architecture, as explained in the section Sub-architectures in https://cran.r-project.org/doc/manuals/r-release/R-admin.html for example, in an R ``` R-x.y.z for Windows (32/64 bit) ``` that has been downloaded (and installed) from [https://cran.r-project.org/bin/windows/base/](https://cran.r-project.org/bin/windows/base/) then, include the environment variable R_ARCH. For example R_ARCH=/x64 (or R_ARCH=/i386 as appropriate): ``` export R_HOME=/c/progra~1/R/R-4.0.4 export PATH=$PATH:/c/progra~1/PostgreSQL/13/bin export R_ARCH=/x64 USE_PGXS=1 make USE_PGXS=1 make install ``` ### Installing from a Pre-Built "plr" Win32 - adjust paths according to your own setup, and be sure to restart the PostgreSQL service after changing: In Windows environment (generally): ``` R_HOME=C:\Progra~1\R\R-4.1.0 Path=%PATH%;%R_HOME%\x64\bin ``` #### Detailed Windows Environment In a Windows environment, with a PL/R compiled using Microsoft Visual Studio [https://github.com/postgres-plr/plr/releases/latest](https://github.com/postgres-plr/plr/releases/latest), with a PostgreSQL compiled with Microsoft Visual Studio [https://www.enterprisedb.com/downloads/postgres-postgresql-downloads](https://www.enterprisedb.com/downloads/postgres-postgresql-downloads), and an R acquired from [https://cran.r-project.org/bin/windows/base/](https://cran.r-project.org/bin/windows/base/) do the following. #### First: Download and install PostgreSQL compiled with Microsoft Visual Studio [https://www.enterprisedb.com/downloads/postgres-postgresql-downloads](https://www.enterprisedb.com/downloads/postgres-postgresql-downloads) Download PL/R compiled using Microsoft Visual Studio [https://github.com/postgres-plr/plr/releases/latest](https://github.com/postgres-plr/plr/releases/latest) Unzip the plr.zip file into a folder, that is called the "unzipped folder". If your installation of PostgreSQL had been installed into "C:\Program Files\PostgreSQL\13", then from the unzipped PL/R folder, place the following * .sql files and the plr.control file, all found in the "share\extension" folder into "C:\Program Files\PostgreSQL\13\share\extension" folder. * plr.dll file found in the "lib" folder into "C:\Program Files\PostgreSQL\13\lib" folder. #### Second: Install R with the feature checked [x] "Save version number in registry"." See the "Tip" item below. ### Alternately: Acquire R from the same location and choose [ ] "Save version number in registry". At a Command Prompt run (and may have to be an Administrator Command Prompt) and using wherever your path to R may be, do: ``` setx R_HOME "C:\Program Files\R\R-4.1.0" /M ``` ### Optionally: Acquire R from the same location and choose [ ] "Save version number in registry". Choose Control Panel -> System -> advanced system settings -> Environment Variables button. In the "System variables" area, create the System Variable, called R_HOME. Give R_HOME the value of the PATH to the R home, for example (without quotes) "C:\Program Files\R\R-4.1.0". If you forgot to set the R_HOME environment variable (by any method), then (eventually) you may get this error: ```postgresql postgres=# CREATE EXTENSION plr; CREATE EXTENSION postgres=# SELECT r_version(); ERROR: environment variable R_HOME not defined HINT: R_HOME must be defined in the environment of the user that starts the postmaster process. ``` ### Third: Put the R.dll in your PATH. This is required, so do the following: Control Panel -> System -> Advanced System Settings -> Environment Variables button In the "System variables" area, choose the System Variable, called "Path". Click on the Edit button. Add the R.dll folder to the "Path". For example (without quotes), add "C:\Program Files\R\R-4.1.0\bin\x64" or "C:\Program Files\R\R-4.1.0\bin\i386". If you are running R version 2.11 or earlier on Windows, the R.dll folder is different; instead of "bin\i386" or "bin\x64", it is "bin". Note, a 64bit compiled PL/R can only run with a 64bit compiled PostgreSQL. A 32bit compiled PL/R can only run with a 32bit compiled PostgreSQL. The last 32bit PostgreSQL was version ten(10) from [https://www.enterprisedb.com/downloads/postgres-postgresql-downloads](https://www.enterprisedb.com/downloads/postgres-postgresql-downloads). Of course, you, yourself, may yourself, compile a 32bit PostgreSQL using Microsoft Visual Studio. ### Fourth: Restart the PostgreSQL cluster, do: At a Command Prompt run (and you may have to be in an Administrator Command Prompt): Use the service name of whatever service your PostgreSQL is running under. ``` net stop postgresql-x64-13 ``` Alternately, do the following: Control Panel -> Administrative Tools -> Services Find postgresql-x64-13 (or whatever service your PostgreSQL is running under). Right click and choose "Stop" At a Command Prompt run (and you may have to be in an Administrator Command Prompt): Use the service name of whatever service your PostgreSQL is running under. ``` net start postgresql-x64-13 ``` Alternately, do the following: Control Panel -> Administrative Tools -> Services Find postgresql-x64-13 (or whatever service your PostgreSQL is running under). Right click and choose "Start" **Tip** R headers are required. Download and install R prior to building PL/R. R must have been built with the `--enable-R-shlib` option when it was configured, in order for the libR shared object library to be available. **Tip:** Additionally, libR must be findable by your runtime linker. On Linux, this involves adding an entry in /etc/ld.so.conf for the location of libR (typically $R_HOME/bin or $R_HOME/lib), and then running ldconfig. Refer to `man ldconfig` or its equivalent for your system. **Tip:** R_HOME must be defined in the environment of the user under which PostgreSQL is started, before the postmaster is started. Otherwise PL/R will refuse to load. See plr_environ(), which allows examination of the environment available to the PostgreSQL postmaster process. **Tip:** On the Win32 platform, from a PL/R compiled by Microsoft Visual Studio, and from an R, installabled by an installer from [https://cran.r-project.org/bin/windows/base/](https://cran.r-project.org/bin/windows/base/), R will consider a registry entry created by the R installer if it fails to find R_HOME environment variable. If you choose the installer option ‘Save version number in registry’, as explained in ‘Does R use the Registry?’ at [https://cran.r-project.org/bin/windows/base/rw-FAQ.html](https://cran.r-project.org/bin/windows/base/rw-FAQ.html) there is no need to set R_HOME on this platform. Be careful removing older version of R as it may take away InstallPath entry away from HKLM\SOFTWARE\R-core\R a.k.a. Computer\HKEY_LOCAL_MACHINE\SOFTWARE\R-core\R. ### Creating the PLR Extension As of PostgreSQL 9.1 you can use the new ```CREATE EXTENSION``` command: ```postgresql CREATE EXTENSION plr; ``` This is not only simple, it has the added advantage of tracking all PL/R installed objects as dependent on the extension, and therefore they can be removed just as easily if desired: ```postgresql DROP EXTENSION plr; ``` **Tip** If a language is installed into `template1`, all subsequently created databases will have the language installed automatically. **Tip** In addition to the documentation, the plr.out.* files in the plr/expected folder are a good source of usage examples. ## Functions and Arguments To create a function in the PL/R language, use standard R syntax, but without the enclosing braces or function assignment. Instead of `myfunc <- function(arguments) { function body }`, the body of your PL/R function is just `sqlfunction body` ```postgresql CREATE OR REPLACE FUNCTION funcname(argument-types) RETURNS return-type AS ' function body ' LANGUAGE plr; ``` The body of the function is simply a piece of R script. When the function is called, the argument values are passed as variables `arg1...argN` to the R script. The result is returned from the R code in the usual way. For example, a function returning the greater of two integer values could be defined as: ```postgresql CREATE OR REPLACE FUNCTION r_max(integer, integer) RETURNS integer AS ' if (arg1 > arg2) return(arg1) else return(arg2) ' LANGUAGE plr STRICT; ``` Literal characters in the body of an R function that is within the body of a PL/R function can be written in double quotes (") or in single quotes (') (both, just like R), except that in PL/R each single quote is escaped with a preceding single quote('). Also, in PostgreSQL functions, dollar signs may distinquish the beginning and end of a string boundary. Some examples follow. ```postgresql CREATE OR REPLACE FUNCTION hello() RETURNS text AS ' return(''Hello'') ' LANGUAGE plr; CREATE OR REPLACE FUNCTION hello2() RETURNS text AS ' return("Hello") ' LANGUAGE plr; CREATE OR REPLACE FUNCTION hello3() RETURNS text AS $body$ return('Hello') $body$ LANGUAGE plr; CREATE OR REPLACE FUNCTION hello4() RETURNS text AS $body$ return("Hello") $body$ LANGUAGE plr; SELECT hello(); hello ------- Hello (1 row) SELECT hello2(); hello2 -------- Hello (1 row) SELECT hello3(); hello3 -------- Hello (1 row) SELECT hello4(); hello4 -------- Hello (1 row) ``` Starting with PostgreSQL 8.0, arguments may be explicitly named when creating a function. If an argument is explicitly named at function creation time, that name will be available to your R script in place of the usual ```argN variable```. For example: ```postgresql CREATE OR REPLACE FUNCTION sd(vals float8[]) RETURNS float AS ' sd(vals) ' LANGUAGE plr STRICT; ``` Starting with PostgreSQL 8.4, a PL/R function may be declared to be a `WINDOW`. In this case, in addition to the usual `argN(or named)` variables, PL/R automatically creates several other arguments to your function. For each explicit argument, a corresponding variable called `farg1...fargN` is passed to the R script. These contain an R vector of all the values of the related argument for the moving `WINDOW` frame within the current `PARTITION`. For example: ```postgresql CREATE OR REPLACE FUNCTION r_regr_slope(float8, float8, int) RETURNS float8 AS ' slope <- NA y <- farg1 x <- farg2 preceding <- arg3 if (fnumrows == preceding + 1L) try (slope <- lm(y ~ x)$coefficients[2]) return(slope) ' LANGUAGE plr WINDOW; ``` In the preceding example,`farg1` and `farg2` are R vectors containing the current row’s data plus that of related rows. The determination as to which rows qualify as related is determined by the frame specification of the query at run time. The example also illustrates one of two additional autogenerated arguments. `fnumrows` is the number of rows in the current `WINDOW` frame. The other (not shown) auto-argument is called `prownum`. This argument provides the 1-based row offset of the current row in the current `PARTITION`. See [Window Functions](#window-functions) for more information and a more complete example. In some of the the definitions above, note the clause `STRICT`, which saves us from having to think about NULL input values: if a NULL is passed, the function will not be called at all, but will just return a NULL result automatically. In a non-strict function, if the actual value of an argument is NULL, the corresponding `argN` variable will be set to a `NULL R` object. For example, suppose that we wanted `r_max` with one null and one non-null argument to return the non-null argument, rather than NULL: ```postgresql CREATE OR REPLACE FUNCTION r_max(integer, integer) RETURNS integer AS ' if (is.null(arg1) && is.null(arg2)) return(NULL) if (is.null(arg1)) return(arg2) if (is.null(arg2)) return(arg1) if (arg1 > arg2) return(arg1) ' LANGUAGE plr; ``` As shown above, to return a NULL value from a PL/R function, return `NULL`. This can be done whether the function is strict or not. Composite-type (tuple) arguments are passed to the procedure as R data.frames. The element names of the frame are the attribute names of the composite type. If an attribute in the passed row has the NULL value, it will appear as an `NA` in the frame. Here is an example: ```postgresql CREATE TABLE emp(name text, age int, salary numeric(10,2)); INSERT INTO emp VALUES ('Joe', 41, 250000.00); INSERT INTO emp VALUES ('Jim', 25, 120000.00); INSERT INTO emp VALUES ('Jon', 35, 50000.00); CREATE OR REPLACE FUNCTION overpaid (emp) RETURNS bool AS ' if (200000 < arg1$salary) { return(TRUE) } if (arg1$age < 30 && 100000 < arg1$salary) { return(TRUE) } return(FALSE) ' LANGUAGE plr; ``` ```postgresql SELECT name, overpaid(emp) FROM emp; name | overpaid ------+---------- Joe | t Jim | t Jon | f (3 rows) ``` There is also support for returning a composite-type result value: ```postgresql CREATE OR REPLACE FUNCTION get_emps() RETURNS SETOF emp AS ' names <- c(''Joe'',''Jim'',''Jon'') ages <- c(41,25,35) salaries <- c(250000,120000,50000) df <- data.frame(name = names, age = ages, salary = salaries) return(df) ' LANGUAGE plr; ``` ```postgresql SELECT * FROM get_emps(); name | age | salary ------+-----+----------- Jim | 41 | 250000. Joe | 25 | 120000. Jon | 35 | 50000. (3 rows) ``` An alternative method may be used to create a function in PL/R, if certain criteria are met. First, the function must be a simple call to an existing R function. Second, the function name used for the PL/R function must match that of the R function exactly. If these two criteria are met, the PL/R function may be defined with no body, and the arguments will be passed directly to the R function of the same name. For example: ```postgresql CREATE OR REPLACE FUNCTION sd(_float8) RETURNS float AS ' ' LANGUAGE plr; SELECT round(sd('{1.23,1.31,1.42,1.27}'::_float8)::numeric,8); round ------------ 0.08180261 (1 row) ``` **Tip** Because the function body is passed as an SQL string literal to `CREATE FUNCTION`, you have to escape single quotes and backslashes within your R source, typically by doubling them. ## Passing Data Values The argument values supplied to a PL/R function’s script are the input arguments converted to a corresponding R form. See Table 4-1. Scalar PostgreSQL values become single element R vectors. One exception to this are scalar bytea values. These are first converted to R raw type, and then processed by the R unserialize command. One-dimensional PostgreSQL arrays are converted to multi-element R vectors, two-dimensional PostgreSQL arrays are mapped to R matrixes, and three-dimensional PostgreSQL arrays are converted to three-dimensional R arrays. Greater than three-dimensional arrays are not supported. Composite-types are transformed into R data.frames. #### Table 4-1. Function Arguments | PostgreSQL type | R type | | ------------------------------- | ------- | | boolean | logical | | int2,int4 | integer | | int8,float4,float8,money,numeric | numeric | | bytea | object | | everything else | character | Conversely, the return values are first coerced to R character, and therefore anything that resolves to a string that is acceptable input format for the function’s declared return type will produce a result. Again, there is an exception for scalar bytea return values. In this case, the R object being returned is first processed by the R serialize command, and then the binary result is directly mapped into a PostgreSQL bytea datum. Similar to argument conversion, there is also a mapping between the dimensionality of the declared PostgreSQL return type and the type of R object. That mapping is shown in Table 4-2 #### Table 4-2. Function Result Dimensionality |PgSQL return type| R type| Result| Example| |---------------- | ----- | ----- | ------ | |scalar | array,matrix,vector|first column of first row| c(1,2,3) in R returns 1 in PostgreSQL| |setof scalar | 1D array,greater than 2D array, vector|multi-row, 1 column set |array(1:10) in R returns 10 rows in PostgreSQL| |scalar| data.frame |textual representation of the first column’s vector | data.frame(c(1,2,3)) in R returns ’c(1, 2, 3)’| |setof scalar |2D array,matrix,data.frame| #columns > 1, error; #columns == 1,multi-row, 1 column set| (as.data.frame(array(1:10,c(2,5))))[,1] in R returns 2 rows of scalar| |array| 1D array,greater than 3D array,vector| 1D array |array(1:8,c(2,2,2,2)) in R returns {1,2,3,4,5,6,7,8,1,2,3,4,5,6,7,8}| |array |2D array,matrix,data.frame| 2D array |array(1:4,c(2,2)) in R returns {{1,3},{2,4}}| |array| 3D array| 3D array| array(1:8,c(2,2,2)) in R returns {{{1,5},{3,7}},{{2,6},{4,8}}}| |composite| 1D array,greater than 2D array,vector| first row, 1 column |array(1:8,c(2,2,2)) in R returns 1 row of scalar| |setof composite| 1D array,greater than 2D array,vector|multi-row, 1 column set|array(1:8,c(2,2,2)) in R returns 8 rows of scalar| |composite| 2D array,matrix,data.frame|first row, multi-column|array(1:4,c(2,2)) in R returns 1 row of 2 columns| |setof composite|2D array,matrix,data.frame|multi-row, multi-column set|array(1:4,c(2,2)) in R returns 2 rows of 2 columns| ## Using Global Data Sometimes it is useful to have some global status data that is held between two calls to a procedure or is shared between different procedures. Equally useful is the ability to create functions that your PL/R functions can share. This is easily done since all PL/R procedures executed in one backend share the same R interpreter. So, any global R variable is accessible to all PL/R procedure calls, and will persist for the duration of the SQL client connection. An example of using a global object appears in the `pg.spi.execp` example, in [Database Access and Support Functions](#database-access). A globally available, user named, R function (the R function name of PL/R functions is not the same as its PostgreSQL function name; see: [R Function Names](#rfunction-names)) can be created dynamically using the provided PostgreSQL function `install_rcmd(text)`. Here is an example: ```postgresql SELECT install_rcmd('pg.test.install <-function(msg) {print(msg)}'); install_rcmd -------------- OK (1 row) ``` ```postgresql CREATE OR REPLACE FUNCTION pg_test_install(text) RETURNS text AS ' pg.test.install(arg1) ' LANGUAGE plr; ``` ```postgresql SELECT pg_test_install('hello world'); pg_test_install ----------------- hello world (1 row) ``` A globally available, user named, R function can also be automatically created and installed in the R interpreter. See: [Loading R Modules at Startup](#startup) PL/R also provides a global variable called `pg.state.firstpass.` This variable is reset to TRUE the first time each `PL/R` function is called, for a particular query. On subsequent calls the value is left unchanged. This allows one or more PL/R functions to perform a possibly expensive initialization on the first call, and reuse the results for the remaining rows in the query. For example: ```postgresql CREATE TABLE t(f1 int); INSERT INTO t VALUES (1); INSERT INTO t VALUES (2); INSERT INTO t VALUES (3); ``` ```postgresql CREATE OR REPLACE FUNCTION f1() RETURNS int AS ' msg <- paste(''enter f1, pg.state.firstpass is '', pg.state.firstpass) pg.thrownotice(msg) if (pg.state.firstpass == TRUE) pg.state.firstpass <<- FALSE msg <- paste(''exit f1, pg.state.firstpass is '', pg.state.firstpass) pg.thrownotice(msg) return(0) ' LANGUAGE plr; ``` ```postgresql CREATE OR REPLACE FUNCTION f2() RETURNS int AS ' msg <- paste(''enter f2, pg.state.firstpass is '', pg.state.firstpass) pg.thrownotice(msg) if (pg.state.firstpass == TRUE) pg.state.firstpass <<- FALSE msg <- paste(''exit f2, pg.state.firstpass is '', pg.state.firstpass) pg.thrownotice(msg) return(0) ' LANGUAGE plr; ``` ```postgresql SELECT f1(), f2(), f1 FROM t; NOTICE: enter f1, pg.state.firstpass is TRUE NOTICE: exit f1, pg.state.firstpass is FALSE NOTICE: enter f2, pg.state.firstpass is TRUE NOTICE: exit f2, pg.state.firstpass is FALSE NOTICE: enter f1, pg.state.firstpass is FALSE NOTICE: exit f1, pg.state.firstpass is FALSE NOTICE: enter f2, pg.state.firstpass is FALSE NOTICE: exit f2, pg.state.firstpass is FALSE NOTICE: enter f1, pg.state.firstpass is FALSE NOTICE: exit f1, pg.state.firstpass is FALSE NOTICE: enter f2, pg.state.firstpass is FALSE NOTICE: exit f2, pg.state.firstpass is FALSE f1 | f2 | f1 ----+----+---- 0 | 0 | 1 0 | 0 | 2 0 | 0 | 3 (3 rows) ``` ```postgresql CREATE OR REPLACE FUNCTION row_number2() RETURNS int AS ' if (pg.state.firstpass) { assign(''pg.state.firstpass'', FALSE, env=.GlobalEnv) lclcntr<- 1 } else lclcntr<- plrcounter + 1 assign(''plrcounter'', lclcntr, env=.GlobalEnv) return(lclcntr) ' LANGUAGE plr; ``` ```postgresql SELECT row_number2(), f1 FROM t; row_number2 | f1 ------------+----- 1 | 1 2 | 2 3 | 3 (3 rows) ``` ## Database Access and Support ## Functions The following commands are available to access the database from the body of a PL/R procedure, or in support thereof: ### Normal Support `pg.spi.exec(character query)` Execute an SQL query given as a string. An error in the query causes an error to be raised. Otherwise, the command’s return value is the number of rows processed for `INSERT` ,`UPDATE`, or `DELETE` statements, or zero if the query is a utility statement. If the query is a `SELECT` statement, the values of the selected columns are placed in an R data.frame with the target column names used as the frame column names. However, non-numeric columns are **not** converted to factors. If you want all non-numeric columns converted to factors, a convenience function `pg.spi.factor` (described below) is provided. If a field of a SELECT result is NULL, the target variable for it is set to `NA`. For example: ```postgresql CREATE OR REPLACE FUNCTION test_spi_tup(text) RETURNS SETOF record AS ' pg.spi.exec(arg1) ' LANGUAGE plr; ``` ```postgresql SELECT * FROM test_spi_tup('SELECT oid, NULL::text as nullcol, typname FROM pg_type WHERE typname = ''oid'' OR typname = ''text''') AS t(typeid oid, nullcol text, typename name); typeid | nullcol | typename --------+---------+---------- 25 | | text 26 | | oid (2 rows) ``` The NULL values were passed to R as `NA`, and on return to PostgreSQL they were converted back to NULL. `pg.spi.prepare(character query,integer vector type_vector)` Prepares and saves a query plan for later execution. The saved plan will be retained for the life of the current backend. The query may use arguments, which are placeholders for values to be supplied whenever the plan is actually executed. In the query string, refer to arguments by the symbols `$1...$n`. If the query uses arguments, the values of the argument types must be given as a vector. Pass `NA` for `type_vector` if the query has no arguments. The argument types must be identified by the type Oids, shown in pg_type. Global variables are provided for this use. They are named according to the convention TYPENAMEOID, where the actual name of the type, in all capitals, is substituted for TYPENAME. A support function, `load_r_typenames()` must be used to make the predefined global variables available for use: ```postgresql SELECT load_r_typenames(); load_r_typenames ------------------ OK (1 row) ``` Another support function,`r_typenames()` may be used to list the predefined Global variables: ```postgresql SELECT * FROM r_typenames(); typename | typeoid ------------+--------- ABSTIMEOID | 702 ACLITEMOID | 1033 ANYARRAYOID | 2277 ANYOID | 2276 BITOID | 1560 BOOLOID | 16 [...] TRIGGEROID | 2279 UNKNOWNOID | 705 VARBITOID | 1562 VARCHAROID | 1043 VOIDOID | 2278 XIDOID | 28 (159 rows) ``` The return value from `pg.spi.prepare` is a query ID to be used in subsequent calls to pg.spi.execp. See `spi_execp` for an example. `pg.spi.execp(external pointer saved_plan, variable listvalue_list)` Execute a query previously prepared with `pg.spi.prepare.saved_plan` is the external pointer returned by `pg.spi.prepare`. If the query references arguments, a `value_list` must be supplied: this is an R list of actual values for the plan arguments. It must be the same length as the argument type_vector previously given to pg.spi.prepare. Pass `NA` for `value_list` if the query has no arguments. The following illustrates the use of `pg.spi.prepare` and `pg.spi.execp` with and without query arguments: ```postgresql CREATE OR REPLACE FUNCTION test_spi_prep(text) RETURNS text AS ' sp <<- pg.spi.prepare(arg1, c(NAMEOID, NAMEOID)) print(''OK'') ' LANGUAGE plr; ``` ```postgresql SELECT test_spi_prep('SELECT oid, typname FROM pg_type WHERE typname = $1 OR typname = $2'); test_spi_prep --------------- OK (1 row) ``` ```postgresql CREATE OR REPLACE FUNCTION test_spi_execp(text, text, text) RETURNS SETOF record AS ' pg.spi.execp(pg.reval(arg1), list(arg2,arg3)) ' LANGUAGE plr; ``` ```postgresql SELECT * FROM test_spi_execp('sp','oid','text') AS t(typeid oid, typename name); typeid | typename --------+---------- 25 | text 26 | oid (2 rows) ``` ```postgresql CREATE OR REPLACE FUNCTION test_spi_prep2(text) RETURNS text AS ' sp <<- pg.spi.prepare(arg1, NA) print(''OK'') ' LANGUAGE plr; ``` ```postgresql SELECT test_spi_prep('SELECT oid, typname FROM pg_type WHERE typname = ''bytea'' OR typname = ''text'''); test_spi_prep --------------- OK (1 row) ``` ```postgresql CREATE OR REPLACE FUNCTION test_spi_execp(text) RETURNS SETOF record AS ' pg.spi.execp(pg.reval(arg1), NA) ' LANGUAGE plr; ``` ```postgresql SELECT * FROM test_spi_execp('sp') AS t(typeid oid, typename name); typeid | typename --------+---------- 17 | bytea 25 | text (2 rows) ``` ```postgresql CREATE OR REPLACE FUNCTION test_spi_prep(text) RETURNS text AS ' sp <<- pg.spi.prepare(arg1) print(''OK'') ' LANGUAGE plr; ``` ```postgresql SELECT test_spi_prep('SELECT oid, typname FROM pg_type WHERE typname = ''bytea'' OR typname = ''text'''); test_spi_prep --------------- OK (1 row) ``` ```postgresql CREATE OR REPLACE FUNCTION test_spi_execp(text) RETURNS SETOF record AS ' pg.spi.execp(pg.reval(arg1)) ' LANGUAGE plr; ``` ```postgresql SELECT * FROM test_spi_execp('sp') AS t(typeid oid, typename name); typeid | typename --------+---------- 17 | bytea 25 | text (2 rows) ``` NULL arguments should be passed as individual `NA` values in value_list. Except for the way in which the query and its arguments are specified,`pg.spi.execp` works just like `pg.spi.exec`. `pg.spi.cursor_open(character cursor_name, external pointer saved_plan, variable list value_list)` Opens a cursor identified by cursor_name. The cursor can then be used to scroll through the results of a query plan previously prepared by pg.spi.prepare. Any arguments to the plan should be specified in arg values similar to `pg.spi.execp`. Only read-only cursors are supported at the moment. ```r plan <- pg.spi.prepare('SELECT * FROM pg_class'); cursor_obj <- pg.spi.cursor_open('my_cursor',plan); ``` Returns a cursor object that be be passed to `pg.spi.cursor_fetch` `pg.spi.cursor_fetch(external pointer cursor, boolean forward, integer rows)` Fetches rows from the cursor object previously returned by `pg.spi.cursor_open`. If forward is TRUE, then the cursor is moved forward to fetch at most the number of rows required by the rows parameter. If forward is FALSE, then the cursor is moved backwards at most the number of rows specified. rows indicates the maximum number of rows that should be returned. ```r plan <- pg.spi.prepare('SELECT * FROM pg_class'); cursor_obj <- pg.spi.cursor_open('my_cursor',plan); data <- pg.spi.cursor_fetch(cursor_obj,TRUE,as.integer(10)); ``` Returns a data frame containing the results. `pg.spi.cursor_close(external pointer cursor)` Closes a cursor previously opened by `pg.spi.cursor_open` ```r plan <- pg.spi.prepare('SELECT * FROM pg_class'); cursor_obj <- pg.spi.cursor_open('my_cursor',plan); pg.spi.cursor_close(cursor_obj); ``` `pg.spi.lastoid()` Returns the OID of the row inserted by the last query executed via `pg.spi.exec` or `pg.spi.execp`, if that query was a single-row INSERT. (If not, you get zero.) `pg.quoteliteral(character SQL_string)` Duplicates all occurrences of single quote and backslash characters in the given string. This may be used to safely quote strings that are to be inserted into SQL queries given to `pg.spi.exec` or `pg.spi.prepare`. `pg.quoteident(character SQL_string)` Return the given string suitably quoted to be used as an identifier in an SQL query string. Quotes are added only if necessary (i.e., if the string contains non-identifier characters or would be case folded). Embedded quotes are properly doubled. This may be used to safely quote strings that are to be inserted into SQL queries given to `pg.spi.exec` or `pg.spi.prepare`. `pg.thrownotice(character message)` `pg.throwerror(character message)` Emit a PostgreSQL `NOTICE` or `ERROR` message.`ERROR` also raises an error condition: further execution of the function is abandoned, and the current transaction is aborted. `pg.spi.factor(data.frame data)` Accepts an R `data.frame` as input, and converts all non-numeric columns to `factors`. This may be useful for `data.frames` produced by `pg.spi.exec` or `pg.spi.prepare`, because the PL/R conversion mechanism does **not** do that for you. ### RPostgreSQL Compatibility Support The following functions are intended to provide some level of compatibility between PL/R and RPostgreSQL (PostgreSQL DBI package). This allows, for example, a function to be first prototyped using an R client, and then easily moved to PL/R for production use. `dbDriver(character dvr_name)` `dbConnect (DBIDriver drv, character user, character password, character host, character dbname, character port, character tty, character options)` `dbSendQuery(DBIConnection conn, character sql)` `fetch(DBIResult rs,integer num_rows)` `dbClearResult(DBIResult rs)` `dbGetQuery(DBIConnection conn, character sql)` `dbReadTable(DBIConnection conn, character name)` `dbDisconnect(DBIConnection conn)` `dbUnloadDriver(DBIDriver drv)` These functions nominally work like their RPostgreSQL counterparts except that all queries are performed in the current database. Therefore all driver and connection related parameters are ignored, and dbDriver, dbConnect, dbDisconnect, and dbUnloadDriver are no-ops. ## PostgreSQL Support Functions The following commands are available to use in PostgreSQL queries to aid in the use of PL/R functions: `plr_version()` that displays the PL/R version x.y (but not the patch version x.y.z) ```postgresql SELECT plr_version(); plr_version ------------- 8.4 (1 row) ``` `SELECT * FROM pg_available_extensions WHERE name = 'plr'` that displays the PL/R version x.y.z ```postgresql SELECT * FROM pg_available_extensions WHERE name = 'plr'; name | default_version | installed_version | comment ------+-----------------+-------------------+---------------------------------------------------------------- plr | 8.4.2 | 8.4.2 | load R interpreter and execute R script from within a database (1 row) ``` `r_version()` that displays R version . . . ```postgresql SELECT r_version(); r_version ------------------------------------------------- (platform,x86_64-w64-mingw32) (arch,x86_64) (os,mingw32) (system,"x86_64, mingw32") (status,"") (major,4) (minor,1.0) (year,2021) (month,05) (day,18) ("svn rev",80317) (language,R) (version.string,"R version 4.1.0 (2021-05-18)") (nickname,"Camp Pontanezen") (14 rows) ``` `install_rcmd(text R_code)` Install R code, given as a string, into the interpreter. See [Using Global Data](#global-data) for an example. `reload_plr_modules()` Force re-loading of R code from the plr_modulestable. It is useful after modifying the contents of plr_modules, so that the change will have an immediate effect. `plr_singleton_array(float8 first_element)` Creates a new PostgreSQL array, using element `first_element`. This function is predefined to accept one float8 value and return a float8 array. The C function that implements this PostgreSQL function is capable of accepting and returning other data types, although the return type must be an array of the input parameter type. It can also accept multiple input parameters. For example, to define a `plr_array` function to create a text array from two input text values: ```postgresql CREATE OR REPLACE FUNCTION plr_array (text, text) RETURNS text[] AS '$libdir/plr', 'plr_array' LANGUAGE C STRICT; ``` ```postgresql SELECT plr_array('hello', 'world'); plr_array --------------- {hello,world} (1 row) ``` `plr_array_push(float8[] array, float8 next_element)` Pushes a new element onto the end of an existing PostgreSQL array. This function is predefined to accept one float8 array and a float8 value, and return a float8 array. The C function that implements this PostgreSQL function is capable of accepting and returning other data types. For example, to define a `plr_array_push` function to add a text value to an existing text array: ```postgresql CREATE OR REPLACE FUNCTION plr_array_push(_text, text) RETURNS text[] AS '$libdir/plr','plr_array_push' LANGUAGE C STRICT; ``` ```postgresql SELECT plr_array_push(plr_array('hello', 'world'), 'how are you'); plr_array_push ----------------------------- {hello,world,"how are you"} (1 row) ``` `plr_array_accum(float8[] state_value,float8 next_element)` Creates a new array using next_element if state_value is NULL. Otherwise, pushes next_element onto the end of state_value. This function is predefined to accept one float8 array and a float8 value, and return a float8 array. The C function that implements this PostgreSQL function is capable of accepting and returning other data types. For example, to define a `plr_array_accum` function to add an int4 value to an existing int4 array: ```postgresql CREATE OR REPLACE FUNCTION plr_array_accum(_int4, int4) RETURNS int4[] AS '$libdir/plr','plr_array_accum' LANGUAGE C; ``` ```postgresql SELECT plr_array_accum(NULL, 42); plr_array_accum ------------- {42} (1 row) SELECT plr_array_accum('{23,35}', 42); plr_array_accum ----------------- {23,35,42} (1 row) ``` This function may be useful for creating custom aggregates. See [Aggregate Functions](#aggregate-functions) for an example. `load_r_typenames()` Installs datatype Oid variables into the R interpreter as globals. See also `r_typenames` below. `r_typenames()` Displays the datatype Oid variables installed into the R interpreter as globals. See [Database Access and Support Functions](#database-access) for an example. `plr_environ()` Displays the environment under which the Postmaster is currently running. This may be useful to debug issues related to R specific environment variables. This function is installed with EXECUTE permission revoked from PUBLIC. `plr_set_display(text display)` Sets the DISPLAY environment variable under which the Postmaster is currently running. This may be useful if using R to plot to a virtual frame buffer. This function is installed with EXECUTE permission revoked from PUBLIC. `plr_get_raw(bytea serialized_object)` By default, when R objects are returned as type `bytea`, the R object is serialized using an internal R function prior to sending to PostgreSQL. This function deserializes the R object using another internal R function, and returns the pure raw bytes to PostgreSQL. This is useful, for example, if the R object being returned is a JPEG or PNG graphic for use outside of R. ## Aggregate Functions Aggregates in PostgreSQL are extensible via SQL commands. In general, to create a new aggregate, a state transition function and possibly a final function are specified. The final function is used in case the desired output of the aggregate is different from the data that needs to be kept in the running state value. There is more than one way to create a new aggregate using PL/R. A simple aggregate can be defined using the predefined PostgreSQL C function,`plr_array_accum` (see [PostgreSQL Support Functions](#postgresql-support)) as a state transition function, and a PL/R function as a finalizer. For example: ```postgresql CREATE OR REPLACE FUNCTION r_median(_float8) RETURNS float AS ' median(arg1) ' LANGUAGE plr; ``` ```postgresql CREATE AGGREGATE median ( sfunc = plr_array_accum, basetype = float8, stype = _float8, finalfunc = r_median ); ``` ```postgresql CREATE TABLE foo(f0 int, f1 text, f2 float8); INSERT INTO foo VALUES(1,'cat1',1.21); INSERT INTO foo VALUES(2,'cat1',1.24); INSERT INTO foo VALUES(3,'cat1',1.18); INSERT INTO foo VALUES(4,'cat1',1.26); INSERT INTO foo VALUES(5,'cat1',1.15); INSERT INTO foo VALUES(6,'cat2',1.15); INSERT INTO foo VALUES(7,'cat2',1.26); INSERT INTO foo VALUES(8,'cat2',1.32); INSERT INTO foo VALUES(9,'cat2',1.30); ``` ```postgresql SELECT f1, median(f2) FROM foo GROUP BY f1 ORDER BY f1; f1 | median ------+-------- cat1 | 1.21 cat2 | 1.28 (2 rows) ``` A more complex aggregate might be created by using a PL/R functions for both state transition and finalizer. ## Window Functions Starting with version 8.4, PostgreSQL supports `WINDOW` functions which provide the ability to perform calculations across sets of rows that are related to the current query row. This is comparable to the type of calculation that can be done with an aggregate function. But unlike regular aggregate functions, use of a window function does not cause rows to become grouped into a single output row; the rows retain their separate identities. Behind the scenes, the window function is able to access more than just the current row of the query result. See the PostgreSQL documentation for more general information related to the use of this capability. PL/R functions may be defined as `WINDOW`. For example: ```postgresql CREATE OR REPLACE FUNCTION r_regr_slope(float8, float8, int) RETURNS float8 AS ' slope <- NA y <- farg1 x <- farg2 preceding <- arg3 if (fnumrows == preceding + 1L) try (slope <- lm(y ~ x)$coefficients[2]) return(slope) ' LANGUAGE plr WINDOW; ``` A number of variables are automatically provided by PL/R to the R interpreter: `fargN` `farg1` and `farg2` are R vectors containing the current row’s data plus that of the related rows. `fnumrows` The number of rows in the current `WINDOW` frame. `prownum` (not shown) Provides the 1-based, row offset of the current row, in the current `PARTITION`. A more complete example follows: ```postgresql -- CREATE test TABLE CREATE TABLE test_data ( fyear integer, firm float8, eps float8 ); ``` ```postgresql -- insert randomly perturbated data for test INSERT INTO test_data SELECT (b.f + 1) % 10 + 2000 AS fyear, floor((b.f+1)/10) + 50 AS firm, f::float8/100 + random()/10 AS eps FROM generate_series(-500,499,1) b(f); ``` ```postgresql CREATE OR REPLACE FUNCTION r_regr_slope(float8, float8, int) RETURNS float8 AS ' slope <- NA y <- farg1 x <- farg2 preceding <- arg3 if (fnumrows == preceding + 1L) try (slope <- lm(y ~ x)$coefficients[2]) return(slope) ' LANGUAGE plr WINDOW; ``` ```postgresql SELECT *, r_regr_slope(eps, lag_eps, 8) OVER w AS slope_R FROM (SELECT firm, fyear, eps, lag(eps) OVER (ORDER BY firm, fyear) AS lag_eps FROM test_data) AS a WHERE eps IS NOT NULL WINDOW w AS (ORDER BY firm, fyear ROWS 8 PRECEDING); ``` In this example, the variables `farg1` and `farg2` contain the current row value for eps and lag_eps, as well as the preceding 8 rows which are also in the same `WINDOW` frame within the same `PARTITION`. In this case since no `PARTITION` is explicitly defined, the `PARTITION` is the entire set of rows returned from the inner sub-select. In these next examples, use of the variables `arg1`,`farg1`,`fnumrows`, and `prownum` are illustrated in detail. The window frame is saved into a dedicated R environment. [R Environments] (https://cran.r-project.org/doc/manuals/r-release/R-lang.html#Environment-objects). Variables `farg#` and only `farg1` in these simple examples. The `foo` table that we created (above) is reused here. ```postgresql CREATE OR REPLACE FUNCTION arg1(int) RETURNS int AS ' return(arg1) ' LANGUAGE plr WINDOW; CREATE OR REPLACE FUNCTION farg1(int) RETURNS text AS ' return(capture.output(farg1)) ' LANGUAGE plr WINDOW; CREATE OR REPLACE FUNCTION fnumrows(int) RETURNS int AS ' return(fnumrows) ' LANGUAGE plr WINDOW; CREATE OR REPLACE FUNCTION prownum(int) RETURNS int AS ' return(prownum) ' LANGUAGE plr WINDOW; SELECT s.f1, s.f0, arg1(s.f0) OVER(PARTITION BY s.f1 ORDER BY f0), farg1(s.f0) OVER(PARTITION BY s.f1 ORDER BY f0), fnumrows(s.f0) OVER(PARTITION BY s.f1 ORDER BY f0), prownum(s.f0) OVER(PARTITION BY s.f1 ORDER BY f0) FROM (SELECT f0 + 10 f0, f1 FROM foo) AS s; f1 | f0 | arg1 | farg1 | fnumrows | prownum ------+----+------+--------------------+----------+--------- cat1 | 11 | 11 | [1] 11 | 1 | 1 cat1 | 12 | 12 | [1] 11 12 | 2 | 2 cat1 | 13 | 13 | [1] 11 12 13 | 3 | 3 cat1 | 14 | 14 | [1] 11 12 13 14 | 4 | 4 cat1 | 15 | 15 | [1] 11 12 13 14 15 | 5 | 5 cat2 | 16 | 16 | [1] 16 | 1 | 1 cat2 | 17 | 17 | [1] 16 17 | 2 | 2 cat2 | 18 | 18 | [1] 16 17 18 | 3 | 3 cat2 | 19 | 19 | [1] 16 17 18 19 | 4 | 4 (9 rows) SELECT s.f1, s.f0, arg1(s.f0) OVER(PARTITION BY s.f1 ORDER BY f0 ROWS 1 PRECEDING), farg1(s.f0) OVER(PARTITION BY s.f1 ORDER BY f0 ROWS 1 PRECEDING), fnumrows(s.f0) OVER(PARTITION BY s.f1 ORDER BY f0 ROWS 1 PRECEDING), prownum(s.f0) OVER(PARTITION BY s.f1 ORDER BY f0 ROWS 1 PRECEDING) FROM (SELECT f0 + 10 f0, f1 FROM foo) AS s; f1 | f0 | arg1 | farg1 | fnumrows | prownum ------+----+------+-----------+----------+--------- cat1 | 11 | 11 | [1] 11 | 1 | 1 cat1 | 12 | 12 | [1] 11 12 | 2 | 2 cat1 | 13 | 13 | [1] 12 13 | 2 | 3 cat1 | 14 | 14 | [1] 13 14 | 2 | 4 cat1 | 15 | 15 | [1] 14 15 | 2 | 5 cat2 | 16 | 16 | [1] 16 | 1 | 1 cat2 | 17 | 17 | [1] 16 17 | 2 | 2 cat2 | 18 | 18 | [1] 17 18 | 2 | 3 cat2 | 19 | 19 | [1] 18 19 | 2 | 4 (9 rows) ``` Programmer-created temporary (or utility) variables and their values may be needed by the user need to be re-available within the next call of the function, that is, at the next position of the row pointer. These variables can be stashed in the R environment `parent.frame(0)`. Do not stash these variables in the R global environment `.RGlobalEnv`. ```postgresql CREATE OR REPLACE FUNCTION framefirst_plus_current(int) RETURNS int AS ' if(prownum == 1) assign(''frame_first_value'', arg1, envir = parent.frame()) return(frame_first_value + farg1[fnumrows]) ' LANGUAGE plr WINDOW; SELECT s.f1, s.f0, framefirst_plus_current(s.f0) OVER(PARTITION BY s.f1 ORDER BY f0) FROM (SELECT f0 + 10 f0, f1 FROM foo) AS s; f1 | f0 | framefirst_plus_current ------+----+------------------------- cat1 | 11 | 22 cat1 | 12 | 23 cat1 | 13 | 24 cat1 | 14 | 25 cat1 | 15 | 26 cat2 | 16 | 32 cat2 | 17 | 33 cat2 | 18 | 34 cat2 | 19 | 35 (9 rows) ```` Another interesting example follows. The idea of "Winsorizing" is to return either the original value or, if that value is outside certain bounds, a trimmed value. So for example `winsorize(eps, 0.1)` would return the value at the 10th percentile for values of eps less that that, the value of the 90th percentile for eps greater than that value, and the unmodified value of eps otherwise. Everytime, the row pointer is moved, to prevent the re-calcuation of the 'frame result' the to-be-once calculated frame_result, that is only needs to be calculated at `prownum == 1`, is stored in the parent.frame. ```postgresql CREATE OR REPLACE FUNCTION winsorize(float8, float8) RETURNS float8 AS ' if(prownum == 1L) assign(''frame_result'', psych::winsor(as.vector(farg1), arg2), envir = parent.frame()) return(frame_result[prownum]) ' LANGUAGE plr VOLATILE WINDOW; ``` Here is the example call through SQL. Note, the R CRAN package `psych` (and the dependencies), must have already been installed into R. ```postgresql SELECT fyear, eps, winsorize(eps, 0.1) OVER (PARTITION BY fyear) AS w_eps FROM test_data ORDER BY fyear, eps; ``` For optimization reasons, constant expressions are not expanded. The corresponding `farg2` in the `Winsorize` example above is passes with NULL value. Compatibility reasons exist, so that other arguments are not shifted, in functions users created with previous versions of PL/R. ## Loading R Modules at Startup PL/R has support for auto-loading R code during interpreter initialization. It uses a special table, `plr_modules`, which is presumed to contain modules of R code. If this table exists, the modules defined are fetched from the table and loaded into the R interpreter immediately after creation. The definition of the table `plr_modules` is as follows: ```postgresql CREATE TABLE plr_modules ( modseq int4, modsrc text ); ``` The column `modseq` is used to control the order of installation. The column `modsrc` contains the full text of the R code to be executed, including assignment if that is desired. Consider, for example, the following statement: ```postgresql INSERT INTO plr_modules VALUES (0, 'pg.test.module.load <-function(msg) {print(msg)}'); ``` This statement will cause an R function namedpg.test.module.load to be created in the R interpreter on initialization. A PL/R function may now simply reference the function directly as follows: ```postgresql CREATE OR REPLACE FUNCTION pg_test_module_load(text) RETURNS text AS ' pg.test.module.load(arg1) ' LANGUAGE plr; ``` ```postgresql SELECT pg_test_module_load('hello world'); pg_test_module_load --------------------- hello world (1 row) ``` The table `plr_modules` must be readable by all, but it is wise to make it owned and writable only by the database administrator. ## R Function Names In PostgreSQL, a function name can be used for different functions (overloaded) as long as the number of arguments or their types differ. R, however, requires all function names to be distinct. PL/R deals with this by constructing the internal R function names as a concatenation of the string “PLR” with the object ID of the procedure’s `pg_proc`. Thus, PostgreSQL functions with the same name and different argument types will be different R functions too. This is not normally a concern for a PL/R programmer, but it might be visible when debugging. If a specific, known, function name is needed so that an R function can be referenced by one or more PL/R functions, the `install_rcmd(text)` command can be used. See [Using Global Data](#global-data). ## Trigger Procedures Trigger procedures can be written in PL/R. PostgreSQL requires that a procedure that is to be called as a trigger must be declared as a function with no arguments and a return type of `trigger`. The information from the trigger manager is passed to the procedure body in the following variables: `pg.tg.name` The name of the trigger from the `CREATE TRIGGER` statement. `pg.tg.relid` The object ID of the table that caused the trigger procedure to be invoked. `pg.tg.relname` The name of the table that caused the trigger procedure to be invoked. `pg.tg.when` The string `BEFORE` or `AFTER` depending on the type of trigger call. `pg.tg.level` The string `ROW` or `STATEMENT` depending on the type of trigger call. `pg.tg.op` The string `INSERT`,`UPDATE`, or `DELETE` depending on the type of trigger call. `pg.tg.new` When the trigger is defined `FOR EACH ROW`, a data.frame containing the values of the new table row for `INSERT` or `UPDATE` actions. For triggers defined `FOR EACH STATEMENT` and for `DELETE` actions, set to `NULL`. The attribute names are the table’s column names. Columns that are null will be represented as `NA`. `pg.tg.old` When the trigger is defined `FOR EACH ROW`, a data.frame containing the values of the old table row for `DELETE` or `UPDATE` actions. For triggers defined `FOR EACH STATEMENT` and for `INSERT` actions, set to `NULL`. The attribute names are the table’s column names. Columns that are null will be represented as `NA`. `pg.tg.args` A vector of the arguments to the procedure as given in the `CREATE TRIGGER` statement. The return value from a trigger procedure can be `NULL` or a one row data.frame matching the number and type of columns in the trigger table. `NULL` tells the trigger manager to silently suppress the operation for this row. If a one row data.frame is returned, it tells PL/R to return a possibly modified row to the trigger manager that will be inserted instead of the one given in `pg.tg.new`. This works for `INSERT` and `UPDATE` only. Needless to say that all this is only meaningful when the trigger is r`BEFORE` and `FOR EACH ROW`; otherwise the return value is ignored. Here’s a little example trigger procedure that forces an integer value in a table to keep track of the number of updates that are performed on the row. For new rows inserted, the value is initialized to 0 and then incremented on every update operation. ```postgresql CREATE TABLE mytab(num integer, description text, modcnt integer); ``` **Notice** below, that the trigger procedure itself does not know the column name; that’s supplied from the trigger arguments. This lets the trigger procedure be reused with different tables. ```postgresql CREATE FUNCTION trigfunc_modcount() RETURNS trigger AS ' if (pg.tg.op == ''INSERT'') { retval <- pg.tg.new retval[pg.tg.args[1]] <- 0 } if (pg.tg.op == ''UPDATE'') { retval <- pg.tg.new retval[pg.tg.args[1]] <- pg.tg.old[pg.tg.args[1]] + 1 } if (pg.tg.op == ''DELETE'') retval <- pg.tg.old return(retval) ' LANGUAGE plr; ``` ```postgresql CREATE TRIGGER trig_mytab_modcount BEFORE INSERT OR UPDATE ON mytab FOR EACH ROW EXECUTE PROCEDURE trigfunc_modcount('modcnt'); ``` ```postgresql INSERT INTO mytab(num, description) VALUES(11, 'eleven'); SELECT * FROM mytab; num | description | modcnt -----+-------------+-------- 11 | eleven | 0 (1 row) INSERT INTO mytab(num, description) VALUES(12, 'twelve'); SELECT * FROM mytab; num | description | modcnt -----+-------------+-------- 11 | eleven | 0 12 | twelve | 0 (2 rows) UPDATE mytab SET description = 'twelve again' WHERE num = 12; SELECT * FROM mytab; num | description | modcnt -----+--------------+-------- 11 | eleven | 0 12 | twelve again | 1 (2 rows) DELETE FROM mytab WHERE num = 12; SELECT * FROM mytab; num | description | modcnt -----+-------------+-------- 11 | eleven | 0 (1 row) ``` ## Inline Handler In PL/R version 8.4, is the `DO` inline handler. The DO inline handler allows the execution of an anonymous PL/R code block. ```postgresql SELECT plr_version(); plr_version ------------- 8.4 ``` ```postgresql DO LANGUAGE plr ' pg.throwlog(''Hello, world!'') '; ``` Output is seen in the PostgreSQL log: ```text 2021-03-18 04:47:15.086 UTC [47940] LOG: Hello, world! ``` ```postgresql DO LANGUAGE plr ' pg.thrownotice(''Hello, world!'') '; ``` Output is seen in the user console: ```text NOTICE: Hello, world! DO ``` ## Stored Procedures In PostgreSQL version eleven(11) or later, is the feature of Stored Procedures. These work in any operating system and in any platform. Unlike functions that return a value, procedures do not return a value. ```postgresql SELECT version(); version ------------------------------------------------------------ PostgreSQL 11.0, compiled by Visual C++ build 1914, 64-bit (1 row) SELECT current_setting('server_version_num')::int; current_setting ----------------- 110000 (1 row) ``` ```postgresql CREATE TABLE tbl(val integer); CREATE OR REPLACE PROCEDURE insert_data(a int, b int) AS ' pg.spi.exec(''INSERT INTO tbl VALUES (1);'') pg.spi.exec(''INSERT INTO tbl VALUES (2);'') ' LANGUAGE plr; CALL insert_data(1, 2); SELECT * FROM tbl; val ----- 1 2 (2 rows) ``` ## Transactions in Stored Procedures This feature has the same PostgreSQL version requirement as seen in `Stored Procedures`. Also PL/R version 8.4.2 (or later) is required. ```postgresql CREATE TABLE test1 (a int, b text); CREATE OR REPLACE PROCEDURE transaction_test1() AS ' for(i in 0:9) { pg.spi.exec(paste(''INSERT INTO test1 (a) VALUES ('', i, '');'')) if (i %% 2 == 0) { pg.spi.commit() } else { pg.spi.rollback() } } ' LANGUAGE plr; CALL transaction_test1(); SELECT * FROM test1; a | b ---+--- 0 | 2 | 4 | 6 | 8 | (5 rows) ``` ## Custom Type (Tuple) Arguments in Window Functions Arguments now can be a custom tuple or a record. PL/R version 8.4.2 (or later) is required. ```postgresql CREATE OR REPLACE FUNCTION fast_win_frame(r int, t record) RETURNS bool AS ' identical(parent.frame(), .GlobalEnv) && pg.throwerror(''Parent env is global'') exists(''plr_window_frame'', parent.frame(), inherits=FALSE) || pg.throwerror(''No window frame data found'') r == farg2[[prownum, 2]][3] ' LANGUAGE plr WINDOW; SELECT s.r, s.p, fast_win_frame(NULLIF(r,4), (s.r, s.q)) OVER w FROM (SELECT r, r % 2 AS p, array_fill(CASE WHEN r=7 THEN 77 ELSE r END, ARRAY[3]) AS q FROM generate_series(1,10) r) s WINDOW w AS (PARTITION BY p ORDER BY r ROWS BETWEEN UNBOUNDED PRECEDING AND UNBOUNDED FOLLOWING) ORDER BY s.r; r | p | fast_win_frame ----+---+---------------- 1 | 1 | t 2 | 0 | t 3 | 1 | t 4 | 0 | 5 | 1 | t 6 | 0 | t 7 | 1 | f 8 | 0 | t 9 | 1 | t 10 | 0 | t (10 rows) ``` ## License License: GPL version 2 or newer. http://www.gnu.org/copyleft/gpl.html 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA